Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 239
  • Last Modified:

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
0
CDP
Asked:
CDP
  • 5
  • 4
  • 3
  • +2
1 Solution
 
MAVERICKCommented:
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....


0
 
CDPAuthor Commented:
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
0
 
idcanadaCommented:
...
If text > 0 then
rtfbox.selstart = rtf.selstart - 7 '// Weather
rtfbox.sellength = 7
rtfbox.selcolor = vbred
end if
.

0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
CDPAuthor Commented:
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?
0
 
mark2150Commented:
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

0
 
mark2150Commented:
P.S.

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

M

0
 
CDPAuthor Commented:
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
0
 
PedroGCommented:
your problem is not in the way tah you were turning the word red, do has the first select the word, make the selection red. This is Ok.

The next text is in red, because you told rtextbox to do so!! You must turn it back to black (or whatever color u whant).

To do this make
SelStart=Len(rTxtBox.Text)
SelLenght = 0
SelColor = RGB(0 ,0 ,0)  'Use the color u what the normal text in

The Space stuff can work, but u must call the sub for the delete, backspace and return keys, because the user can change the text that is allredy written
0
 
mark2150Commented:
Yes, you're doing somehting silly! You need to pass HILITE the *WORD* you want to flag, *NOT* the entire text box! (grin!)

M

0
 
CDPAuthor Commented:
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
0
 
mark2150Commented:
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



0
 
MAVERICKCommented:
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

0
 
PedroGCommented:
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
0
 
CDPAuthor Commented:
Thanks again!

Jon, I'd appreciate the code.

Mat
0
 
PedroGCommented:
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
0
 
MAVERICKCommented:
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



0

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

  • 5
  • 4
  • 3
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now