True Highlighting for RichTextBox

[moeur]

The RichTextBox control supports the Rich Text Format codes for highlighting text, but the control itself gives you no access to this functionality.
Here is a simple routine that adds highlighting

Public Sub HighLight(RTB As RichTextBox, lColor As Long)
'add new color to color table
'add tags \highlight# and \highlight0
'where # is new color number
Dim iPos As Long
Dim strRTF As String
Dim bkColor As Integer
 
    With RTB
        iPos = .SelStart
        'bracket selection
        .SelText = Chr(128) & .SelText & Chr(129) ' \'80 \'81
        strRTF = RTB.TextRTF
'add new color
        bkColor = AddColorToTable(strRTF, lColor)
'add highlighting
         strRTF = Replace(strRTF, "\'80", "\highlight" & CStr(bkColor) & " ")
         strRTF = Replace(strRTF, "\'81", "\highlight0 ")
 
         .TextRTF = strRTF
        .SelStart = iPos
       End With
 
End Sub

We also need to add the highlight color to the rtf color table if it is not already there

Function AddColorToTable(strRTF As String, lColor As Long) As Integer
Dim iPos As Long, jPos As Long
 
Dim ctbl As String
Dim tagColors
Dim nColors As Integer
Dim tagNew As String
Dim i As Integer
Dim iLen As Integer
Dim split1 As String
Dim split2 As String
 
    'make new color into tag
    tagNew = "\red" & CStr(lColor And &HFF) & _
        "\green" & CStr(Int(lColor / &H100) And &HFF) & _
        "\blue" & CStr(Int(lColor / &H10000))
    
    'find colortable
    iPos = InStr(strRTF, "{\colortbl")
    
    If iPos > 0 Then 'if table already exists
        jPos = InStr(iPos, strRTF, ";}")
        'color table
        ctbl = Mid(strRTF, iPos + 12, jPos - iPos - 12)
        'array of color tags
        tagColors = Split(ctbl, ";")
        nColors = UBound(tagColors) + 2
        'see if our color already exists in table
        For i = 0 To UBound(tagColors)
            If tagColors(i) = tagNew Then
                AddColorToTable = i + 1
                Exit Function
            End If
        Next i
'{\fonttbl{\f0\fnil\fcharset0 Verdana;}}
'{\colortbl ;\red0\green0\blue0;\red128\green0\blue255;}
        
        split1 = Left(strRTF, jPos)
        split2 = Mid(strRTF, jPos + 1)
        strRTF = split1 & tagNew & ";" & split2
        AddColorToTable = nColors
    
    Else
        'color table doesn't exists, let's make one
        iPos = InStr(strRTF, "{\fonttbl") 'beginning of font table
        jPos = InStr(iPos, strRTF, ";}}") + 2 'end of font table
        split1 = Left(strRTF, jPos)
        split2 = Mid(strRTF, jPos + 1)
        strRTF = split1 & "{\colortbl ;" & tagNew & ";}" & split2
        AddColorToTable = 1
    End If
 
End Function