PDA

View Full Version : RichEdit, searching & coloring words



zak
31-08-2010, 11:42
Hi
the purpose of this code is to search for the word "tiger" in the RichEdit window and to color every occurrence of the word "tiger" in red.
1- if the text without CRLF ; ie: on one line it will color "tiger" exactly
2- but if the text contains CRLF the the coloring will be shifted, as in the attached picture.
3- when we run the program the text in the richedit are selected, how to unselect it at first, it does not work to set:
lCR.cpMin = 0, lCR.cpMax = 0 before calling:
SendMessage hEdit, %EM_EXSETSEL, 0, VarPtr(lCR)

4- if we replace :
Do
...
Until pos = 0

with:
While pos > 0
....
Wend
it will not work.


Uses "UI"

#INCLUDE "%APP_INCLUDEPATH%\RichEdit32.inc"

Begin Const
%ID_RICHEDIT
%IDBTN_RUN
End Const

Global hEdit As DWord
Global hDlg As Long
Global txt As String
Global lCR As CHARRANGE

Function TBMain()
'Dim hDlg As Long '---Handle of the main window

Dialog New 0,"RichEdit search",10,10,500,300,%WS_OVERLAPPEDWINDOW Or %WS_CLIPCHILDREN,0 To hDlg

Dim lx, ly, wx, hy As Long
Dialog Get Size hDlg To lx, ly
Dialog Get Client hDlg To wx, hy


Dialog Get Client hDlg To wx, hy
wx = 350
hY = hY - 30
txt = "lion tiger lion dog cat tiger tiger horse"
txt = txt + CRLF + CRLF + CRLF + "tiger horse tiger lion dog cat tiger tiger horse tiger horse"
'from zlatkoAB tip:
Control Add RTF_GetClass,hDlg,%ID_RICHEDIT,txt,0,0,wx,hy,&H50B010C4
Control Add Button, hDlg, %IDBTN_RUN , "&Search ...", 355, 3, 60, 20, %BS_PUSHLIKE
Control Set Resize hDlg, %ID_RICHEDIT, 1, 0, 1, 1

'---Return a window handle for the specified control ID
Control Handle hDlg, %ID_RICHEDIT To hEdit
'to unselect the text assigned to RichEdit
Control Set Focus hDlg, %ID_RICHEDIT
lCR.cpMin = 0:lCR.cpMax = 0
SendMessage hEdit, %EM_EXSETSEL, 0, VarPtr(lCR)

'---Show dialog in MODAL state

Dialog Show Modal hDlg, Call dlgCallback

End Function

CallBack Function dlgCallback() As Long

'---Now test the message
Select Case CBMSG

Case %WM_COMMAND
Select Case CBCTL

Case %ID_RICHEDIT 'Some Richedit events, just to
'RichEdit_UpdateInfo(CBHNDL, hEdit)
Case %IDBTN_RUN
RichEdit_UpdateInfo(CBHNDL, hEdit)
RTF_SetFGColor(CBHNDL, %ID_RICHEDIT, Rgb(255,0,0))

End Select
End Select

End Function
Function RichEdit_UpdateInfo(ByVal hWnd As Long, ByVal hEdit As Long) As Long

'Dim lCR As CHARRANGE
Dim txt As String
Dim SelLength As Long
Dim pos,lPos As Long
Dim i,txtlenght As Long
txt = RTF_GetText(hDlg, %ID_RICHEDIT,%SF_TEXT)
txtlenght = Len(txt)
lPos = 0
'While pos > 0
Do
pos = InStr(lPos + 1, txt, "tiger")
lCR.cpMin = pos - 1
SelLength = 5 'lenght of "tiger" word
lCR.cpMax = lCR.cpMin + SelLength
lPos = pos
SendMessage hEdit, %EM_EXSETSEL, 0, VarPtr(lCR)
RTF_SetFGColor(hDlg, %ID_RICHEDIT, Rgb(255,0,0))
Control Set Focus hDlg, %ID_RICHEDIT
'Wend
'Until pos = 0 corrected to the following line
Loop Until pos = 0
End Function

ErosOlmi
31-08-2010, 12:07
At the beginning of the loop pos is zero so it will never enter in


while pos > 0
'...
wend

loop.

If you want it to enter at least once, set something like

pos = -1
While pos
'...
Wend

In any case check pos after

pos = InStr(...)

Also DO ... MUST end with LOOP optionally followed by WHILE or UNTIL. See help at http://www.thinbasic.com/public/products/thinBasic/help/html/doloop.htm

Ciao
Eros

zak
31-08-2010, 12:18
thanks Eros, my brain was in a travel, i was thinking while wend have a bug
regards

ErosOlmi
31-08-2010, 12:30
Well, to be honest I'm happy you posted your code because I discovered that thinBasic pre-processor is not checking DO/LOOP pairs. Thanks to your code it is now fixed and next thinBasic version will check that for each DO there is a pair LOOP and the other way round.

Thanks
Eros

zak
31-08-2010, 14:15
i have found "Control Set Focus" function, if we add this code after the controls definitions in the Function TBMain(), the pre assigned text to richedit control will be unselected, i have modified the original code. also dimming lCR as Global

'to unselect the text assigned to RichEdit
Control Set Focus hDlg, %ID_RICHEDIT
lCR.cpMin = 0:lCR.cpMax = 0
SendMessage hEdit, %EM_EXSETSEL, 0, VarPtr(lCR)