Option Explicit

Const MAX = 20

Private Enum colors
BLACK
RED
GREEN
BLUE
End Enum

Private Enum keyFlags
None
Spacebar
ReturnKey
End Enum

Dim keyFlag As keyFlags
Dim colorWords$(MAX, BLUE)
Dim rgbColor&(BLUE)


Private Sub Form_Load()
'Red Words
colorWords(0, RED) = "visual basic"
colorWords(1, RED) = "red"
colorWords(2, RED) = "russia"
'Green Words
colorWords(0, GREEN) = "comment"
colorWords(1, GREEN) = "green"
colorWords(2, GREEN) = "italy"
'Blue Words
colorWords(0, BLUE) = "ocean"
colorWords(1, BLUE) = "blue"
colorWords(2, BLUE) = "united states"

'Set the colorcodes
rgbColor(BLACK) = vbBlack
rgbColor(RED) = vbRed
rgbColor(GREEN) = vbGreen
rgbColor(BLUE) = vbBlue

Command1.Caption = "Load"
Command2.Caption = "Save"
Command3.Caption = "Color Line"
End Sub

Private Sub RichTextBox1_KeyDown(KeyCode As Integer, _
Shift As Integer)
Select Case KeyCode
Case vbKeySpace: keyFlag = Spacebar
Case vbKeyReturn: keyFlag = ReturnKey
Case Else: keyFlag = None
End Select
End Sub

Private Sub RichTextBox1_Change()
Static previousWord$
Static previousWordStart&
Static previousWordLength&

Select Case keyFlag
Case None: Exit Sub
Case ReturnKey
If Comment Then Exit Sub
Case Spacebar
If InComment Then Exit Sub
End Select

Dim currentWord$
Dim wordStart&
Dim lengthWord&
Dim selstartholder&

selstartholder = RichTextBox1.SelStart

currentWord = _
GetCurrentWord(wordStart, lengthWord)

If currentWord <> "" Then
Dim j%, w$, found As Boolean
Dim k As colors

currentWord = LCase$(currentWord)
For k = RED To BLUE
For j = 0 To MAX
w = IIf(InStr(colorWords(j, k), " "), _
previousWord & " " & currentWord, _
currentWord)

Select Case colorWords(j, k)
Case w: found = True
Exit For
Case ""
Exit For
End Select
Next
If found Then Exit For
Next

If found Then
Dim lgth&, beginning&
If InStr(w, " ") Then
beginning = previousWordStart
lgth = previousWordLength + _
lengthWord + 1
Else
beginning = wordStart
lgth = lengthWord
End If

colorArea beginning, lgth, k
End If

previousWord = currentWord
previousWordStart = wordStart
previousWordLength = lengthWord
With RichTextBox1
.SelColor = rgbColor(BLACK)
.SelStart = selstartholder
End With
End If
End Sub

Private Function GetCurrentWord(start&, length&)
length = Len(RichTextBox1.Text) - keyFlag
For start = length To 2 Step -1
Select Case Asc(Mid$(RichTextBox1.Text, start, 1))
Case vbKeySpace, 10
start = start + 1
Exit For
End Select
Next

length = length - start + 1
If length > 0 Then
GetCurrentWord = Mid$(RichTextBox1.Text, start, length)
Else
GetCurrentWord = ""
End If
End Function

'Sub to load a file
Private Sub Command1_Click()
With RichTextBox1
.filename = "c:\text.txt"
If Dir$(.filename) = "" Then Exit Sub

If LCase$(Right$(.filename, 3)) <> "rtf" Then
colorTheWords
colorTheComments
End If

.SelStart = Len(.Text)
.SetFocus
End With
End Sub

Private Sub Command2_Click()
RichTextBox1.SaveFile "c:\text.txt", rtfText
End Sub

Private Sub Command3_Click()
Dim beginning&, ending&
Dim selstartholder&

With RichTextBox1
selstartholder = .SelStart
beginning = InComment

If beginning Then
For ending = beginning To Len(.Text)
If Mid$(.Text, ending, 1) = vbCr Then
Exit For
End If
Next
colorArea beginning, ending - beginning, GREEN
Else
colorTheWords .SelStart
End If

.SelStart = selstartholder
.SetFocus
End With
End Sub

Private Sub colorTheWords(Optional start& = 0)
Dim j%, t$, match&, L&, w$
Dim beginning&, ending&
Dim k As colors

t = LCase$(RichTextBox1.Text)
L = Len(t)

If start Then
For beginning = start To 2 Step -1
If Mid$(t, beginning, 1) = vbLf Then
beginning = beginning + 1
Exit For
End If
Next
For ending = start To L - 1
If Mid$(t, ending, 1) = vbCr Then
ending = ending - 1
Exit For
End If
Next
Else
start = RichTextBox1.SelStart
beginning = 1
ending = L
End If


For k = RED To BLUE
For j = 0 To MAX
w = colorWords(j, k)
If w = "" Then Exit For
match = InStr(beginning, t, w)
Do While match >= beginning And _
match < ending
If InComment(match) = 0 Then
colorArea match, Len(w), k
End If
match = InStr(match + 1, t, w)
Loop
Next
Next

With RichTextBox1
.SelStart = start
.SetFocus
End With
End Sub

Private Sub colorTheComments()
Dim beginning&, ending&
Dim selstartholder&

With RichTextBox1
selstartholder = .SelStart

beginning = InStr(.Text, "'")
Do While beginning
If InComment(beginning) Then
For ending = beginning To Len(.Text)
If Mid$(.Text, ending, 1) = vbCr Then
Exit For
End If
Next
colorArea beginning, ending - beginning, GREEN
End If
beginning = InStr(beginning + 1, .Text, "'")
Loop
.SelStart = selstartholder
End With
End Sub

Private Function Comment() As Boolean
Dim beginning&, k%, ending&, m%
Dim selstartholder&

selstartholder = RichTextBox1.SelStart
Comment = False

With RichTextBox1
'We just entered Cr Lf so backup 2 chars
ending = .SelStart - 2
'Beginning of file
If ending <= 0 Then Exit Function
beginning = InComment(ending)
If beginning = 0 Then Exit Function

colorArea beginning, _
ending - beginning + 1, GREEN

.SelStart = selstartholder
End With

Comment = True
End Function

Private Function InComment(Optional start& = 0) As Long
Dim beginning&

With RichTextBox1
If start = 0 Then start = .SelStart

For beginning = start To 2 Step -1
If Mid$(.Text, beginning, 1) = vbLf Then
beginning = beginning + 1
Exit For
End If
Next

If Mid$(.Text, beginning, 1) = "'" Then
InComment = beginning
Else
InComment = 0
End If
End With
End Function

Private Sub colorArea(begin&, lgth&, clr As colors)
With RichTextBox1
.SelStart = begin - 1
.SelLength = lgth
.SelColor = rgbColor(clr)
.SelLength = 0
End With
End Sub