Click here to Skip to main content
11,790,387 members (65,835 online)
Click here to Skip to main content

RichTextBox with background highlighting in VB.NET

, 29 Jul 2002 187.8K 1.5K 49
Rate this:
Please Sign up or sign in to vote.
Subclasses the standard .NET RichTextBox and adds background highlighting capabilities
<!-- Download Links --> <!-- Article image -->

Sample Image - RichTextBoxHS.jpg

<!-- Add the rest of your HTML here -->


We needed a control with background highlighting capabilities, so after looking everywhere, I ended up writing one. I found many people on the UseNet Groups and discussion threads asking for such a control and no one every answered. Well, here's an answer. It's kind of a kludge, but seems to work OK. It has NOT been through our QA cycle yet so use it at your own risk but I think it's pretty solid.

Apparently, there is an RTF tag called \highlight#. The RichTextBox control understands how to display the \highlight# tag, but the control does not provide any means of setting the tag. The reason I call my solution a kludge, is because the only way I could make it work is to scrape the raw RTF out of the control, manually parse it, strip out any existing \highlight# tags, rebuild the RTF color table, and manually insert the \highlight# tag myself. It seems to work ... but I'm not comfortable I know enough about RTF document structures to have thought of every scenario and every possible internal layout which can exist inside an RTF document. Bottom line, there may be RTF Documents which defeat my approach.

The RichTextBoxHS control is a subclass of the standard .NET RichTextBox. I've done several such controls which subclass one of the standard .NET controls and I always have a big problem getting the Visual Studio .NET Toolbox to recognize them. Bottom line ....

It takes "Funky" steps to recreate the RichTextBoxHS control

These steps (however funky) are required to recreate this control. I still haven’t deduced why, but unless you use Visual Studio’s tools to initially create the UserControl, the control never gets added to the ToolBox! So, for success, follow these steps:

  • Open Visual Studio
  • Open what ever VB project into which you want to add a RichTextBoxHS control
  • From the MainMenu, select Project+AddUserControl
    Templates: User Control
    Name: RichTextBoxHS
  • The UserControl design surface will open
  • Close the UserControl Design surface
  • Open the UserControl Code Editor surface
  • Replace “ALL” code in the UserControl Editor with below code (or download here)
  • Build the solution

Rather than repeating, step by step, how this approach works, I heavily commented the below code.

Imports System.Drawing
Imports System.Text
Public Class RichTextBoxHS
    Inherits Windows.Forms.RichTextBox

#Region " Windows Form Designer generated code "
    Public Sub New()
        'This call is required by the Windows Form Designer.
        'Add any initialization after the InitializeComponent() call
    End Sub

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
            End If
        End If
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer
    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        components = New System.ComponentModel.Container()
    End Sub

#End Region

    Public WriteOnly Property SelectionBackColor() As Color
        Set(ByVal Value As Color)
            'First, test SelectedText property NOT SelectedRTF property because
            '...SelectedRTF will never be nothing, it will always have at least
            '...the current default Font table
            If Me.SelectedText Is Nothing Then Exit Property
            Dim sb As New StringBuilder()           'use StringBuilder for speed 
                                                    'and cleanliness
            Dim SelText As String = Me.SelectedRtf  'move to local string for speed
            Dim strTemp As String                   'used twice for ease of calculating 
                                                    'internal coordinates
            Dim FontTableEnds As Integer            'end character of the rtf font table
            Dim ColorTableBegins As Integer         'beginning of the rtf color table
            Dim ColorTableEnds As Integer           'end of the rtf color table
            Dim StartLooking As Integer             'used to walk a string appending chunks
            Dim HighlightBlockStart As Integer      'used to find "\highlight#" block for 
            Dim HighlightBlockEnd As Integer        'used to find "\highlight#" block for 
            Dim cycl As Integer                     'used in For/Next loops
            Dim NewColorIndex As Integer = 0        'new color table index for incoming color

            'find the end of the font table
            FontTableEnds = InStr(1, SelText, "}}")
            'add the header and font table to the string accumulator
            sb.Append(Mid(SelText, 1, FontTableEnds + 1))

            'find the color table start
            ColorTableBegins = InStr(FontTableEnds, SelText, "{\colortbl")
            If ColorTableBegins = 0 Then 'no color table exists 
                'add a color table header
                sb.Append("{\colortbl ;")
                'no color table so for later use make the ColorTableEnd the same 
                ' as FontTableEnds
                ColorTableEnds = FontTableEnds
                'default our new color table index to 1 since it will be the only one
                'remember Color table index 0 is reserved 
                NewColorIndex = 1
            Else 'a color table already exists
                'find the end of the color table
                ColorTableEnds = InStr(ColorTableBegins, SelText, "}")
                'backup one character so as to exclude the brace
                ColorTableEnds -= 1
                'need to count the quantity of semi;colons which will
                '... determine what color table index number our new color will be
                strTemp = Mid(SelText, FontTableEnds + 2, 
                              (ColorTableEnds - FontTableEnds) - 1)
                For cycl = 1 To strTemp.Length
                    If Mid(strTemp, cycl, 1) = ";" Then NewColorIndex += 1
                'append the color table without end brace
            End If

            'append the color table entry for the highlight color
            sb.Append("\red" & Trim(Value.R.ToString))
            sb.Append("\green" & Trim(Value.G.ToString))
            sb.Append("\blue" & Trim(Value.B.ToString))
            'append the table entry terminator semi;colon

            'append the color table terminating brace
            'append the new highlight tag
            sb.Append("\highlight" & Trim(NewColorIndex.ToString))
            'Drop into a single string for easier manipulation
            strTemp = Mid(SelText, ColorTableEnds + 2, 
                          (SelText.Length - ColorTableEnds) - 1)

            'begin at first character
            StartLooking = 1
            'append everything remaining, but strip all remaining highlight tags
                'find a "\highlight" block
                HighlightBlockStart = InStr(StartLooking, strTemp, "\highlight")
                'if no more "\highlight" block found
                If HighlightBlockStart = 0 Then
                    'append everything remaining
                    sb.Append(Mid(strTemp, StartLooking, 
                                  strTemp.Length - StartLooking))
                    'we're done appending
                    Exit Do
                End If
                'calculate the end of the word "highlight"
                HighlightBlockEnd = HighlightBlockStart + 9
                'accomodate color tables with over 9 colors and thus multi-digit 
                'color indexes Plus, watch for (and discard) ONE space if it 
                'immediately follows the last digit
                    'keep stepping past end
                    HighlightBlockEnd += 1
                    'watch for (and discard) ONE space if it immediately follows the
                    ' last digit
                    If Mid(strTemp, HighlightBlockEnd + 1, 1) = " " Then
                        HighlightBlockEnd += 1
                        Exit Do
                    End If
                    'looking for the first non-numeric character
                Loop While InStr(1, "0123456789", Mid(strTemp, HighlightBlockEnd + 1, 1))
                'append this block
                sb.Append(Mid(strTemp, StartLooking, (HighlightBlockStart - StartLooking)))
                'move the start forward past the last "\highlight#" block
                StartLooking = HighlightBlockEnd + 1

            Me.SelectedRtf = sb.ToString
        End Set
    End Property

    Public Sub FindHighlight(ByVal SearchText As String, ByVal HighlightColor As Color, _
                             ByVal MatchCase As Boolean, ByVal WholeWords As Boolean)
        Dim StartLooking As Integer = 0
        Dim FoundAt As Integer
        Dim SearchLength As Integer
        Dim RTBfinds As RichTextBoxFinds
        If SearchText Is Nothing Then Exit Sub
        Select Case True
            Case MatchCase And WholeWords
                RTBfinds = RichTextBoxFinds.MatchCase Or RichTextBoxFinds.WholeWord
            Case MatchCase
                RTBfinds = RichTextBoxFinds.MatchCase
            Case WholeWords
                RTBfinds = RichTextBoxFinds.WholeWord
            Case Else
                RTBfinds = RichTextBoxFinds.None
        End Select
        SearchLength = SearchText.Length
            FoundAt = Me.Find(SearchText, StartLooking, RTBfinds)
            If FoundAt > -1 Then Me.SelectionBackColor = HighlightColor
            StartLooking = StartLooking + SearchLength
        Loop While FoundAt > -1
    End Sub

    Public Sub BackColorSetWhole(ByVal BackColorDefault As Color)
        Me.SelectionBackColor = BackColorDefault
    End Sub

End Class

BUGS ....

If anyone finds bugs, or discovers an RTF Document which defeats my approach, please let me know. I will try to fix any problems.


Frederick Volking
Senior Architect
Hunter Stone, Inc


This article has no explicit license attached to it but may contain usage terms in the article text or the download files themselves. If in doubt please contact the author via the discussion board below.

A list of licenses authors might use can be found here


About the Author

Web Developer
United States United States
No Biography provided

You may also be interested in...

Comments and Discussions

GeneralMy vote of 4 Pin
Member 95123158-Jun-13 6:15
memberMember 95123158-Jun-13 6:15 
General2 Questions Pin
Jared James Sullivan18-Jan-09 17:32
memberJared James Sullivan18-Jan-09 17:32 
QuestionI can't change color text that I selected Pin
Member 310014228-Feb-08 20:35
memberMember 310014228-Feb-08 20:35 
Generalcannot use RichTextBoxHS in application Pin
pallavipatil0114-Jun-06 2:33
memberpallavipatil0114-Jun-06 2:33 
GeneralFantastic example! Pin
DbMan174-May-06 10:35
memberDbMan174-May-06 10:35 
GeneralSelectionBackColor is in .NET Framework version 2.0. Pin
ErichG14-Feb-06 5:22
memberErichG14-Feb-06 5:22 
GeneralNeed the code in C# Pin
spvarapu9-Mar-05 22:27
memberspvarapu9-Mar-05 22:27 
GeneralRe: Need the code in C# Pin
ttgiang12-Sep-05 7:02
memberttgiang12-Sep-05 7:02 
Generalclass possibility Pin
Pyro Joe25-Feb-05 16:55
memberPyro Joe25-Feb-05 16:55 
GeneralRe: class possibility Pin
Pyro Joe25-Feb-05 16:57
memberPyro Joe25-Feb-05 16:57 
GeneralOdd "newline" Pin
Opryshok5-Jul-04 22:47
memberOpryshok5-Jul-04 22:47 
QuestionIf no selection then BUG? Pin
Jon Jake29-Jan-04 5:21
memberJon Jake29-Jan-04 5:21 
QuestionWhy so complicated? Pin
Martin Mueller30-Jul-02 20:29
memberMartin Mueller30-Jul-02 20:29 
AnswerBecause I didn't know no'better! Pin
volking31-Jul-02 6:11
membervolking31-Jul-02 6:11 
GeneralRe: Because I didn't know no'better! Pin
Martin Müller2-Aug-02 9:33
sussMartin Müller2-Aug-02 9:33 
GeneralRe: Because I didn't know no'better! Pin
volking2-Aug-02 13:27
membervolking2-Aug-02 13:27 
GeneralRe: Because I didn't know no'better! Pin
FredAdams26-Feb-04 5:47
sussFredAdams26-Feb-04 5:47 
GeneralCarret in RichTextBox Pin
Step29-Jul-02 20:46
sussStep29-Jul-02 20:46 
GeneralRe: Carret in RichTextBox Pin
Juvenile11-Jan-04 4:23
memberJuvenile11-Jan-04 4:23 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.

| Advertise | Privacy | Terms of Use | Mobile
Web03 | 2.8.1509028.1 | Last Updated 30 Jul 2002
Article Copyright 2002 by FlashMerlot
Everything else Copyright © CodeProject, 1999-2015
Layout: fixed | fluid