Changing colour in RichEdit

[netmaestro]

Try this :

Code: Select all

Procedure SetColor(gadget,color) 
  format.CHARFORMAT2 
  format\cbSize = SizeOf(CHARFORMAT2) 
  format\dwMask = #CFM_COLOR 
  format\crTextColor = Color 
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
EndProcedure 

OpenWindow(0, 0, 0, 322, 170, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
CreateGadgetList(WindowID(0)) 
EditorGadget(0, 8, 8, 306, 133) 
TextGadget(1, 80, 150, 200, 20, "Right-Click for Text Color options") 
TextGadget(2, 10, 150, 50, 20, "Text Color")
CreatePopupMenu(0) 
MenuItem(#Red, "Red") 
MenuItem(#Yellow, "Yellow")
MenuItem(#Green, "Green") 
MenuItem(#Black, "Black") 
SetActiveGadget(0) 

Repeat 
  EventID = WaitWindowEvent() 
  Select EventID 
    Case #WM_RBUTTONUP
      DisplayPopupMenu(0, WindowID(0)) 
    Case #PB_Event_Menu 
      SetColor(0, EventMenu()) 
      SetGadgetColor(2, #PB_Gadget_FrontColor, EventMenu())
  EndSelect 
Until EventID = #PB_Event_CloseWindow 

[drahneir]

Ah, netmaestro again, who else. Thank you very much, and yes, your code is working. I have something like yours embedded in my application, which is not working. But now, where I know that it must be working, I will see what is wrong here. Thanks again.

[drahneir]

Well, in my application it doesn't work. The difference between my editor gadget and the one of netmaestro is, that mine is read only as I wrote in my first post. That seems to be the reason for the malfunction.
But before I came to PureBasic, I had the same application realized in Visual Basic, and there it worked. Since both build up on Windows, there must be a solution in PB as well. I will keep on trying.

[HeX0R]

Something like this ?

Code: Select all

Procedure SetColor(Gadget, Color)
	Protected format.CHARFORMAT2, sel.CHARRANGE, sel_saved.CHARRANGE

	format\cbSize      = SizeOf(CHARFORMAT2)
	format\dwMask      = #CFM_COLOR
	format\crTextColor = Color
	SendMessage_(GadgetID(Gadget), #EM_EXGETSEL, 0, @sel)
	CopyMemory(@sel, @sel_saved, SizeOf(CHARRANGE))
	sel\cpMax = -1
	SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel)
	SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
	SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel_saved)
EndProcedure

OpenWindow(0, 0, 0, 322, 170, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CreateGadgetList(WindowID(0))
EditorGadget(0, 8, 8, 306, 133, #PB_Editor_ReadOnly)
AddGadgetItem(0, -1, "This is a stupid Text")
TextGadget(1, 80, 150, 200, 20, "Right-Click for Text Color options")
TextGadget(2, 10, 150, 50, 20, "Text Color")
CreatePopupMenu(0)
MenuItem(#Red, "Red")
MenuItem(#Yellow, "Yellow")
MenuItem(#Green, "Green")
MenuItem(#Black, "Black")
SetActiveGadget(0)

Repeat
	Select WaitWindowEvent()
		Case #WM_RBUTTONUP
			DisplayPopupMenu(0, WindowID(0))
		Case #PB_Event_Menu
			SetColor(0, EventMenu())
			SetGadgetColor(2, #PB_Gadget_FrontColor, EventMenu())
		Case #PB_Event_CloseWindow
			Break
	EndSelect
ForEver

[drahneir]

Thanks, HeXOR, but this is again the problem, that I don't have selected text. Perhaps it is better to explain what I am doing. My application is a kind of radio teletype. From the receiver I get a string of characters, which are displayed in the RX editor, which by nature is read only. These characters are dark blue. When I transmit, the outgoing characters are monitored in the RX editor as well, and these I want to display in red. When receiving again, the color should change to dark blue again. The problem is to change the color from the position on, where new characters are appended.

[srod]

With a slight adjustment...

Code: Select all

Procedure SetColor(Gadget, Color) 
   Protected format.CHARFORMAT2, sel.CHARRANGE, sel_saved.CHARRANGE 

   format\cbSize      = SizeOf(CHARFORMAT2) 
   format\dwMask      = #CFM_COLOR 
   format\crTextColor = Color 
   SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
EndProcedure 

OpenWindow(0, 0, 0, 322, 170, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
CreateGadgetList(WindowID(0)) 
EditorGadget(0, 8, 8, 306, 133, #PB_Editor_ReadOnly) 
SetActiveGadget(0) 

Repeat 
  Delay(10)
  SetColor(0, #Blue) 
  AddGadgetItem(0, -1, "Receiving...") 
  SetColor(0, #Red) 
  AddGadgetItem(0, -1, "Transmitting...") 
Until WindowEvent()=#PB_Event_CloseWindow

[drahneir]

Thanks srod for ur help. The code is working, but is not apllicable for me, since the received text does not come in linewise, but characterwise.
When I spend each character a line, it works, but makes no sense.
I have been trying many alternatives the last two days but did not come to a final solution.
I have wrote in previous posts that I don't have text to select. That's true for the moment I click on the transmit button, but when I am patient and wait a few milliseconds until the first transmit character appears, I have text to select. That's not the problem. The problem is now, that each time I change the selection, the color changes back to the default.
I experimented with 3 colors: green for received text, red for transmit text and blue as default.
When I start the application I am in receiving mode and the text appears in green. When I start transmitting, the receive text changes to default and the transmit text is red. When changing back to recieve, the transmit text changes to default as well, so that finally all text is blue.
So I give up now. This feature is not very important, since transmitting has leading and trailing lines 'TX-Start' and 'TX-End'.
Thanks for all who have replied.

[Sparkie]

In theory you should be able to accomplish your task. Without seeing your code it's difficult to see what's going wrong. Here's some streaming text that changes color at each uppercase/lowercase character. Note that nothing is selected at the time of the color change.

Code: Select all

;Streaming code credit goes to El_Choni 
Global *InPtr, InText$

Procedure EditStreamCallback(dwCookie.l, *pbBuff.l, cb.l, *pcb.Long) 
  If dwCookie = 0
    length = MemoryStringLength(*InPtr) 
    If length > cb 
      CopyMemory(*InPtr, *pbBuff, cb) 
      *InPtr + cb 
      *pcb\l = cb 
    ElseIf length < = cb 
      CopyMemory(*InPtr, *pbBuff, length) 
      *InPtr + length 
      *pcb\l = length 
    EndIf 
  EndIf 
  ProcedureReturn #S_OK 
EndProcedure 

Procedure SetColor(Gadget, Color) 
  Protected format.CHARFORMAT2, sel.CHARRANGE, sel_saved.CHARRANGE 
  format\cbSize      = SizeOf(CHARFORMAT2) 
  format\dwMask      = #CFM_COLOR 
  format\crTextColor = Color 
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
EndProcedure 

OpenWindow(0, 0, 0, 322, 170, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
CreateGadgetList(WindowID(0)) 
EditorGadget(0, 8, 8, 306, 133, #PB_Editor_ReadOnly) 
SetActiveGadget(0) 
SetColor(0, #Blue) 
eStream.EDITSTREAM 
eStream\dwCookie = 0 
eStream\pfnCallback = @EditStreamCallback() 

Restore myData

For c = 1 To 46
  Read myChar.c
  InText$ =  Chr(myChar)
  *InPtr = @InText$
  Delay(100)
  If Asc(InText$) < 97
    SetColor(0, #Blue)
  Else
    SetColor(0, #Red)
  EndIf
  SendMessage_(GadgetID(0), #EM_STREAMIN, #SF_TEXT | #SFF_SELECTION, @eStream)
  UpdateWindow_(GadgetID(0))
Next c

Repeat 
  Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow 

End

DataSection
myData:
Data.s "The Lazy Brown Fox ", Chr(13), "Jumped Over Fred's Head"
EndDataSection

[drahneir]

Yes, Sparkie, that's it. Thank you very much for your help. Now the color remains when leaving transmit. Well, that was a long birth, but finally it works. The way via streamin calback looks to me a bit complicated and I wouldn't have gone it on my own . Thanks again.

[drahneir]

A final remark on this subject:
after some investigation I found out why it didn't work before. I appended new text the PureBasic way

Code: Select all

SetGadgetText(Gadget, GetGadgetText(Gadget) + NewText)

This command caused the loss of previous format settings.
Now I use the '#EM_REPLACESEL' message. It works fine and I don't need a callback function.

[srod]

A final remark on this subject:
after some investigation I found out why it didn't work before. I appended new text the PureBasic way

Code: Select all

SetGadgetText(Gadget, GetGadgetText(Gadget) + NewText)

This command caused the loss of previous format settings.

Aye it would do!

That explains things.