PureBasic Forums - English

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

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.
; ===========================================================================================================

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 
; ...