A Simple Font/Size/Color Manager for the EditorGadget.

[offsides]

This is one of those "Standing on the Shoulders of Giants" endeavors. Here, several examples posted over the years by Freak, tsSoft, RASHAD, and others on how to modify font text elements in the EditorGadget, are rolled into one. My only contribution is the parser.

Code: Select all

; AltFont
; A simple program to do elementary RTF-like modifications
; to plain text.
;
; FontIdx --------->[ 1 ] [    2    ] [     3     ] [     4     ]
Global FontList$ = "Arial.Courier New.Comic Sans MS.Segoe Script."

Global ColorList$ = "blu.16711680.grn.65280.red.255.cya.16776960.gray.8421504.wht.16777215.yel.65535.blk.0."
       ColorList$ + "dgrn.$336633.dred.$3300CC.dblu.$cc6600.lgra.$eeeeee."      
;                      Dark Grn  | Dark Red   |  Dark Blue | Light Gray   etc.
; ===========================================================================
; Defaults
Global D_FntIdx = 1  ; <----- DEFAULT FONT from FontList$
Global D_FontName$ = StringField(FontList$, D_FntIdx, ".")
Global D_FontSize = 11
Global D_FontStyle = 0
Global D_FGColor = $000000 ; or $0
Global D_BGColor = $ffffff

Global afd.s = "\"  ; Alt Font Demark. Changeable if conflict.
Global EdBox, Win_mb, Ed_Width, Ed_Height

Declare.s GetFontVars(m$)
Declare SetFontMods()
Declare WinMgr()

Structure AT
  TStart.i   ; Chr location of first letter of text block to be modified
  TEnd.i     ; Chr location of last letter
  TFont.i    ; Font Index
  TSize.i    ; Size in points
  TStyle.i   ; Font Style, i,b,u
  FColor.i   ; Font color, if any. 
  BColor.i   ; Back color
EndStructure

Global NewList AltFont.AT() ; List of text, location, size, style, and
                            ; color of text blocks you want to modify.
; ===========================================================================
WinWidth = 350: WinHeight = 510: RM = 10: LM = 10

Msg$ = "\Main Title\s:20.i.b.u.c:dblu/yel.\||" +  ; load it all up...
       "\First Heading\f:4.s:16.b.c:blu.\|" +   
       "\\chr:169.\In these examples, the \default\i.b.\ font is black." +
       "This font is set to the EditorGadget prior to " +
       "modification by these procedures." +
       "You can modify this text any way you " +
       "wish \so long as you complete\f:3.u.c:dred/lgra.\ " +
       "each mod before you begin another.|" + 
       "\Keep track of all your demarks. A missing one " + 
       "will mess up all following text.\c:blu.\||" +     
       "\Some ''Latin''\f:1.s:16.i.b.c:dgrn.\|" + 
       "Donec dapibus tristique. Mauris" +
       "tib sollicitudin \nunc nulla\u.\ urna Aenean" +
       "Tincidunt ipsum nec neque Praesent|" +
       "\Here's some smaller (8) text.\s:8.\||" +
       "\Third Heading\f:2.b.s:16.i.d.c:dred.\|" +
       "\This is a text block of all one color using " +
       "Comic Sans MS with the default size but " +
       "blue color.\f:3.c:blu.\ \If you want to modify\c:red.\" + 
       "\ this pargraph, you have to split blocks. " +
       "Check out the text code for this paragraph.\f:3.c:blu.\"

Msg$ = ReplaceString(Msg$, "|", #LF$) 
Msg$ = ReplaceString(Msg$, "''", Chr(34))

; ========================================================
;--- MAKE WINDOW
; =============================
WinFlag = #PB_Window_Invisible | #PB_Window_Tool|#PB_Window_SystemMenu | #PB_Window_ScreenCentered|#PB_Window_SizeGadget
Win_mb = OpenWindow(#PB_Any, 0, 0, WinWidth, WinHeight, "", WinFlag)

EdBoxFlag = #PB_Editor_WordWrap
EdBox = EditorGadget(#PB_Any, 5, 5, Ed_Width, Ed_Height, EdBoxFlag )
BindEvent(#PB_Event_SizeWindow, @WinMgr(), Win_mb) 

SendMessage_(GadgetID(EdBox), #EM_SETMARGINS, #EC_LEFTMARGIN, LM|0 << 16) 
SendMessage_(GadgetID(EdBox), #EM_SETMARGINS, #EC_RIGHTMARGIN, 0|RM << 16) 

DefaultFontID = FontID(LoadFont(#PB_Any, D_FontName$, D_FontSize, D_FontStyle))
SetGadgetFont(EdBox, DefaultFontID)
; -----------------------------------------------------------------------------
PlainText$ = GetFontVars(Msg$)       ; Get font info, strip Msg$ of font stuff.
   SetGadgetText(EdBox, PlainText$) ; Set raw text to EdBox
   SetFontMods()                     ; Modify to suit.
; -----------------------------------------------------------------------------
HideWindow(Win_mb, 0) 

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow 

; ========================================================
; =================================
;--- MAP TEXT for LOCN & FONT INFO
; =================================
Procedure.s GetFontVars(Msg$)

; For each text block...
tStart = FindString(Msg$, afd)
While tStart
  FIdx = D_FntIdx: Style = D_FontStyle: Size = D_FontSize: FClr = D_FGColor: BClr = D_BGColor: ClrCalc = 0 ; Set defaults each time.
  tEnd = FindString(Msg$, afd, tStart+1) 
  cEnd = FindString(Msg$, afd, tEnd+1)
  CmdList$ = Mid(Msg$, tEnd+1, cEnd - tEnd-1)
  
  For i = 1 To CountString(CmdList$, ".")
    Cmd$ = StringField(CmdList$, i, ".") ; ea cmd
    Dm = FindString(Cmd$, ":")           ; cmd arg?
    If Dm
      CKey$ = Left(Cmd$, Dm)
      CVal$ = RemoveString(Cmd$, CKey$)
      CVal = Val(CVal$)
    Else
      CKey$ = Cmd$
    EndIf
    
    Select CKey$
      Case "b": Style | #CFM_BOLD      ; Styles  
      Case "i": Style | #CFM_ITALIC        
      Case "u": Style | #CFM_UNDERLINE 
      Case "f:": FIdx = CVal           ; Font Index           
      Case "s:": Size = CVal           ; Size            
      Case "c:"
        Dm = FindString(CVal$, "/") ; ie. fg/bg 
        If Dm
          FG$ = Left(CVal$, Dm-1)
          BG$ = Right(CVal$, Len(CVal$)-Dm)
        Else
          FG$ = CVal$          
        EndIf
        ; always get fg
        P1 = FindString(ColorList$, FG$)
        P2 = P1 + Len(FG$)+1
        P3 = FindString(ColorList$, ".", P2)
        FClr = Val(Mid(ColorList$, P2, P3-P2)) 
        If Dm ; get bg
          P1 = FindString(ColorList$, BG$)
          P2 = P1 + Len(BG$)+1
          P3 = FindString(ColorList$, ".", P2)
          BClr = Val(Mid(ColorList$, P2, P3 - P2))
        EndIf       
    EndSelect
  Next
  Msg$ = RemoveString(Msg$, afd, #PB_String_NoCase, tStart, 2)            ; Remove 1st two demarks
  Msg$ = RemoveString(Msg$, CmdList$ + afd, #PB_String_NoCase, tStart, 1) ; Remove CmdList$ + 3rd demark.
  
  AddElement(AltFont())
  
  AltFont()\TStart = tStart-1  ;-1   ;  because 1st afd was del.
  AltFont()\TEnd = tEnd-2            ;  ... and so is the 2nd.
  AltFont()\TFont = FIdx
  AltFont()\TSize = Size
  AltFont()\TStyle = Style
  AltFont()\FColor = FClr
  AltFont()\BColor = BClr

  tStart = FindString(Msg$, afd, tEnd-1)  ; Go get the next one.
Wend
ProcedureReturn Msg$ ; Msg$ clear of all dmks and cmds
EndProcedure

; =============================
;--- INSERT FONT MODS
; =============================
Procedure SetFontMods ()

If ListSize(AltFont())
  #CFM_BACKCOLOR = $4000000  
  chr.charformat2\cbSize = SizeOf(CHARFORMAT2)
  sel.CHARRANGE
  
  ForEach  AltFont() ;...Block of text   
    ; ---- SET TEXT SELECTION  ---------------
    SendMessage_(GadgetID(EdBox),#EM_SETSEL, AltFont()\TStart, AltFont()\TEnd)
    chr.CHARFORMAT2
    chr\cbSize = SizeOf(CHARFORMAT2)
    
    ; ---- FONT ------------------------------
    FontName$ = StringField(FontList$, AltFont()\TFont, ".") 
    chr\cbSize = SizeOf(CHARFORMAT2)
    chr\dwMask = #CFM_FACE
    PokeS(@chr\szFaceName, FontName$)
    SendMessage_(GadgetID(EdBox), #EM_SETCHARFORMAT, #SCF_SELECTION, chr)     
    ; ---- SIZE ------------------------------    
    chr\dwMask = #CFM_SIZE
    chr\yHeight = AltFont()\TSize*20   ; Convert points to "twips" for EG
    SendMessage_(GadgetID(EdBox), #EM_SETCHARFORMAT, #SCF_SELECTION, chr)     
    ; ---- COLOR -----------------------------    
    chr\dwMask = #CFM_BACKCOLOR|#CFM_COLOR    
    chr\crTextColor = AltFont()\FColor
    chr\crBackColor = AltFont()\BColor
    SendMessage_(GadgetID(EdBox), #EM_SETCHARFORMAT, #SCF_SELECTION, chr)     
    ; ---- STYLE -----------------------------    
    chr\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_UNDERLINE  ; Could also add the others.
    chr\dwEffects = AltFont()\TStyle 
    SendMessage_(GadgetID(EdBox), #EM_SETCHARFORMAT, #SCF_SELECTION, chr)
  Next
  SendMessage_(GadgetID(EdBox),#EM_SETSEL,0,0)  ; Clear the selection.
EndIf

EndProcedure

Procedure WinMgr()
  Ed_Width = WindowWidth(Win_mb) - 10      
  Ed_Height = WindowHeight(Win_mb) - 10 
  ResizeGadget(EdBox, 5, 5, Ed_Width, Ed_Height)
  SetWindowTitle(Win_mb, Str(Ed_Width) + " X " + Str(Ed_Height))  
EndProcedure

[dcr3]

Nice.

My only contribution is the parser.

Not so .

[offsides]

Thanks, dcr3.

I didn't want to puff up the original post too much so I left off some notes that might be handy for those that want to play around with this:

Code: Select all

; ===========================================================================================================
; Ver. 0.74
; ---------------------------------
; Each block of text you want to modify is surrounded by demarks, typically "\".
; This is followed by the List of font mods you want to apply to each block,
; followed by a final demark.

; The available commands are
; 
; fN.  The font name index, N
; sN.  The font size, in N points
; c$.  Font Color$, fore/back, names below
; i.   Italic
; d.   Bold
; u.   Underline

; Like this:
;          [Text block to change] [  Commands list  ]
; Syntax: \ ....             ....\  fN.sN.i.d.u.c$.  \
; 
; o  The "base" font is the default font. It remains in effect wherever a change has NOT
;    been ordered. Changes occur only to the text that is marked ( \.....\ cmd \ ). Changes
;    do not "linger", as in RTF, but are reset to default after each operation.

; o  Nested text blocks are not supported. Each one has to be processed individually and
;    completely before the next one can be approached. That means the default font can
;    marked up as much as you want, but not one that's being changed.

; o  For anything longer than a few lines, it's best to compose the text raw, get it
;    the way you want it, then add the cmd syntax which is removed during processing.

; o  Word wrap is your friend.

; o  Commands can be entered in any order, just follow each with a ".".

; o  You do not have to define each font element, only those that depart from the default.
; ===========================================================================================================

[ebs]

Thanks for this - it's very handy.
I needed a 'strike-through' font style, and it was easy to add.

[offsides]

ebs, you're welcome. Glad it worked out.

Bill

[idle]

thanks for sharing.

[RASHAD]

Thanks Bill for this fine piece of code
Thanks for sharing it

[offsides]

Thank YOU, RASHAD, for your many contributions to the PB forums over the years.
Bill

[Kwai chang caine]

Works well here
Thanks for sharing

[Axolotl]

Hey offsides,

nice idea and thanks for sharing.
I just had a quick look at the source text and noticed that the following lines should read differently.
Or I did not understand it. (which unfortunately can always be)

Code: Select all

; ... 
; f:N.  The font name index, N      ; <== Colon between f,s,c and N  
; s:N.  The font size, in N points 
; c:$.  Font Color$, fore/back, names below 
; ...

[offsides]

Axolotl,

Nope, you're right. You caught a little version drift in the docs, there.
The final (posted) syntax requires a ":" between a key letter and it's value. An earlier version didn't and the text discrepancy you found was from the earlier one.
Actually, the colon isn't necessary as long as the keys are single chrs. It's just easier to read with the colon, especially when entering alpha names for the color.
Sorry for the confusion.

Bill