-
ok ok... I think I wasn't specific enough before. I need to be able to color words as soon as the user types them i.e. i type hello and exactly when I finish typing the o it colors hello blue also I have buttons to add code to the rtb so I need this to happen with the Change action I have been able to color somewhat but my code is a little buggy.... and it only colors if it's at the end of all the other text which would be good if that's how i wanted it(it deosn't flicker this way) plus help!!! this is my code:
Code:
Private sLookUp(9, 1) As String
Private Sub Form_Load()
sLookUp(0, 0) = "Hello"
sLookUp(0, 1) = Trim(Str(vbGreen))
sLookUp(1, 0) = "World"
sLookUp(1, 1) = Trim(Str(vbBlue))
sLookUp(2, 0) = "!!!"
sLookUp(2, 1) = Trim(Str(vbRed))
End Sub
Private Sub RTB1_KeyUp(KeyCode As Integer, Shift As Integer)
Dim iStart As Long
Dim iEnd As Long
Dim iMatch As Integer
Dim sWord As String
Dim iPos As Long
With RTB1
iPos = .SelStart
If .SelStart Then
If Mid(.Text, iPos, 1) <> " " Then
iStart = InStrRev2(.Text, " ", iPos) + 1
iEnd = InStr(iStart, .Text, " ")
If iEnd = 0 Then iEnd = Len(.Text)
sWord = Mid(.Text, iStart, iEnd - iStart + 1)
'Caption = sWord
iMatch = MatchKeyWord(sWord)
If iMatch Then
.SelStart = iStart - 1
.SelLength = Len(sWord)
.SelColor = Val(sLookUp(iMatch - 1, 1))
.SelStart = iPos
.SelColor = vbBlack
End If
End If
End If
End With
End Sub
Private Function MatchKeyWord(ByVal sWord As String) As Integer
Dim iLookUp As Integer
For iLookUp = 0 To UBound(sLookUp)
If LCase(sWord) = LCase(sLookUp(iLookUp, 0)) Then Exit For
Next
If iLookUp <= UBound(sLookUp) Then MatchKeyWord = iLookUp + 1
End Function
Private Function InStrRev2(ByVal sString As String, ByVal sChars As String, Optional ByVal lPos As Long = 1) As Long
If Len(sString) = 0 Then Exit Function
If lPos = 1 Then lPos = Len(sString)
While Mid(sString, lPos, 1) <> sChars And lPos > 1
lPos = lPos - 1
Wend
If lPos = 1 And Left(sString, 1) <> sChars Then
InStrRev2 = 0
Else
InStrRev2 = lPos
End If
End Function
Any help will be appreciated!
------------------
DiGiTaIErRoR
-
I recognize that code...
I've tweaked it a little to make it more intuitive, the rest is up to you..
Code:
Private sLookUp(9, 1) As String
Private Sub Form_Load()
'Create Lookup Table
sLookUp(0, 0) = "vb-world"
sLookUp(0, 1) = Trim(Str(vbBlue))
sLookUp(1, 0) = "is"
sLookUp(1, 1) = Trim(Str(vbRed))
sLookUp(2, 0) = "the"
sLookUp(2, 1) = Trim(Str(vbGreen))
sLookUp(3, 0) = "best"
sLookUp(3, 1) = Trim(Str(vbCyan))
'Add More Here
End Sub
Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
'Find the Word Currently under the Text Caret
Dim iStart As Long
Dim iEnd As Long
Dim iMatch As Integer
Dim sKeyWord As String
Dim iPos As Long
With RichTextBox1
iPos = .SelStart
If iPos Then
If Mid(.Text, iPos, 1) <> " " Then
iStart = InStrRev(.Text, " ", .SelStart) + 1
iEnd = InStr(iStart, .Text, " ")
If iEnd = 0 Then iEnd = Len(.Text)
'Check for a Match
sKeyWord = Trim(Mid$(.Text, iStart, iEnd - iStart + 1))
Caption = sKeyWord & " : " & Len(sKeyWord)
iMatch = MatchKeyWord(sKeyWord)
.SelStart = iStart - 1
.SelLength = Len(sKeyWord)
If iMatch Then
.SelColor = Val(sLookUp(iMatch - 1, 1))
Else
.SelColor = vbBlack
End If
.SelStart = iPos
End If
End If
.SelColor = vbBlack
End With
End Sub
Private Function MatchKeyWord(ByVal sWord As String) As Integer
'Check Word for a Match in the Lookup Table
Dim iLookUp As Integer
For iLookUp = 0 To UBound(sLookUp)
If LCase(sWord) = LCase(sLookUp(iLookUp, 0)) Then Exit For
Next
If iLookUp <= UBound(sLookUp) Then MatchKeyWord = iLookUp + 1
End Function
Private Function InStrRev2(ByVal sString As String, ByVal sChars As String, Optional ByVal lPos As Long = 1) As Long
'Duplicate of the VB6 Function InstrRev
'If you Don't have VB6, Rename InStrRev in the
'KeyUp Event to InstrRev2 to use this Routine instead.
If Len(sString) = 0 Then Exit Function
If lPos = 1 Then lPos = Len(sString)
While Mid(sString, lPos, 1) <> sChars And lPos > 1
lPos = lPos - 1
Wend
If lPos = 1 And Left(sString, 1) <> sChars Then
InStrRev2 = 0
Else
InStrRev2 = lPos
End If
End Function
------------------
Aaron Young
Analyst Programmer
[email protected]
[email protected]
