Color a Specific Word in every richtextbox line VB

Question

I want to color every same word inside a richtextbox . I can do it for one line but not on multiple lines. Ex. Welcome "user" .....

I want the word user to be an exact color in every line it is in. Here's with what i came up so far:

RichTextBox1.Text = "Welcome "
RichTextBox1.Select(RichTextBox1.TextLength, 0)
RichTextBox1.SelectionColor = My.Settings.color
RichTextBox1.AppendText(My.Settings.username)
RichTextBox1.SelectionColor = Color.Black
RichTextBox1.AppendText(" ........." + vbCrLf)    

It's on form.load, tried to put on richtextbox.textchange but it just colors the last "user" word and the others are black. Thanks in advance.

Answer 1

This is a simple Class that enables multiple Selections and Highlights of text for RichTextBox and TextBox controls.
You can use multiple instances of this Class for different controls.

You can add the Words to Select/HighLight to a List and specify which color to use for selecting and/or highlighting the text.

Dim ListOfWords As WordList = New WordList(RichTextBox1)

ListOfWords.AddRange({"Word1", "Word2"})
ListOfWords.SelectionColor = Color.LightBlue
ListOfWords.HighLightColor = Color.Yellow

These are the visual results of the Class actions:

In the example, the List of words is filled using:

Dim Patterns As String() = TextBox1.Text.Split(Chr(32))
ListOfWords.AddRange(Patterns)

In the visual example, the Class is configured this way:

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

    Dim Patterns As String() = TextBox1.Text.Split(Chr(32))

    Dim ListOfWords As WordList = New WordList(RichTextBox1)
    ListOfWords.AddRange(Patterns)
    ListOfWords.SelectionColor = Color.LightBlue
    ListOfWords.HighLightColor = Color.Yellow

    If RadioButton1.Checked = True Then
        ListOfWords.WordsSelect()
    ElseIf RadioButton2.Checked Then
        ListOfWords.WordsHighLight()
    Else
        ListOfWords.DeselectAll()
    End If

End Sub

This is the Class used to generate the Selections and HighLights:

Imports System.Drawing.Text
Imports System.Text.RegularExpressions

Class WordList
    Private TextRendererFlags As TextFormatFlags = TextFormatFlags.Left Or
                                 TextFormatFlags.Top Or TextFormatFlags.NoPadding Or
                                 TextFormatFlags.WordBreak Or TextFormatFlags.TextBoxControl

    Private _Control As RichTextBox = Nothing
    Private Words As List(Of Word)

    Public Sub New(ByVal RefControl As RichTextBox)
        Me._Control = RefControl
        Me.Words = New List(Of Word)
        Me.ProtectSelection = False
    End Sub

    Public Property ProtectSelection As Boolean
    Public Property HighLightColor As Color
    Public Property SelectionColor As Color

    Public Sub Add(NewWord As String)
        Me.Words.Add(New Word() With {.Word = NewWord, .Indexes = GetWordIndexes(NewWord)})
    End Sub

    Public Sub AddRange(NewWords As String())
        For Each WordItem As String In NewWords
            Me.Words.Add(New Word() With {.Word = WordItem, .Indexes = GetWordIndexes(WordItem)})
        Next
    End Sub
    Private Function GetWordIndexes(Word As String) As List(Of Integer)
        Return Regex.Matches(Me._Control.Text, Word).
                     Cast(Of Match)().
                     Select(Function(chr) chr.Index).ToList()
    End Function

    Public Sub DeselectAll()
        If Me._Control IsNot Nothing Then
            Me._Control.SelectAll()
            Me._Control.SelectionBackColor = Me._Control.BackColor
            Me._Control.Update()
        End If
    End Sub

    Public Sub WordsHighLight()
        If Me.Words.Count > 0 Then
            For Each WordItem As Word In Me.Words
                For Each Position As Integer In WordItem.Indexes
                    Dim _P As Point = Me._Control.GetPositionFromCharIndex(Position)
                    TextRenderer.DrawText(Me._Control.CreateGraphics(), WordItem.Word,
                                          Me._Control.Font, _P, Me._Control.ForeColor,
                                          Me.HighLightColor, TextRendererFlags)
                Next
            Next
        End If
    End Sub

    Public Sub WordsSelect()
        Me.DeselectAll()
        If Me.Words.Count > 0 Then
            For Each WordItem As Word In Me.Words
                For Each Position As Integer In WordItem.Indexes
                    Me._Control.Select(Position, WordItem.Word.Length)
                    Me._Control.SelectionColor = Me._Control.ForeColor
                    Me._Control.SelectionBackColor = Me.SelectionColor
                    Me._Control.SelectionProtected = Me.ProtectSelection
                Next
            Next
        End If
    End Sub

    Class Word
        Property Word As String
        Property Indexes As List(Of Integer)
    End Class

End Class

Answer 2

With a module,you can do it this way :

Imports System.Runtime.CompilerServices

Module Utility

<Extension()>
Sub HighlightText(ByVal myRtb As RichTextBox, ByVal word As String, ByVal color As Color)
    If word = String.Empty Then Return
    Dim index As Integer, s_start As Integer = myRtb.SelectionStart, startIndex As Integer = 0
    While(__InlineAssignHelper(index, myRtb.Text.IndexOf(word, startIndex))) <> -1
        myRtb.[Select](index, word.Length)
        myRtb.SelectionColor = color
        startIndex = index + word.Length
    End While

    myRtb.SelectionStart = s_start
    myRtb.SelectionLength = 0
    myRtb.SelectionColor = Color.Black
End Sub

<Obsolete("Please refactor code that uses this function, it is a simple work-around to simulate inline assignment in VB!")>
Private Shared Function __InlineAssignHelper(Of T)(ByRef target As T, value As T) As T
    target = value
    Return value
End Function
End Module

Or , you can also go with this one as it will allow you to highlight multiple words at the same time :

 Private Sub HighlightWords(ByVal words() As String)
     Private Sub HighlightWords(ByVal words() As String)
    For Each word As String In words
        Dim startIndex As Integer = 0

        While (startIndex < rtb1.TextLength)
            Dim wordStartIndex As Integer = rtb1.Find(word, startIndex, RichTextBoxFinds.None)
            If (wordStartIndex <> -1) Then
                rtb1.SelectionStart = wordStartIndex
                rtb1.SelectionLength = word.Length
                rtb1.SelectionBackColor = System.Drawing.Color.Black
            Else
                Exit While
            End If

            startIndex += wordStartIndex + word.Length
        End While

    Next
End Sub

Source Hope this helps :)