Initial

EDOKA/Utils/RichTextBoxHS.vb

@@ -0,0 +1,161 @@
+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 remaing highlight tags
+            Do
+                'find a "\highlight" block
+                HighlightBlockStart = InStr(StartLooking, strTemp, "\highlight")
+                'if no "\highlight" block found
+                If HighlightBlockStart = 0 Then
+                    'append everything remaining
+                    sb.Append(Mid(strTemp, StartLooking, strTemp.Length - StartLooking))
+                    'we 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