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 ....
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:
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()
'This call is required by the Windows Form Designer.
InitializeComponent()
'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
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
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
'stripping
Dim HighlightBlockEnd As Integer 'used to find "\highlight#" block for
'stripping
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
Next
'append the color table without end brace
sb.Append(strTemp)
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
sb.Append(";")
'append the color table terminating brace
sb.Append("}")
'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
Do
'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
Do
'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
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
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
| You must Sign In to use this message board. | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
) 
I need the insights!
