Some Color and Stuff for the EditorGadget...

Share your advanced PureBasic knowledge/code with the community.
BarryG
Addict
Addict
Posts: 3324
Joined: Thu Apr 18, 2019 8:17 am

Re: Some Color and Stuff for the EditorGadget...

Post by BarryG »

This code is great, but XOR'ing the existing styles doesn't seem to work when selecting all text, or all text in a line? Like if Ctrl+A is used to select all text, or even triple-clicking a line, I lose italics when just trying to add or remove bold to the selection. Can this be fixed? I also assume this problem exists when changing the font of the selection? (I didn't try that yet).

Below is an animation of what I mean. I don't want to lose the italics at all.

Image

Code: Select all

CompilerIf Defined(ENM_LINK, #PB_Constant)
CompilerElse
  #ENM_LINK = $04000000
CompilerEndIf
CompilerIf Defined(CFM_LINK, #PB_Constant)
CompilerElse
  #CFM_LINK = $00000020
CompilerEndIf
CompilerIf Defined(CFE_LINK, #PB_Constant)
CompilerElse
  #CFE_LINK = $0020
CompilerEndIf
CompilerIf Defined(CFE_SUBSCRIPT, #PB_Constant)
CompilerElse
  #CFE_SUBSCRIPT = $00010000
CompilerEndIf
CompilerIf Defined(CFE_SUPERSCRIPT, #PB_Constant)
CompilerElse
  #CFE_SUPERSCRIPT = $00020000
CompilerEndIf
CompilerIf Defined(CFM_SUBSCRIPT, #PB_Constant)
CompilerElse
  #CFM_SUBSCRIPT = #CFE_SUBSCRIPT | #CFE_SUPERSCRIPT
  #CFM_SUPERSCRIPT=#CFM_SUBSCRIPT
CompilerEndIf
CompilerIf Defined(CFM_BACKCOLOR, #PB_Constant)
CompilerElse
  #CFM_BACKCOLOR =$4000000
CompilerEndIf


;-Declares.
Declare Editor_BackColor(Gadget, Color.l)
Declare Editor_Color(Gadget, Color.l)
Declare Editor_Font(Gadget, FontName.s)
Declare Editor_FontSize(Gadget, Fontsize.l)
Declare Editor_Format(Gadget, flags, alternate=0)
Declare Editor_Select(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)   
Declare Editor_Bulleted(Gadget)
Declare Editor_JustifyParagraph(Gadget, justify)
Declare Editor_CopyText(gadget)
Declare Editor_CutText(gadget)
Declare Editor_InsertText(gadget,Text$)
Declare Editor_PasteText(gadget)
Declare.l Editor_LoadRTF(gadget, filename.s, replaceall=0)
Declare.l Editor_StreamFileInCallback(dwCookie, pbBuff, cb, pcb)
Declare.l Editor_SaveRTF(gadget, filename.s)
Declare.l Editor_StreamFileOutCallback(dwCookie, pbBuff, cb, pcb)


;-----------------------------------------------Character formatting.
Procedure Editor_BackColor(Gadget, Color.l)
  format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)
  format\dwMask = #CFM_BACKCOLOR
  format\crBackColor = Color
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

; Set the Text color for the Selection
; in RGB format
Procedure Editor_Color(Gadget, Color.l)
  format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)
  format\dwMask = #CFM_COLOR
  format\crTextColor = Color
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

; Set Font for the Selection
; You must specify a font name, the font doesn't need
; to be loaded
Procedure Editor_Font(Gadget, FontName.s)
  format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)
  format\dwMask = #CFM_FACE
  PokeS(@format\szFaceName, FontName)
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

; Set Font Size for the Selection
; in pt
Procedure Editor_FontSize(Gadget, Fontsize.l)
  format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)
  format\dwMask = #CFM_SIZE
  format\yHeight = FontSize*20
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

; Set Format of the Selection. This can be a combination of
; the following values:
; #CFE_BOLD
; #CFE_ITALIC
; #CFE_UNDERLINE
; #CFE_STRIKEOUT
; #CFE_LINK
; #CFE_SUBSCRIPT
; #CFE_SUPERSCRIPT
;If the optional parameter 'alternate' is non-zero then the formatting attributes specified in
;'flags' will be xored with those already present within the first character of the selection.
;This has the effect of removing individual attributes if already present.
;E.g. specifying #CFE_BOLD on an already bold selection, will remove the bold formatting etc.
Procedure Editor_Format(Gadget, flags, alternate=0)
  hWnd = GadgetID(Gadget)
  format.CHARFORMAT2\cbSize = SizeOf(CHARFORMAT2)
  If alternate
    SendMessage_(hWnd, #EM_GETCHARFORMAT, 1, @format)
    flags = format\dwEffects ! flags
  EndIf
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE|#CFM_LINK|#CFM_SUBSCRIPT|#CFM_SUPERSCRIPT
  format\dwEffects = flags
  SendMessage_(hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

; Selects Text inside an EditorGadget
; Line numbers range from 0 to CountGadgetItems(#Gadget)-1
; Char numbers range from 1 to the length of a line
; Set Line numbers to -1 to indicate the last line, and Char
; numbers to -1 to indicate the end of a line
; selecting from 0,1 to -1, -1 selects all.
Procedure Editor_Select(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)   
  hWnd = GadgetID(Gadget)
  sel.CHARRANGE\cpMin = SendMessage_(hWnd, #EM_LINEINDEX, LineStart, 0) + CharStart - 1
  If LineEnd = -1
    LineEnd = SendMessage_(hWnd, #EM_GETLINECOUNT, 0, 0) - 1
  EndIf
  sel\cpMax = SendMessage_(hWnd, #EM_LINEINDEX, LineEnd, 0)
  If CharEnd = -1
    sel\cpMax + SendMessage_(hWnd, #EM_LINELENGTH, sel\cpMax, 0)
  Else
    sel\cpMax + CharEnd - 1
  EndIf
  SendMessage_(hWnd, #EM_EXSETSEL, 0, @sel)
EndProcedure


;-----------------------------------------------Paragraph formatting.
Procedure Editor_Bulleted(Gadget)
  format.PARAFORMAT
  format\cbSize = SizeOf(PARAFORMAT)
  format\dwMask = #PFM_NUMBERING   
  format\wnumbering = #PFN_BULLET
  SendMessage_(GadgetID(Gadget), #EM_SETPARAFORMAT, 0, @format)
EndProcedure

;Set paragraph justification.
;Can be one of the following values:
; #PFA_LEFT   
; #PFA_RIGHT   
; #PFA_CENTER   
Procedure Editor_JustifyParagraph(Gadget, justify)
  format.PARAFORMAT
  format\cbSize = SizeOf(PARAFORMAT)
  format\dwMask = #PFM_ALIGNMENT
  format\wAlignment = justify
  SendMessage_(GadgetID(Gadget), #EM_SETPARAFORMAT, 0, @format)
EndProcedure


;-----------------------------------------------Clipboard.
Procedure  Editor_CopyText(gadget)
  SendMessage_(GadgetID(gadget), #WM_COPY,0,0)   
EndProcedure

Procedure  Editor_CutText(gadget)
  SendMessage_(GadgetID(gadget), #WM_CUT,0,0)   
EndProcedure

Procedure Editor_InsertText(gadget,Text$)
  ProcedureReturn SendMessage_(GadgetID(gadget),#EM_REPLACESEL,0,Text$)
EndProcedure

Procedure  Editor_PasteText(gadget)
  SendMessage_(GadgetID(gadget), #WM_PASTE,0,0)   
EndProcedure


;-----------------------------------------------Streaming.

;***********************************************************************************************
;The following procedure loads an rtf file into an editor gadget.
;Returns zero if no error encountered.
;***********************************************************************************************
;The optional parameter 'replaceall' can be set to #SFF_SELECTION to replace the current selection only.
Procedure.l Editor_LoadRTF(gadget, filename.s, replaceall=0)
  Protected edstr.EDITSTREAM
  edstr\dwCookie = ReadFile(#PB_Any, filename)
  If edstr\dwCookie
    edstr\dwError = 0
    edstr\pfnCallback = @Editor_StreamFileInCallback()
    SendMessage_(GadgetID(gadget), #EM_STREAMIN, #SF_RTF|replaceall, edstr)
    CloseFile(edstr\dwCookie)
    ProcedureReturn edstr\dwError
  Else
    ProcedureReturn 1
  EndIf
EndProcedure
;The following is called repeatedly by Windows to stream data into an editor gadget from an external file.
Procedure.l Editor_StreamFileInCallback(dwCookie, pbBuff, cb, pcb)
  Protected result, length
  result=0
  length=ReadData(dwCookie, pbBuff, cb)
  PokeL(pcb, length)
  If length = 0
    result = 1
  EndIf
  ProcedureReturn result
EndProcedure


;***********************************************************************************************
;The following procedure saves the rtf content of an editor gadget to an external file.
;Returns zero if no error encountered.
;***********************************************************************************************
Procedure.l Editor_SaveRTF(gadget, filename.s)
  Protected edstr.EDITSTREAM
  edstr\dwCookie = CreateFile(#PB_Any, filename)
  If edstr\dwCookie
    edstr\dwError = 0
    edstr\pfnCallback = @Editor_StreamFileOutCallback()
    SendMessage_(GadgetID(gadget), #EM_STREAMOUT, #SF_RTF, edstr)
    CloseFile(edstr\dwCookie)
    ProcedureReturn edstr\dwError
  Else
    ProcedureReturn 1
  EndIf
EndProcedure
;The following is called repeatedly by Windows to stream data from an editor gadget to an external file.
Procedure.l Editor_StreamFileOutCallback(dwCookie, pbBuff, cb, pcb)
  Protected result, length
  result=0
  WriteData(dwCookie, pbBuff, cb)
  PokeL(pcb, cb)
  If cb = 0
    result = 1
  EndIf
  ProcedureReturn result
EndProcedure

; -------------------------------------------------------------
; Source Example:


#Editor = 1
#BoldButton = 2

If OpenWindow(0, 0, 0, 500, 205, "",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  
  EditorGadget(#Editor, 10, 10, 480, 150)
  AddGadgetItem(#Editor, 0, "This is a blue, bold and italic big text")     
  AddGadgetItem(#Editor, 1, "Times new Roman, background red, striked out and italic")   
  AddGadgetItem(#Editor, 2, "LINK")   
  AddGadgetItem(#Editor, 3, "This issubscript")
  AddGadgetItem(#Editor, 4, "This issuperscript")
  AddGadgetItem(#Editor, 5, "Bulleted 1")
  AddGadgetItem(#Editor, 6, "Bulleted 2")
  
  ButtonGadget(#BoldButton, 9, 170, 150, 24, "Toggle selection bold")
  
  ;The following line temporarily hides the selection whilst we format the text,
  SendMessage_(GadgetID(#Editor),#EM_HIDESELECTION,1,0)
  
  Editor_Select(#Editor, 0, 1, 0, -1)  ; select line 1
  Editor_Color(#Editor, RGB(0,0,255))
  Editor_FontSize(#Editor, 20)
  Editor_Format(#Editor, #CFE_BOLD|#CFE_ITALIC)
  ;      Editor_Format(#Editor, #CFE_ITALIC,1)
  
  
  Editor_Select(#Editor, 1, 1, 1, -1)  ; select line 2
  Editor_Font(#Editor, "Times New Roman")
  Editor_Format(#Editor, #CFE_ITALIC|#CFE_STRIKEOUT)
  Editor_Backcolor(#Editor, #Red)
  Editor_JustifyParagraph(#Editor,#PFA_CENTER)
  
  Editor_Select(#Editor, 2, 1, 2, -1)  ; select line 2
  Editor_Format(#Editor, #CFE_LINK)
  ;      Editor_Format(#Editor, #CFE_LINK,1)
  
  Editor_Select(#Editor, 3, 8, 3, -1)
  Editor_Format(#Editor, #CFE_SUBSCRIPT|#CFE_BOLD)
  
  Editor_Select(#Editor, 4, 8, 4, -1)
  Editor_Format(#Editor, #CFE_SUPERSCRIPT|#CFE_BOLD)
  
  Editor_Select(#Editor, 5, 1, 6, -1)
  Editor_Bulleted(#Editor)
  
  Editor_Select(#Editor, 0, 0, 0, 0)   ; select nothing again
  
  SendMessage_(GadgetID(#Editor),#EM_HIDESELECTION,0,0)
  
  ;Uncomment the following to save the contents of the editor gadget in rich text format.
  ;Editor_SaveRTF(#Editor, "c:\test.rtf")
  
  Repeat
    ev=WaitWindowEvent()
    If ev=#PB_Event_Gadget And EventGadget()=#BoldButton
      Editor_Format(#Editor, #CFE_BOLD, 1)
    EndIf
  Until ev = #PB_Event_CloseWindow
  
EndIf 
JHPJHP
Addict
Addict
Posts: 2129
Joined: Sat Oct 09, 2010 3:47 am
Contact:

Re: Some Color and Stuff for the EditorGadget...

Post by JHPJHP »

Hi BarryG,

Working as expected; see Microsoft quote below.
- make sure when you select the entire top line not to include the carriage return.

https://docs.microsoft.com/en-us/window ... charformat
Microsoft wrote:A CHARFORMAT structure that receives the attributes of the first character. The dwMask member specifies which attributes are consistent throughout the entire selection. For example, if the entire selection is either in italics or not in italics, CFM_ITALIC is set; if the selection is partly in italics and partly not, CFM_ITALIC is not set.
Hacky Workaround:

Code: Select all

Repeat
  ev=WaitWindowEvent()
  If ev=#PB_Event_Gadget And EventGadget()=#BoldButton
    SendMessage_(GadgetID(#Editor), #EM_GETSEL, @nStart, @nFinish)
    SendMessage_(GadgetID(#Editor), #WM_SETREDRAW, #False, #Null)

    For x = nStart To nFinish
      SendMessage_(GadgetID(#Editor), #EM_SETSEL, x, x + 1)
      Editor_Format(#Editor, #CFE_BOLD, 1)
    Next
    SendMessage_(GadgetID(#Editor), #WM_SETREDRAW, #True, #Null)
    SendMessage_(GadgetID(#Editor), #EM_SETSEL, nStart, nFinish)
  EndIf
Until ev = #PB_Event_CloseWindow
BarryG
Addict
Addict
Posts: 3324
Joined: Thu Apr 18, 2019 8:17 am

Re: Some Color and Stuff for the EditorGadget...

Post by BarryG »

JHPJHP wrote:Hi BarryG,

Working as expected; see Microsoft quote below.
- make sure when you select the entire top line not to include the carriage return.

https://docs.microsoft.com/en-us/window ... charformat
Microsoft wrote:A CHARFORMAT structure that receives the attributes of the first character. The dwMask member specifies which attributes are consistent throughout the entire selection. For example, if the entire selection is either in italics or not in italics, CFM_ITALIC is set; if the selection is partly in italics and partly not, CFM_ITALIC is not set.
Hacky Workaround:

Code: Select all

Repeat
  ev=WaitWindowEvent()
  If ev=#PB_Event_Gadget And EventGadget()=#BoldButton
    SendMessage_(GadgetID(#Editor), #EM_GETSEL, @nStart, @nFinish)
    SendMessage_(GadgetID(#Editor), #WM_SETREDRAW, #False, #Null)

    For x = nStart To nFinish
      SendMessage_(GadgetID(#Editor), #EM_SETSEL, x, x + 1)
      Editor_Format(#Editor, #CFE_BOLD, 1)
    Next
    SendMessage_(GadgetID(#Editor), #WM_SETREDRAW, #True, #Null)
    SendMessage_(GadgetID(#Editor), #EM_SETSEL, nStart, nFinish)
  EndIf
Until ev = #PB_Event_CloseWindow
Thanks JHPJHP, that works!

And the default behavior is absolutely stupid, IMO. Microsoft Word and Wordpad don't act like that; they both do exactly what your workaround does (and what the user expects).

So I don't agree that your code is "hacky workaround" at all, but is instead a valuable fix. Cheers!
Post Reply