Link to home
Start Free TrialLog in
Avatar of CDP
CDP

asked on

Turning pre-defined words red in RTBox as user types them.

I would like to be able to have my application change the colour of certain words as the user types them in a Rich Text Box. Can anyone suggest a way of doing this?

In other words, I would have a list of relevant words, for example: Weather, Sun, Rain, Cloud, etc and if the user typed a sentance like "The weather here is very wet at the moment, we're having a lot of rain." The words weather and rain would be turn red when the user had typed them.

Thanks
Mat
Avatar of MAVERICK
MAVERICK
Flag of United States of America image

use the Instr function find the specific words in immediately before the cursor..... then use the RTB.selcolor method to make it red....
If this is acceptable I'll write an example....


Avatar of CDP
CDP

ASKER

Thank you, I'd appreciate that! I have tried to do what you suggested but can only change the colour of the text after a 'hot' word.

Here is what I have done (this is in the selChange Sub):

Dim text As Integer
text = InStr(rtfbox.text, "weather")
If text > 0 Then
rtfbox.SelColor = vbRed
End If

Any text that is typed after the word weather is red.

Thanks again
Mat
...
If text > 0 then
rtfbox.selstart = rtf.selstart - 7 '// Weather
rtfbox.sellength = 7
rtfbox.selcolor = vbred
end if
.

Avatar of CDP

ASKER

Thanks for the suggestion. I have tried it and get an error saying 'Invalid Property Value'.

This is my code:
Dim text As Integer
text = InStr(rtfbox.text, "weather")
If text > 0 Then
rtfbox.SelStart = rtfbox.SelStart - 7 <--this is the line with error
rtfbox.SelLength = 7
rtfbox.SelColor = vbRed
End If

Any ideas?
Ummm, .SelStart is *ZERO* in your code example because NO TEXT IS SELECTED! When you subtract 7 from it you're passing a negative and there is no such thing as a negative pointer into a string - hence the error.

You need to *MARK* the text so that SelStart is valid.

Here is sample routine (untested, written off the top of my head) that allows you to pass a string to be highlighted. It will replace *all* occurances instead of just the *first* and it is case insensitive.

PRIVATE SUB HILITE( Txt As String )
Dim Marker1 As Integer, First As Integer
First = 1
Txt = UCASE( Txt )
'
Retry:
Markter1 = InStr(First, UCASE( rtb.Text ), Txt )
If Marker1 > 0 Then
    rtb.SelStart = Marker
    rtb.SelLen = Len( Txt )
    rtb.SelColor = vbRed
    First = Marker1 + 1
    Goto Retry
Endif
'
End Sub

M

P.S.

Only call this thing when you sense a (Space) in the data stream. This will speed operation.

M

Avatar of CDP

ASKER

OK, This is what I have done:

Private Sub rtfbox_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeySpace
Call HILITE(rtfbox.Text)
End Select
End Sub

Private Sub HILITE(Txt As String)
Dim Marker1 As Integer, First As Integer
First = 1
Txt = "weather"
Txt = UCase(Txt)

Retry:
Marker1 = InStr(First, UCase(rtfbox.Text), Txt)
If Marker1 > 0 Then
    rtfbox.SelStart = Marker1
    rtfbox.SelLength = Len(Txt)
    rtfbox.SelColor = vbRed
    First = Marker1 + 1
    GoTo Retry
End If
'
End Sub

What is happening now is if I just type 'weather' into the rtfbox, it deletes all but the first letter of the word (which is still black) and then it turns any text that I type after that red. I guess I can stop the rest of the text being red by putting rtfbox.selcolor = vbred after the code so that's not a problem.

Am I doing something stupid?
Thanks
Mat
ASKER CERTIFIED SOLUTION
Avatar of PedroG
PedroG

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Yes, you're doing somehting silly! You need to pass HILITE the *WORD* you want to flag, *NOT* the entire text box! (grin!)

M

Avatar of CDP

ASKER

Thank you ! And thanks to everyone who helped!

I've now got it working but am having problems with it flicking through the whole text and leaving the cursor at the end of the text each time the space bar is pressed! I will no doubt be posting another question before long!

Mat
Save the cursor position and change the cursor back once you've made the color change.

You could also make it highlight when someone presses <Enter> instead of <Space>. This will reduce the flicker. You also might want to try changing .Visible to false and then back to .True when you've updated. This will *blink*, but only once.

M



one comment: If the flickering is a problem one way to slove your problem is to count back from the current cursor positon finding the word.. quicker than going over the whole box from the start...

If this is required ... I will arrange the code...

Regards
Jon

One other thing that you should do in the beginning of the higlite function is to hide de selection

RTBox.HideSelectio = True

at the end of the function turn it back on
Avatar of CDP

ASKER

Thanks again!

Jon, I'd appreciate the code.

Mat
The flicker free rotine should only concer with the current line, cause this is the one with the alterations.

There is a problem with only doing the back search, image if a user selects some text in the midle of the whole text, and then deletes it. It will afect text in the back and in front of the cursor. Some thing that were in red should no more be in red.

There are still one point you must consider, you shoul search every word if it is a reserved one you turn it to red if no turn it to black. It may sound silly to do this but imagine the following.

1. the user write Sun (it is a reserved word)
2. you higlite it to red (Very good...)
3. the user deletes the 'n' (now it is displayed only Su, but they are still in red, so you need to change it to black, because it is not a reserved word)

If you still have any questions just continue puting them
It may be better to resubmit another Question so other experts may be able to assist aswell, not that I mind helping of course
Here's the code.... It is not foolproof ... but it handles spaces as well as carridge returns (enter key). And in large amounts of typing it is quicker as it only searches the last 16 characters not the whole document.... As for the "su" part... u could customize the code to trap the backspace and confirm wether it is still a reserved word...  but then again u could keep customizing it until u go crazy!! Word check sub routine determines which words become red. You may delete any references to labels as they are unnecessary.
BTW This code or similar code will be used in my web editor program...

Private Sub RichTextBox1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim RTBpos As Integer
Dim RTBcur As Integer
Dim RTBst As String
Dim RTBsp As Integer
Dim RTBwp As Integer
Dim RTBcr As Integer

Dim RTBtxt As String
Dim RTBwc As String
Dim RTBclr As Boolean

If KeyCode = vbKeySpace Or KeyCode = vbKeyReturn Then
RichTextBox1.Visible = False

'------- get last 16 characters
With RichTextBox1
RTBcur = .SelStart
RTBpos = RTBcur - 15
RTBtxt = .Text
If RTBpos < 0 Then RTBpos = 0
RTBst = Mid$(RTBtxt, RTBpos + 1, (RTBcur - RTBpos))
'------ find spaces



Do
RTBsp = InStr(RTBsp + 1, RTBst, Chr$(32))
Loop Until InStr(RTBsp + 1, RTBst, Chr$(32)) = 0
Do
RTBcr = InStr(RTBcr + 1, RTBst, Chr$(13))
Loop Until InStr(RTBcr + 1, RTBst, Chr$(13)) = 0
Label4.Caption = Str(RTBcr) & "CR " & Str(RTBsp) & "SP"

If RTBcr > RTBsp Then
RTBsp = RTBcr
Label5.Caption = RTBsp
End If

'Label1.Caption = RTBsp
Label2.Caption = RTBst & "Z"
RTBwp = RTBpos + RTBsp
Label3.Caption = Str(RTBcur) & " " & Str(RTBwp)
'------ check the word
RTBwc = UCase$(Mid$(RTBtxt, RTBwp + 1, (RTBcur - RTBwp + 1)))
wordcheck RTBwc, RTBclr
Label1.Caption = RTBwc



'---------------- change the color
If RTBclr Then

SelStart = RTBwp
Visible = True
SetFocus
SelLength = (RTBcur - RTBwp + 1)
SelColor = vbRed
SelStart = RTBcur
SetFocus
'.SelLength = 1
SelColor = vbBlack

Else
Visible = True
SelStart = RTBcur
SetFocus
End If
'-------------- End the space detector
End With
End If
If KeyCode = vbKeyReturn Then
Label3.Caption = "Return"
Else
Label3.Caption = "NoReturn"

End If
End Sub
Private Sub wordcheck(Word As String, Clr As Boolean)
Clr = False
If InStr(1, Word, "TEST") > 0 Then
Clr = True: Exit Sub: End If
If InStr(1, Word, "eject", vbTextCompare) > 0 Then
Clr = True: Exit Sub: End If



End Sub

ICQ# 6631387