EditorGadget

[Shardik]

This is another more complicated example of creating an EditorGadget
without scrollbars using solely API functions. It demonstrates how to
change the font of selected text, how to read out the current contents
of the EditorGadget and how to discriminate between the text written in
different fonts. It would also be possible to change font size and style of
selected text in a similar way thus programming an own WYSIWYG editor:

Code: Select all

EnableExplicit

ImportC ""
  ATSUFindFontFromName(*FontName, FontNameLength.L, FontNameCode.L, FontNamePlatform.L, FontNameScript.L, FontNameLanguage.L, *ATSUIFontID)
  TXNAttachObjectToWindowRef(TXNObject.L, WindowRef.L)
  TXNCountRunsInRange(TXNObject.L, StartOffset.L, EndOffset.L, *RunCount)
  TXNCreateObject(*FrameRect, FrameOptions.L, *TXNObject)
  TXNFocus(TXNObject.L, BecomingFocused.L)
  TXNGetData(TXNObject.L, StartOffset.L, EndOffset.L, *DataHandle)
  TXNGetIndexedRunInfoFromRange(TXNObject.L, RunIndex.L, StartOffset.L, EndOffset.L, *RunStartOffset, *RunEndOffset, *RunDataType, FontAttributeCount.L, *TypeAttributes)
  TXNGetSelection(TXNObject.L, *StartOffset, *EndOffset)
  TXNSelectAll(TXNObject.L)
  TXNSetData(TXNObject.L, DataType.L, *DataPtr, DataSize.L, StartOffset.L, EndOffset.L)
  TXNSetFrameBounds(TXNObject.L, Top.L, Left.L, Bottom.L, Right.L, FrameID.L)
  TXNSetSelection(TXNObject.L, StartOffset.L, EndOffset.L)
  TXNSetTXNObjectControls(TXNObject.L, ClearAll.L, ControlCount.L, ControlTags.L, ControlData.L)
  TXNSetTypeAttributes(TXNObject.L, AttributeCount.L, TXNTypeAttributes.L, StartOffset.L, EndOffset.L)
  TXNUpdate(TXNObject.L)
EndImport

#kATSUFontTag = 261
#kFontFullName = 4
#kFontNoLanguage = -1
#kFontNoPlatform = -1
#kFontNoScript = -1
#kTXNEndOffset = $7FFFFFFF
#kTXNTextData = 'TEXT'

Structure AttributeData
  StructureUnion
    DataPtr.L
    DataValue.L
    ATSUFeatures.L
    ATSUVariations.L
    URLRef.L
  EndStructureUnion
EndStructure

Structure TXNTypeAttributes
  TXTNTag.L
  TXNAttributeSize.L
  TXNAttributeData.AttributeData
EndStructure

Structure HIRect
  x.F
  y.F
  Width.F
  Height.F
EndStructure

Procedure.L ChangeFont(TXNObject.L, FontName.S)
  Protected EndOffset.L
  Protected FontID.L
  Protected StartOffset.L
  Protected Dim TypeAttributes.TXNTypeAttributes(0)

  If ATSUFindFontFromName(@FontName, Len(FontName), #kFontFullName, #kFontNoPlatform, #kFontNoScript, #kFontNoLanguage, @FontID) = 0
    ; ----- Select "Line 3"
    StartOffset = 14
    EndOffset = 20
    TXNSetSelection(TXNObject, StartOffset, EndOffset)

    ; ----- Change font of "Line 3"
    TypeAttributes(0)\TXTNTag = #kATSUFontTag
    TypeAttributes(0)\TXNAttributeSize = SizeOf(FontID)
    TypeAttributes(0)\TXNAttributeData\DataValue = FontID
    TXNSetTypeAttributes(TXNObject, 1, @TypeAttributes(0), StartOffset, EndOffset)
    TXNSetSelection(TXNObject, #kTXNEndOffset, #kTXNEndOffset)

    ProcedureReturn FontID
  EndIf
EndProcedure

Procedure.S GetEditorText(TXNObject.L, FontID.L)
  Protected CustomFontText.S
  Protected DataHandle.L
  Protected DefaultFontText.S
  Protected EndOffset.L
  Protected i.L
  Protected RunCount.L
  Protected RunDataType.L
  Protected RunEndOffset.L
  Protected RunStartOffset.L
  Protected StartOffset.L
  Protected Text.S
  Protected Dim TypeAttributes.TXNTypeAttributes(0)

  TypeAttributes(0)\TXTNTag = #kATSUFontTag
  TypeAttributes(0)\TXNAttributeSize = SizeOf(FontID)
  TypeAttributes(0)\TXNAttributeData\DataValue = #Null

  TXNSelectAll(TXNObject)
  TXNGetSelection(TXNObject, @StartOffset, @EndOffset)
  
  If StartOffset < EndOffset
    If TXNCountRunsInRange(TXNObject, StartOffset, EndOffset, @RunCount) = 0
      For i = 0 To RunCount - 1
        If TXNGetIndexedRunInfoFromRange(TXNObject, i, StartOffset, EndOffset, @RunStartOffset, @RunEndOffset, @RunDataType, 1, @TypeAttributes(0)) = 0
          If TXNGetData(TXNObject, RunStartOffset, RunEndOffset, @DataHandle) = 0
            Text = PeekS(PeekL(DataHandle), RunEndOffset - RunStartOffset, #PB_Unicode)

            If TypeAttributes(0)\TXNAttributeData\DataValue = FontID
              CustomFontText + Text
            Else
              DefaultFontText + Text
            EndIf                
          EndIf
        EndIf
      Next i
    EndIf
  EndIf

  TXNSetSelection(TXNObject, #kTXNEndOffset, #kTXNEndOffset)

  Text = "Text in default font:" + #CR$ + DefaultFontText + #CR$ + #CR$
  Text + "Text in font Apple Chancery:" + #CR$ + CustomFontText

  ProcedureReturn Text
EndProcedure

Define Bounds.HIRect
Define FontID.L
Define i.L
Define Text.S
Define TXNObject.L

For i = 1 To 5
  Text + "Line " + Str(i) + #CR$
Next i

OpenWindow(0, 200, 100, 420, 115, "Get text of MLTE TextObject containing different fonts", #PB_Window_SystemMenu)
ButtonGadget(0, (WindowWidth(0) - 370) / 2, WindowHeight(0) - 25, 370, 20, "Change font of 3rd line to Apple Chancery and get text", #PB_Button_MultiLine)

While WindowEvent()
Wend

Bounds\x = 5
Bounds\y = 5
Bounds\Width = WindowWidth(0) - 10
Bounds\Height = 80

TXNCreateObject(@Bounds, 0, @TXNObject)
TXNAttachObjectToWindowRef(TXNObject, WindowID(0))
TXNSetData(TXNObject, #kTXNTextData, @Text, Len(Text) - 1, 0, 0)
TXNSetFrameBounds(TXNObject, 5, 5, 80, WindowWidth(0) - 10, 0)
TXNUpdate(TXNObject)
TXNFocus(TXNObject, #True)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_Gadget
      If EventType() = #PB_EventType_LeftClick
        If EventGadget() = 0
          DisableGadget(0, #True)
          FontID = ChangeFont(TXNObject, "Apple Chancery")
          MessageRequester("Editor contents info", GetEditorText(TXNObject, FontID))
        EndIf
      EndIf
  EndSelect
ForEver

[WilliamL]

Thanks shardik!

Now that we have some new features in the Editor gadget (by API) I'd like to see them incorporated into PureBasic...

Maybe after the summer break.