Some Color and Stuff for the EditorGadget...

Share your advanced PureBasic knowledge/code with the community.
Post Reply
Shannara
Addict
Addict
Posts: 1808
Joined: Thu Oct 30, 2003 11:19 pm
Location: Emerald Cove, Unformed

Post by Shannara »

Hroudtwolf wrote:once more....

Code: Select all

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



 Procedure  CopyEditorText(gadget)
 SendMessage_(GadgetID(gadget), #WM_COPY,0,0)    
 EndProcedure
 
 Procedure InsertEditorText(gadget,Text$)
  ProcedureReturn SendMessage_(GadgetID(gadget),#EM_REPLACESEL,0,Text$)
EndProcedure
Heh, replied to the correct thread?
Top
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

Update: the Editor_Format() command now has an optional parameter:

Code: Select all

Editor_Format(Gadget, flags, alternate=0)
Setting 'alternate' to non-zero when calling this procedure will cause the formatting attributes specified in 'flags' to 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.

********************************

Original post:
Stumbled across this whilst in search for some convenient 'wrappers' for the tedious business of formatting the contents of rich edit controls etc.

This is excellent - thanks Freak. Just what I was after. :D

Have taken the opportunity to update the code for PB4 and to also add some basic paragraph formatting (justification, bullets etc.) routines. Also updated the streaming functions a little.

Code: Select all

;Some useful functions for formatting text and paragraphs within EditorGadgets.
;By Freak.
;Additions by Hroudtwolf and srod.


;Future proof!
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 StreamFileInCallback(dwCookie, pbBuff, cb, pcb) 
Declare.l Editor_SaveRTF(gadget, filename.s)
Declare.l 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) 
  format.CHARFORMAT2 
  format\cbSize = SizeOf(CHARFORMAT2) 
  If alternate
    SendMessage_(GadgetID(Gadget), #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_(GadgetID(Gadget), #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)    
  sel.CHARRANGE 
  sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1 
  
  If LineEnd = -1 
    LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1 
  EndIf 
  sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0) 
  
  If CharEnd = -1 
    sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0) 
  Else 
    sel\cpMax + CharEnd - 1 
  EndIf 
  SendMessage_(GadgetID(Gadget), #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 = @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 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 = @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 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 

If OpenWindow(0, 0, 0, 600, 500, "",#PB_Window_SystemMenu|#PB_Window_ScreenCentered) 
  If CreateGadgetList(WindowID(0)) 
    
    EditorGadget(#Editor, 10, 10, 580, 480) 
    AddGadgetItem(#Editor, 0, "This is a blue, bold and underlined 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") 

;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, 28) 
      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 
    Until WaitWindowEvent() = #PB_Event_CloseWindow 
  EndIf 
EndIf 

End
Regards.
Last edited by srod on Fri Jul 07, 2006 10:10 pm, edited 1 time in total.
I may look like a mule, but I'm not a complete ass.
Top
User avatar
Joakim Christiansen
Addict
Addict
Posts: 2452
Joined: Wed Dec 22, 2004 4:12 pm
Location: Norway
Contact:
Contact Joakim Christiansen

Post by Joakim Christiansen »

And here is some functions I made to save the RTF format in a buffer:

Code: Select all

Global RTFLength

Procedure.l GetRTFCallback(dwCookie.l,pbBuff.l,cb.l,*pcb.LONG)
  CopyMemory(pbBuff,dwCookie+RTFLength,cb)
  RTFLength + cb
  *pcb\l = cb
  ProcedureReturn 0
EndProcedure
Procedure.l GetRTFLenCallback(dwCookie.l,pbBuff.l,cb.l,*pcb.LONG)
  RTFLength + cb
  *pcb\l = cb
  ProcedureReturn 0
EndProcedure

Procedure GetRTF(Gadget.l,Adress.l)
  Protected Stream.EDITSTREAM
  Stream\dwCookie = Adress
  Stream\pfnCallback = @GetRTFCallback()
  RTFLength = 0
  SendMessage_(GadgetID(Gadget),#EM_STREAMOUT,#SF_RTF,@Stream)
EndProcedure
Procedure.l GetRTFLen(Gadget.l)
  Protected Stream.EDITSTREAM
  Stream\pfnCallback = @GetRTFLenCallback()
  RTFLength = 0
  SendMessage_(GadgetID(Gadget),#EM_STREAMOUT,#SF_RTF,@Stream)
  ProcedureReturn RTFLength
EndProcedure
And how to use it:

Code: Select all

FreeMemory(*Buffer)
*Buffer = AllocateMemory(GetRTFLen(#Editor))
GetRTF(#Editor,*Buffer)
ClearGadgetItemList(#Editor)
SetGadgetText(#Editor,PeekS(*Buffer))
Original thread:
http://www.purebasic.fr/english/viewtopic.php?t=22443
I like logic, hence I dislike humans but love computers.
Top
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

Update: the Editor_Format() command now has an optional parameter:

Code: Select all

Editor_Format(Gadget, flags, alternate=0)
Setting 'alternate' to non-zero when calling this procedure will cause the formatting attributes specified in 'flags' to 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.


See my post above for the code.
I may look like a mule, but I'm not a complete ass.
Top
npath
User
User
Posts: 74
Joined: Tue Feb 15, 2005 5:15 pm

Post by npath »

Just thought that I would add a few procedures that I use when working with the editor gadget:

Code: Select all

Procedure.s Editor_GetSelectedText(Gadget)
  cr.CHARRANGE
  SendMessage_(GadgetID(Gadget), #EM_EXGETSEL, 0, @cr)
  TextLen.l = cr\cpMax - cr\cpMin
  sTemp.s = Space((TextLen * 2) + 1)
  SendMessage_(GadgetID(Gadget), #EM_GETSELTEXT, 0, @sTemp)
  ProcedureReturn sTemp
EndProcedure

Procedure.l Editor_GetCaretPosition(Gadget)
  selStart.l
  selEnd.l
  SendMessage_(GadgetID(Gadget), #EM_GETSEL, @selStart, @selEnd)
  ProcedureReturn selStart
EndProcedure

Procedure Editor_CapSelection(Gadget)
  selected.s = Editor_GetSelectedText(Gadget)
  selected = UCase(selected)
  *sText.s = selected
  SendMessage_(GadgetID(Gadget), #EM_REPLACESEL, 1, *sText)
EndProcedure

Procedure Editor_SetSelection(Gadget, start.l, finish.l)
  SendMessage_(GadgetID(Gadget), #EM_SETSEL, start, finish)
EndProcedure
npath
Last edited by npath on Thu Dec 06, 2007 6:15 am, edited 1 time in total.
Top
npath
User
User
Posts: 74
Joined: Tue Feb 15, 2005 5:15 pm

Post by npath »

Forgot this one:

Code: Select all

Procedure.l Editor_FindTextPosition(Gadget, startPosition.l, searchString.s)
  ft.FINDTEXTEX
  SendMessage_(GadgetID(Gadget), #EM_SETSEL, startPosition, startPosition)
  SendMessage_(GadgetID(Gadget), #EM_EXGETSEL, 0, @ft\chrg) 
  ft\chrg\cpMax = -1
  ft\lpstrText = @searchString 
  location.l = SendMessage_(GadgetID(Gadget), #EM_FINDTEXTEX, (#FR_DOWN Or #FR_MATCHCASE), @ft)
  
  ProcedureReturn location ; Returns -1 if the search string is not found.
EndProcedure
npath
Top
User avatar
greyhoundcode
Enthusiast
Enthusiast
Posts: 112
Joined: Sun Dec 30, 2007 7:24 pm

A late entry ...

Post by greyhoundcode »

I was looking for a method of formatting the contents of the editor gadget, and stumbled across this topic - what a breath of fresh air, easy to understand and easy to implement.

Very happy with the source provided - thanks for that Freak.

Nonetheless I must ask for one more refinement, should someone out there be able to supply it. I would like to use tabulation to set out the information within the gadget. Right now I am using the Courier New font, because of its uniform spacing, which allows me to create tabulation on the basis of counting the number of spaces required.

However it would add a final gloss to be able to use, say Arial, but still have the contents neatly aligned. Is there a straightforward solution to this - I'll be honest - if it's complicated to implement then I probably will not use it.

Thanks for any help! Vive la PureBasic!
Top
PB
PureBasic Expert
PureBasic Expert
Posts: 7581
Joined: Fri Apr 25, 2003 5:24 pm

Re: A late entry ...

Post by PB »

Freak's original code ported to PureBasic v4.31:

Code: Select all

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

; Updated for PureBasic v4.31 by PB in 2009.

Procedure Editor_Select(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)
  sel.CHARRANGE
  sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1

  If LineEnd = -1
    LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1
  EndIf
  sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0)

  If CharEnd = -1
    sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0)
  Else
    sel\cpMax + CharEnd - 1
  EndIf
  SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel)
EndProcedure

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

; Set Font Size for the Selection
; in pt
Procedure Editor_FontSize(Gadget, Fontsize.l)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_SIZE
  format\yHeight = FontSize*20
  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.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_FACE
  PokeS(@format\szFaceName, FontName)
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

; Set Format of the Selection. This can be a combination of
; the following values:
; #CFM_BOLD
; #CFM_ITALIC
; #CFM_UNDERLINE
; #CFM_STRIKEOUT
Procedure Editor_Format(Gadget, Flags.l)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
  format\dwEffects = Flags
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure


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


#Editor = 1

If OpenWindow(0, 0, 0, 500, 500, "EditorGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  EditorGadget(#Editor, 10, 10, 480, 480)

  AddGadgetItem(#Editor, 0, "This is a blue, bold and underlined big text")
  AddGadgetItem(#Editor, 1, "Times new Roman, red, striked out and italic")
  AddGadgetItem(#Editor, 2, "This is usual Text.")


  Editor_Select(#Editor, 0, 1, 0, -1)  ; select line 1
    Editor_Color(#Editor, RGB(0,0,255))
    Editor_FontSize(#Editor, 18)
    Editor_Format(#Editor, #CFM_UNDERLINE)

  Editor_Select(#Editor, 1, 1, 1, -1)  ; select line 2
    Editor_Color(#Editor, RGB(255,0,0))
    Editor_Font(#Editor, "Times New Roman")
    Editor_Format(#Editor, #CFM_ITALIC|#CFM_STRIKEOUT)

  Editor_Select(#Editor, 0, 0, 0, 0)   ; select nothing again


  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
I compile using 5.31 (x86) on Win 7 Ultimate (64-bit).
"PureBasic won't be object oriented, period" - Fred.
Top
User avatar
[blendman]
Enthusiast
Enthusiast
Posts: 297
Joined: Thu Apr 07, 2011 1:14 pm
Location: 3 arks
Contact:
Contact [blendman]

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

Post by [blendman] »

Hi

Sorry To bump an old thread, but how can I have a normal font after to have use a Bold font ?

Editor_Format(Gadget, #CFM_BOLDl) => Editor_Format(Gadget, ????)

Thank you for this Code , very usefull !
Top
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

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

Post by ts-soft »

Code: Select all

EnableExplicit

Procedure Editor_Format(Gadget, Flags.l)
  Protected format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
  format\dwEffects = Flags
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

OpenWindow(0, #PB_Ignore, #PB_Ignore, 640, 480, "")
EditorGadget(0, 5, 5, 630, 470)

Editor_Format(0, #CFM_BOLD)
AddGadgetItem(0, -1, "The quick brown fox jumps over the lazy dog")

Editor_Format(0, 0)
AddGadgetItem(0, -1, "The quick brown fox jumps over the lazy dog")

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
Top
Mesa
Enthusiast
Enthusiast
Posts: 433
Joined: Fri Feb 24, 2012 10:19 am

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

Post by Mesa »

Take a look at the srod's (excellent) post just above (jul 03 2006 7:42pm) or try this

Code: Select all

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

; Updated for PureBasic v4.31 by PB in 2009.

Procedure Editor_Select(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)
  sel.CHARRANGE
  sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1

  If LineEnd = -1
    LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1
  EndIf
  sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0)

  If CharEnd = -1
    sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0)
  Else
    sel\cpMax + CharEnd - 1
  EndIf
  SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel)
EndProcedure

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

; Set Font Size for the Selection
; in pt
Procedure Editor_FontSize(Gadget, Fontsize.l)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_SIZE
  format\yHeight = FontSize*20
  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.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_FACE
  PokeS(@format\szFaceName, FontName)
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

; Set Format of the Selection. This can be a combination of
; the following values:
; #CFM_BOLD
; #CFM_ITALIC
; #CFM_UNDERLINE
; #CFM_STRIKEOUT
Procedure Editor_Format(Gadget, Flags.l, noFlag.l=-1)
  
  If noFlag <>-1
    format.CHARFORMAT
    format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
    oldformat=SendMessage_(GadgetID(Gadget), #EM_GETCHARFORMAT, #SCF_SELECTION, @format)
   Debug format\dwEffects
   format\dwEffects = format\dwEffects & ~noFlag
   Debug format\dwEffects
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
  Else
  
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
  format\dwEffects = Flags
  Debug format\dwEffects
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
  EndIf
EndProcedure


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


#Editor = 1

If OpenWindow(0, 0, 0, 500, 500, "EditorGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  EditorGadget(#Editor, 10, 10, 480, 480)

  AddGadgetItem(#Editor, 0, "This is a blue, bold and underlined big text")
  AddGadgetItem(#Editor, 1, "Times new Roman, red, striked out and italic")
  AddGadgetItem(#Editor, 2, "This is usual Text.")


  Editor_Select(#Editor, 0, 1, 0, -1)  ; select line 1
    Editor_Color(#Editor, RGB(0,0,255))
    Editor_FontSize(#Editor, 12)
    Editor_Format(#Editor, #CFM_BOLD|#CFM_UNDERLINE)

  Editor_Select(#Editor, 1, 1, 1, -1)  ; select line 2
    Editor_Color(#Editor, RGB(255,0,0))
    Editor_Font(#Editor, "Times New Roman")
    Editor_Format(#Editor, #CFM_ITALIC|#CFM_STRIKEOUT)

    
    
;     Editor_Select(#Editor, 2, 1, 2, -1)  ; select line 2
;     Editor_Color(#Editor, RGB(0,0,0))
;     Editor_FontSize(#Editor, 12)
;     Editor_Format(#Editor, 0) ; reset all format
    
    Editor_Select(#Editor, 0, 10, 0, 20)  ; select line 1
    Editor_Color(#Editor, RGB(255,0,0))
    Editor_FontSize(#Editor, 12)
    Editor_Format(#Editor,  0,#CFM_BOLD) ; NO Bold
    
    Editor_Select(#Editor, 0, 30, 0, 40)  ; select line 1
    Editor_Color(#Editor, RGB(255,255,0))
    Editor_FontSize(#Editor, 12)
    Editor_Format(#Editor,  0,#CFM_UNDERLINE) ; NO underline
    
    Editor_Select(#Editor, 0, 0, 0, 0)   ; select nothing again

  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
Mesa.
Top
tbohon
User
User
Posts: 42
Joined: Sat Nov 22, 2008 4:22 am
Location: Olympia, WA USA

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

Post by tbohon »

Some really great stuff here guys ... I've learned a lot from reading and experimenting with the various posts.

My problem is slightly different from changing the color of a highlighted selection and would appreciate any thoughts/guidance on possible fixes.

As the user types in the editor/rtf box I want the data up to but not including the first space to be compared to a list of keywords and, if there is a match, UPPERcase it and set the color of the text as follows:
  • If the contents of the first part of the line are '# ' then the entire line is in green.

    If the contents of the first part of the line matches any word in the keyword list then that word is UPPERcased and set to blue. Only the first word of each line is to be affected, i.e., if a keyword is used elsewhere in a line it is ignored.
Again any thoughts or pointers on how to do this would be most appreciated.

Best,

Tom
Top
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:
Contact IdeasVacuum

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

Post by IdeasVacuum »

I know this post is old, but the code still works 8)

The Procedure Editor_FontSize(Gadget, Fontsize.l) includes this line:

Code: Select all

format\yHeight = FontSize*20
Can anyone tell me what that magic number 20 is?
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Top
User avatar
bbanelli
Enthusiast
Enthusiast
Posts: 544
Joined: Tue May 28, 2013 10:51 pm
Location: Europe
Contact:
Contact bbanelli

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

Post by bbanelli »

https://msdn.microsoft.com/en-us/librar ... 85%29.aspx

yHeight
Type: LONG
Character height, in twips (1/1440 of an inch or 1/20 of a printer's point).

__________________________________________________
Link repaired
19.02.2016
RSBasic
"If you lie to the compiler, it will get its revenge."
Henry Spencer
https://www.pci-z.com/
Top
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:
Contact IdeasVacuum

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

Post by IdeasVacuum »

Aha! Thanks bbanelli.
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Top
Post Reply

Return to “Tricks 'n' Tips”