Introduction
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()
MyBase.New()
InitializeComponent()
End Sub
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
Private components As System.ComponentModel.IContainer
<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)
If Me.SelectedText Is Nothing Then Exit Property
Dim sb As New StringBuilder()
Dim SelText As String = Me.SelectedRtf
Dim strTemp As String
Dim FontTableEnds As Integer
Dim ColorTableBegins As Integer
Dim ColorTableEnds As Integer
Dim StartLooking As Integer
Dim HighlightBlockStart As Integer
Dim HighlightBlockEnd As Integer
Dim cycl As Integer
Dim NewColorIndex As Integer = 0
FontTableEnds = InStr(1, SelText, "}}")
sb.Append(Mid(SelText, 1, FontTableEnds + 1))
ColorTableBegins = InStr(FontTableEnds, SelText, "{\colortbl")
If ColorTableBegins = 0 Then
sb.Append("{\colortbl ;")
ColorTableEnds = FontTableEnds
NewColorIndex = 1
Else
ColorTableEnds = InStr(ColorTableBegins, SelText, "}")
ColorTableEnds -= 1
strTemp = Mid(SelText, FontTableEnds + 2,
(ColorTableEnds - FontTableEnds) - 1)
For cycl = 1 To strTemp.Length
If Mid(strTemp, cycl, 1) = ";" Then NewColorIndex += 1
Next
sb.Append(strTemp)
End If
sb.Append("\red" & Trim(Value.R.ToString))
sb.Append("\green" & Trim(Value.G.ToString))
sb.Append("\blue" & Trim(Value.B.ToString))
sb.Append(";")
sb.Append("}")
sb.Append("\highlight" & Trim(NewColorIndex.ToString))
strTemp = Mid(SelText, ColorTableEnds + 2,
(SelText.Length - ColorTableEnds) - 1)
StartLooking = 1
Do
HighlightBlockStart = InStr(StartLooking, strTemp, "\highlight")
If HighlightBlockStart = 0 Then
sb.Append(Mid(strTemp, StartLooking,
strTemp.Length - StartLooking))
Exit Do
End If
HighlightBlockEnd = HighlightBlockStart + 9
Do
HighlightBlockEnd += 1
If Mid(strTemp, HighlightBlockEnd + 1, 1) = " " Then
HighlightBlockEnd += 1
Exit Do
End If
Loop While InStr(1, "0123456789", Mid(strTemp, HighlightBlockEnd + 1, 1))
sb.Append(Mid(strTemp, StartLooking, (HighlightBlockStart - StartLooking)))
StartLooking = HighlightBlockEnd + 1
Loop
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)
Me.SuspendLayout()
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
Do
FoundAt = Me.Find(SearchText, StartLooking, RTBfinds)
If FoundAt > -1 Then Me.SelectionBackColor = HighlightColor
StartLooking = StartLooking + SearchLength
Loop While FoundAt > -1
Me.ResumeLayout()
End Sub
Public Sub BackColorSetWhole(ByVal BackColorDefault As Color)
Me.SelectAll()
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.
Enjoy,
Frederick
Volking
Senior Architect
Hunter Stone, Inc
http:HunterStone.Com
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.