Reputation: 25
I want to color every same word inside a RichTextBox. I can do it for one line but not on multiple lines. E.g., Welcome "user" .....
I want the word user
to be an exact color in every line it's found.
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
; I tried to use the richtextbox.TextChange
event, but it just colors the last user
word and the others are remain the same.
Upvotes: 2
Views: 1126
Reputation: 11
Public Sub HighlightText(ByVal txt As String, ByVal obj As RichTextBox)
obj.SelectionStart = 0
obj.SelectAll()
obj.SelectionBackColor = Color.White
Dim len = txt.Length
Dim pos = obj.Find(txt, 0, RichTextBoxFinds.NoHighlight)
While (pos >= 0)
obj.Select(pos, len)
obj.SelectionBackColor = Color.Yellow
If pos + len >= obj.Text.Length Then
Exit While
End If
pos = obj.Find(txt, pos + len, RichTextBoxFinds.NoHighlight)
End While
End Sub
Upvotes: 0
Reputation: 11
This works
Public Sub HighlightText(ByVal txt As String, ByVal obj As RichTextBox)
obj.SelectionStart = 0
obj.SelectAll()
obj.SelectionBackColor = Color.White
Dim len = txt.Length
Dim pos = obj.Find(txt, 0, RichTextBoxFinds.NoHighlight)
While (pos >= 0)
obj.Select(pos, len)
obj.SelectionBackColor = Color.Yellow
If pos + len >= obj.Text.Length Then
Exit While
End If
pos = obj.Find(txt, pos + len, RichTextBoxFinds.NoHighlight)
End While
End Sub
Upvotes: 1
Reputation: 32288
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()
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()
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
Public Class WordList
Private TextRendererFlags As TextFormatFlags =
TextFormatFlags.Top Or TextFormatFlags.Left Or TextFormatFlags.NoPadding Or
TextFormatFlags.WordBreak Or TextFormatFlags.TextBoxControl
Private textControl As RichTextBox = Nothing
Private wordsList As List(Of Word)
Public Sub New(rtb As RichTextBox)
textControl = rtb
wordsList = New List(Of Word)
ProtectSelection = False
End Sub
Public Property ProtectSelection As Boolean
Public Property HighLightColor As Color
Public Property SelectionColor As Color
Public Sub Add(word As String)
wordsList.Add(New Word() With {.Word = word, .Indexes = GetWordIndexes(word)})
End Sub
Public Sub AddRange(words As String())
For Each WordItem As String In words
wordsList.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(textControl.Text, word).
OfType(Of Match)().
Select(Function(chr) chr.Index).ToList()
End Function
Public Sub DeselectAll()
If textControl IsNot Nothing Then
textControl.SelectAll()
textControl.SelectionBackColor = textControl.BackColor
textControl.Update()
End If
End Sub
Public Sub WordsHighLight()
If wordsList.Count > 0 Then
For Each WordItem As Word In wordsList
For Each Position As Integer In WordItem.Indexes
Dim p As Point = textControl.GetPositionFromCharIndex(Position)
TextRenderer.DrawText(textControl.CreateGraphics(), WordItem.Word,
textControl.Font, p, textControl.ForeColor,
HighLightColor, TextRendererFlags)
Next
Next
End If
End Sub
Public Sub WordsSelect()
DeselectAll()
If wordsList.Count > 0 Then
For Each WordItem As Word In wordsList
For Each Position As Integer In WordItem.Indexes
textControl.Select(Position, WordItem.Word.Length)
textControl.SelectionColor = textControl.ForeColor
textControl.SelectionBackColor = SelectionColor
textControl.SelectionProtected = ProtectSelection
Next
Next
End If
End Sub
Friend Class Word
Property Word As String
Property Indexes As List(Of Integer)
End Class
End Class
Upvotes: 2
Reputation: 5758
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 :)
Upvotes: 1