Color Words
in a RichTextBox

in Visual Basic®



by Rick Meyer       Home

Supplied with Visual Basic is the RichTextbox that allows you to do many things that you can not do with a simple TextBox. One of the things is to display text (foreground) in varying font colors.

This small project demonstrates how to have your chosen words colored (and font-weight is made bold) as they are typed in.

Note in the Form_Load Sub where you may edit the words to be colored - like these RED ones:

colorWords(0, RED) = "open"
colorWords(1, RED) = "close"
colorWords(2, RED) = "sub"
colorWords(3, RED) = "function"

Keep all the letters in lower case. Add a word simply by putting in another line:

colorWords(4, RED) = "shell"   

Note that right now the maximum number of words for any color is set by the MAX constant to 10 (first line in the program). If you need to color more words a certain color then just change the constant.

Action Keys

As you type away, the program needs to have some idea of when you have reached the end of a word so it can go about the business of deciding whether or not a word has been made that might need to be colored. These keys may be found in the keyFlags enumeration.

The Spacebar, Tab, and Return (Enter) serve as natural delimiters while the Backspace and Delete are also provided since they can change a word.

Additionally the Open Parenthesis "(" and Close Parenthesis ")" have been programmed here as delimiters. If you study the code thoroughly, you may be able to add your own delimiters.

Note the last two subs that are necessary to allow the Tab key to enter data rather than shifting focus to the next Control in the TabOrder. ([Cntrl][Tab] will work without the Subs.)

You may improve upon this program by placing words in a text file, inputting and assigning in the Form_Load Sub then saving in the Form_Unload. This would probably done easiest with the sequential access Open For Input and Open For Output methods. Doing this would not only allow you to change your words without recompiling the program, it would also allow you to design a Form for adding or editing words on-the-fly.
    Instructions for Building this Project:

1. Start a new standard exe
2. On Form1 put a RichTextBox named RichTextBox1

There is no need to position or size the above controls
on the form since that is all done in the Form_Load.

To find the RichTextBox Control click on the VB Menu->Project->Components and select Microsoft Rich TextBox Control. After you click OK the RichTextBox Control will appear in the toolbar usually on the left of the VB IDE (Integrated Development Environment).
Now you are ready for the code. Select all of the following code (by clicking on the word 'Option' three times) and copy it to the clipboard [Ctrl][Insert]. Then paste it into the code window of Form1 with [Shift][Insert]. Variable Key
% As Integer
& As Long
! As Single
# As Double
$ As String 
Option Explicit

Const MAX = 10
Const vbSpace = " ", vbOpenP = "(", vbCloseP = ")"
Const vbKeyOpenP = vbKey9, vbKeyCloseP = vbKey0

Private Enum Colors
    BLACK
    RED
    ORANGE
    BROWN
    GREEN
    PURPLE
    BLUE
End Enum

Private Enum keyFlags
    NONE
    SPACEBAR
    TABKEY
    OPENPAREN
    CLOSEPAREN
    RETURNKEY
    BACKSPACE
    DELETEKEY
End Enum

Dim keyFlag As keyFlags
Dim numChars%(DELETEKEY)
Dim colorWords$(MAX, BLUE)
Dim rgbColor&(BLUE)
Dim selStartPos&
Dim arrTabStop() As Boolean

Private Sub Form_Load()
    'Red Words (type in lower case)
    colorWords(0, RED) = "open"
    colorWords(1, RED) = "close"
    colorWords(2, RED) = "sub"
    colorWords(3, RED) = "function"
    
    'Orange Words
    
    'Brown Words
    colorWords(0, BROWN) = "integer"
    colorWords(1, BROWN) = "long"
    colorWords(2, BROWN) = "string"
    
    'Green Words
    colorWords(0, GREEN) = "rem"
    colorWords(1, GREEN) = "'"

    'Purple Words
    colorWords(0, PURPLE) = "private"
    colorWords(1, PURPLE) = "public"

    'Blue Words
    colorWords(0, BLUE) = "as"
    colorWords(1, BLUE) = "to"
    colorWords(2, BLUE) = "with"

    'Set the colorcodes
    rgbColor(BLACK) = vbBlack
    rgbColor(RED) = vbRed
    rgbColor(ORANGE) = RGB(255, 140, 0)
    rgbColor(BROWN) = RGB(210, 105, 30)
    rgbColor(PURPLE) = RGB(153, 50, 204)
    rgbColor(GREEN) = RGB(46, 139, 87)
    rgbColor(BLUE) = vbBlue
    
    numChars(SPACEBAR) = 1
    numChars(TABKEY) = 1
    numChars(OPENPAREN) = 1
    numChars(CLOSEPAREN) = 1
    numChars(RETURNKEY) = 2
    
    Caption = "RichTextBox Color Words"
    RichTextBox1.Text = ""
    Move 2000, 2000
    Form_Resize
End Sub

Private Sub Form_Resize()
    RichTextBox1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub RichTextBox1_KeyDown(KeyCode As Integer, _
        Shift As Integer)
    
    keyFlag = NONE
    
    Select Case KeyCode
        Case vbKeySpace:    keyFlag = SPACEBAR
        Case vbKeyTab:      keyFlag = TABKEY
        Case vbKeyReturn:   keyFlag = RETURNKEY
        Case vbKeyBack:     keyFlag = BACKSPACE
        Case vbKeyDelete:   keyFlag = DELETEKEY
        Case vbKeyOpenP
          If Shift = 1 Then keyFlag = OPENPAREN
        Case vbKeyCloseP
          If Shift = 1 Then keyFlag = CLOSEPAREN
    End Select
End Sub
 
Private Sub RichTextBox1_Change()
    Dim EndOfText As Boolean
    
    selStartPos = RichTextBox1.SelStart
    EndOfText = (selStartPos = Len(RichTextBox1.Text))
    
    If EndOfText Then If keyFlag = NONE Then Exit Sub

    If SeeAboutColoring Then Exit Sub
    
    If Not EndOfText Then
        Select Case keyFlag
            Case OPENPAREN To CLOSEPAREN
                ColorWord selStartPos, 1, BLACK
        End Select
        Select Case keyFlag
            Case SPACEBAR To RETURNKEY
                keyFlag = NONE
                SeeAboutColoring
        End Select
    End If
        
    With RichTextBox1
        .SelColor = rgbColor(BLACK)
        .SelStart = selStartPos
    End With
End Sub

Private Function SeeAboutColoring() As Boolean
    Dim clrWord$, wordStart&, wordLength&

    clrWord = GetCurrentWord(wordStart, wordLength)
    
    If clrWord = "" Then
        SeeAboutColoring = True
    Else
        ColorWord wordStart, wordLength, SetColor(clrWord)
    End If
End Function

Private Function SetColor(ByVal wd$) As Colors
    Dim j%, clr%, found As Boolean
    
    wd = LCase$(wd)
    
    For clr = RED To BLUE
        For j = 0 To MAX
            Select Case colorWords(j, clr)
                Case wd
                    found = True
                    Exit For
                Case ""
                    Exit For
            End Select
        Next

        If found Then Exit For
    Next

    SetColor = IIf(found, clr, BLACK)
End Function

Private Function GetCurrentWord(start&, length&)
    Dim last&
    
    last = selStartPos + 1 - numChars(keyFlag)
    If last <= 0 Then last = 1
    
    For last = last To Len(RichTextBox1.Text)
        Select Case Mid$(RichTextBox1.Text, last, 1)
          Case vbCr, vbLf, vbTab, vbSpace, vbOpenP, vbCloseP
            Exit For
        End Select
    Next
    
    For start = last - 1 To 1 Step -1
        Select Case Mid$(RichTextBox1.Text, start, 1)
          Case vbCr, vbLf, vbTab, vbSpace, vbOpenP, vbCloseP
            Exit For
        End Select
    Next

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

Private Sub ColorWord(begin&, lgth&, clr As Colors)
    With RichTextBox1
        .SelStart = begin - 1
        .SelLength = lgth
        .SelBold = clr <> BLACK
        .SelColor = rgbColor(clr)
        .SelLength = 0
    End With
End Sub
      
'The following two Subs are necessary to allow the
'  Tab Key to enter a Tab Char in the RichTextBox
Private Sub RichTextBox1_GotFocus()
    Dim j%
    ReDim arrTabStop(Controls.Count) As Boolean
    On Error Resume Next
    
    For j = 0 To Controls.Count - 1
        arrTabStop(j) = Controls(j).TabStop
        Controls(j).TabStop = False
    Next
End Sub

Private Sub RichTextBox1_LostFocus()
    Dim j%
    On Error Resume Next
    
    For j = 0 To Controls.Count - 1
        Controls(j).TabStop = arrTabStop(j)
    Next
End Sub