A simple RichTextBox-based source code colorizer
Since I suppose that somebody will request me the source code of the colorizer that I mentioned in my last post, the code is below. Just create a form with a RichTextBox control. Since this is not a "colorize as you type" approach (I think that the performance could suffer), you need to use the LostFocus of the RichTextBox control or use a "Colorize" button to call the ColorizeRichTextBox method passing the DTE instance, the RichTextBox control, the comment line prefix ( ' for VB.NET, // for C#) and the list of keywords of the language (see Visual Basic Language Keywords and C# Keywords). Notice that the RichTextBox of .NET 1.x doesn't support the SelectionBackColor property. The version that I am posting colorizes the plain text, keywords, strings and comments and it does a pretty good job resembling the code editor appearance. If you find bugs or enhancements let me know.
Public Class FormCodeColorizer
Private Sub ButtonColorize_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonColorize.Click
Dim objDTE As EnvDTE.DTE
objDTE = ... ' Get the EnvDTE.DTE from somewhere
ColorizeRichText(objDTE, Me.RichTextBoxCode, "'", GetVBKeywords())
End Sub
Public Sub ColorizeRichText(ByVal objDTE As EnvDTE.DTE, ByVal ctlRichTextBox As RichTextBox, _
ByVal sCommentLinePrefix As String, ByVal colKeywords As System.Collections.Specialized.StringCollection)
Const DISPLAY_ITEM_PLAIN_TEXT As String = "Plain Text"
Const DISPLAY_ITEM_KEYWORD As String = "Keyword"
Const DISPLAY_ITEM_STRING As String = "String"
#If VS_8_0 Then
' PATCH: The Comment default color is wrong. We use the CSS Comment color instead
Const DISPLAY_ITEM_COMMENT As String = "CSS Comment"
#Else
Const DISPLAY_ITEM_COMMENT As String = "Comment"
#End If
Dim objFont As Font = Nothing
Dim objBackColor As Color
Dim objTextColor As Color
Dim iSelectionStart As Integer
Dim iSelectionLength As Integer
Dim colFontsAndColorsItems As EnvDTE.FontsAndColorsItems = Nothing
Dim sFontFamily As String = ""
Dim sngFontSize As Single
Dim bBoldFont As Boolean
If GetTextEditorFontAndColorsItems(objDTE, sFontFamily, sngFontSize, colFontsAndColorsItems) Then
If GetFontAndColorInformation(colFontsAndColorsItems, DISPLAY_ITEM_PLAIN_TEXT, bBoldFont, objBackColor, objTextColor) Then
Try
If bBoldFont Then
objFont = New Font(sFontFamily, sngFontSize, FontStyle.Bold)
Else
objFont = New Font(sFontFamily, sngFontSize)
End If
' Cache selection position and length
iSelectionStart = ctlRichTextBox.SelectionStart
iSelectionLength = ctlRichTextBox.SelectionLength
' Set the properties of the control
ctlRichTextBox.Font = objFont
ctlRichTextBox.BackColor = objBackColor
ctlRichTextBox.ForeColor = objTextColor
' This is to reset the font and color properties, just in case there was previous colorizing information
ctlRichTextBox.SelectionStart = 0
ctlRichTextBox.SelectionLength = ctlRichTextBox.TextLength
ctlRichTextBox.SelectionFont = objFont
ctlRichTextBox.SelectionColor = objTextColor
ctlRichTextBox.SelectionBackColor = objBackColor
' Colorize keywords
ColorizeRichTextKeywords(ctlRichTextBox, colKeywords, sFontFamily, sngFontSize, colFontsAndColorsItems, DISPLAY_ITEM_KEYWORD)
' Colorize comments
ColorizeRichTextTokens(ctlRichTextBox, sCommentLinePrefix, ControlChars.Cr, RichTextBoxFinds.None, sFontFamily, sngFontSize, colFontsAndColorsItems, DISPLAY_ITEM_COMMENT)
' Colorize strings
ColorizeRichTextTokens(ctlRichTextBox, ControlChars.Quote, ControlChars.Quote, RichTextBoxFinds.None, sFontFamily, sngFontSize, colFontsAndColorsItems, DISPLAY_ITEM_STRING)
' Restore selection position and length
ctlRichTextBox.SelectionStart = iSelectionStart
ctlRichTextBox.SelectionLength = iSelectionLength
Finally
If Not (objFont Is Nothing) Then
objFont.Dispose()
End If
End Try
End If
End If
End Sub
Public Function GetVBKeywords() As System.Collections.Specialized.StringCollection
Dim colVBKeywords As New System.Collections.Specialized.StringCollection
colVBKeywords.Add("AddHandler")
colVBKeywords.Add("AddressOf")
colVBKeywords.Add("Alias")
colVBKeywords.Add("And")
colVBKeywords.Add("AndAlso")
colVBKeywords.Add("As")
colVBKeywords.Add("Boolean")
colVBKeywords.Add("ByRef")
colVBKeywords.Add("Byte")
colVBKeywords.Add("ByVal")
colVBKeywords.Add("Call")
colVBKeywords.Add("Case")
colVBKeywords.Add("Catch")
colVBKeywords.Add("CBool")
colVBKeywords.Add("CByte")
colVBKeywords.Add("CChar")
colVBKeywords.Add("CDate")
colVBKeywords.Add("CDec")
colVBKeywords.Add("CDbl")
colVBKeywords.Add("Char")
colVBKeywords.Add("CInt")
colVBKeywords.Add("Class")
colVBKeywords.Add("CLng")
colVBKeywords.Add("CObj")
colVBKeywords.Add("Const")
colVBKeywords.Add("Continue")
colVBKeywords.Add("CSByte")
colVBKeywords.Add("CShort")
colVBKeywords.Add("CSng")
colVBKeywords.Add("CStr")
colVBKeywords.Add("CType")
colVBKeywords.Add("CUInt")
colVBKeywords.Add("CULng")
colVBKeywords.Add("CUShort")
colVBKeywords.Add("Date")
colVBKeywords.Add("Decimal")
colVBKeywords.Add("Declare")
colVBKeywords.Add("Default")
colVBKeywords.Add("Delegate")
colVBKeywords.Add("Dim")
colVBKeywords.Add("DirectCast")
colVBKeywords.Add("Do")
colVBKeywords.Add("Double")
colVBKeywords.Add("Each")
colVBKeywords.Add("Else")
colVBKeywords.Add("ElseIf")
colVBKeywords.Add("End")
colVBKeywords.Add("EndIf")
colVBKeywords.Add("Enum")
colVBKeywords.Add("Erase")
colVBKeywords.Add("Error")
colVBKeywords.Add("Event")
colVBKeywords.Add("Exit")
colVBKeywords.Add("False")
colVBKeywords.Add("Finally")
colVBKeywords.Add("For")
colVBKeywords.Add("Friend")
colVBKeywords.Add("Function")
colVBKeywords.Add("Get")
colVBKeywords.Add("GetType")
colVBKeywords.Add("GetXMLNamespace")
colVBKeywords.Add("Global")
colVBKeywords.Add("GoSub")
colVBKeywords.Add("GoTo")
colVBKeywords.Add("Handles")
colVBKeywords.Add("If")
colVBKeywords.Add("Implements")
colVBKeywords.Add("Imports")
colVBKeywords.Add("In")
colVBKeywords.Add("Inherits")
colVBKeywords.Add("Integer")
colVBKeywords.Add("Interface")
colVBKeywords.Add("Is")
colVBKeywords.Add("IsNot")
colVBKeywords.Add("Let")
colVBKeywords.Add("Lib")
colVBKeywords.Add("Like")
colVBKeywords.Add("Long")
colVBKeywords.Add("Loop")
colVBKeywords.Add("Me")
colVBKeywords.Add("Mod")
colVBKeywords.Add("Module")
colVBKeywords.Add("MustInherit")
colVBKeywords.Add("MustOverride")
colVBKeywords.Add("MyBase")
colVBKeywords.Add("MyClass")
colVBKeywords.Add("Namespace")
colVBKeywords.Add("Narrowing")
colVBKeywords.Add("New")
colVBKeywords.Add("Next")
colVBKeywords.Add("Not")
colVBKeywords.Add("Nothing")
colVBKeywords.Add("NotInheritable")
colVBKeywords.Add("NotOverridable")
colVBKeywords.Add("Object")
colVBKeywords.Add("Of")
colVBKeywords.Add("On")
colVBKeywords.Add("Operator")
colVBKeywords.Add("Option")
colVBKeywords.Add("Optional")
colVBKeywords.Add("Or")
colVBKeywords.Add("OrElse")
colVBKeywords.Add("Overloads")
colVBKeywords.Add("Overridable")
colVBKeywords.Add("Overrides")
colVBKeywords.Add("ParamArray")
colVBKeywords.Add("Partial")
colVBKeywords.Add("Private")
colVBKeywords.Add("Property")
colVBKeywords.Add("Protected")
colVBKeywords.Add("Public")
colVBKeywords.Add("RaiseEvent")
colVBKeywords.Add("ReadOnly")
colVBKeywords.Add("ReDim")
colVBKeywords.Add("REM")
colVBKeywords.Add("RemoveHandler")
colVBKeywords.Add("Resume")
colVBKeywords.Add("Return")
colVBKeywords.Add("SByte")
colVBKeywords.Add("Select")
colVBKeywords.Add("Set")
colVBKeywords.Add("Shadows")
colVBKeywords.Add("Shared")
colVBKeywords.Add("Short")
colVBKeywords.Add("Single")
colVBKeywords.Add("Static")
colVBKeywords.Add("Step")
colVBKeywords.Add("Stop")
colVBKeywords.Add("String")
colVBKeywords.Add("Structure")
colVBKeywords.Add("Sub")
colVBKeywords.Add("SyncLock")
colVBKeywords.Add("Then")
colVBKeywords.Add("Throw")
colVBKeywords.Add("To")
colVBKeywords.Add("True")
colVBKeywords.Add("Try")
colVBKeywords.Add("TryCast")
colVBKeywords.Add("TypeOf")
colVBKeywords.Add("Variant")
colVBKeywords.Add("Wend")
colVBKeywords.Add("UInteger")
colVBKeywords.Add("ULong")
colVBKeywords.Add("UShort")
colVBKeywords.Add("Using")
colVBKeywords.Add("When")
colVBKeywords.Add("While")
colVBKeywords.Add("Widening")
colVBKeywords.Add("With")
colVBKeywords.Add("WithEvents")
colVBKeywords.Add("WriteOnly")
colVBKeywords.Add("Xor")
colVBKeywords.Add("#Const")
colVBKeywords.Add("#Else")
colVBKeywords.Add("#ElseIf")
colVBKeywords.Add("#End")
colVBKeywords.Add("#If")
colVBKeywords.Add("=")
colVBKeywords.Add("&")
colVBKeywords.Add("&=")
colVBKeywords.Add("*")
colVBKeywords.Add("*=")
colVBKeywords.Add("/")
colVBKeywords.Add("/=")
colVBKeywords.Add("\")
colVBKeywords.Add("\=")
colVBKeywords.Add("^")
colVBKeywords.Add("^=")
colVBKeywords.Add("+")
colVBKeywords.Add("+=")
colVBKeywords.Add("-")
colVBKeywords.Add("-=")
colVBKeywords.Add(">>")
colVBKeywords.Add(">>=")
colVBKeywords.Add("<<")
colVBKeywords.Add("<<=")
Return colVBKeywords
End Function
Public Sub ColorizeRichTextKeywords(ByVal ctlRichTextBox As RichTextBox, _
ByVal colKeywords As System.Collections.Specialized.StringCollection, _
ByVal sFontFamily As String, ByVal sngFontSize As Single, _
ByVal colFontsAndColorsItems As EnvDTE.FontsAndColorsItems, ByVal sDisplayItem As String)
Dim sKeyword As String
Dim eRichTextBoxFinds As RichTextBoxFinds
eRichTextBoxFinds = RichTextBoxFinds.WholeWord Or RichTextBoxFinds.MatchCase
For Each sKeyword In colKeywords
ColorizeRichTextTokens(ctlRichTextBox, sKeyword, "", eRichTextBoxFinds, sFontFamily, sngFontSize, colFontsAndColorsItems, sDisplayItem)
Next
End Sub
Public Sub ColorizeRichTextTokens(ByVal ctlRichTextBox As RichTextBox, _
ByVal sToken As String, ByVal sOptionalTokenDelimiter As String, _
ByVal eRichTextBoxFinds As RichTextBoxFinds, ByVal sFontFamily As String, ByVal sngFontSize As Single, _
ByVal colFontsAndColorsItems As EnvDTE.FontsAndColorsItems, ByVal sDisplayItem As String)
Dim iPosition1 As Integer
Dim iPosition2 As Integer
Dim objFont As Font = Nothing
Dim objBackColor As Color
Dim objTextColor As Color
Dim bBoldFont As Boolean
Dim bFontAndColorInformationRetrieved As Boolean = False
Try
If Not (colFontsAndColorsItems Is Nothing) Then
If sToken <> "" Then
iPosition1 = 0
Do
iPosition1 = ctlRichTextBox.Find(sToken, iPosition1, eRichTextBoxFinds)
If iPosition1 = -1 Then
Exit Do
Else
If sOptionalTokenDelimiter = "" Then
iPosition2 = iPosition1 + sToken.Length
Else
If iPosition1 + sToken.Length < ctlRichTextBox.TextLength Then
iPosition2 = ctlRichTextBox.Find(sOptionalTokenDelimiter, iPosition1 + sToken.Length, RichTextBoxFinds.None)
Else
iPosition2 = -1
End If
If iPosition2 = -1 Then
' Not found, but the delimiter was passed so we assume it means until the end of text.
' This is the case of comments, which use Cr (carriage return) as the token delimiter. We must
' colorize the comment even if it is the last line and no carriage return is used.
' This does not apply to keywords because they don't use token delimiter, so it works as expected
iPosition2 = ctlRichTextBox.TextLength
End If
End If
' Resources are not created until an occurrence was found. And then, they are created only once
If Not bFontAndColorInformationRetrieved Then
If GetFontAndColorInformation(colFontsAndColorsItems, sDisplayItem, bBoldFont, objBackColor, objTextColor) Then
If sFontFamily <> "" Then
If bBoldFont Then
objFont = New Font(sFontFamily, sngFontSize, FontStyle.Bold)
Else
objFont = New Font(sFontFamily, sngFontSize)
End If
bFontAndColorInformationRetrieved = True
End If
End If
End If
If Not bFontAndColorInformationRetrieved Then
Exit Do
Else
ctlRichTextBox.SelectionStart = iPosition1
ctlRichTextBox.SelectionLength = iPosition2 - iPosition1 + sOptionalTokenDelimiter.Length
If Not (objFont Is Nothing) Then
ctlRichTextBox.SelectionFont = objFont
End If
If Not objTextColor.Equals(Color.Empty) Then
ctlRichTextBox.SelectionColor = objTextColor
End If
' Note: The RichTextBox of .NET 1.x doesn't support the SelectionBackColor property
If Not objBackColor.Equals(Color.Empty) Then
ctlRichTextBox.SelectionBackColor = objBackColor
End If
iPosition1 = iPosition2 + sOptionalTokenDelimiter.Length
If iPosition1 >= ctlRichTextBox.TextLength Then
Exit Do
End If
End If
End If
Loop
End If
End If
Finally
If Not (objFont Is Nothing) Then
objFont.Dispose()
End If
End Try
End Sub
Public Function GetFontAndColorInformation(ByVal colFontsAndColorsItems As EnvDTE.FontsAndColorsItems, _
ByVal sDisplayItem As String, ByRef r_bBoldFont As Boolean, ByRef r_objBackColor As Color, _
ByRef r_objTextColor As Color) As Boolean
Dim colColorableItems As EnvDTE.ColorableItems
Dim iOleColor As Integer
Dim bResult As Boolean = False
Try
If Not (colFontsAndColorsItems Is Nothing) Then
colColorableItems = colFontsAndColorsItems.Item(sDisplayItem)
iOleColor = System.Convert.ToInt32(colColorableItems.Background)
r_objBackColor = System.Drawing.ColorTranslator.FromOle(iOleColor)
iOleColor = System.Convert.ToInt32(colColorableItems.Foreground)
r_objTextColor = System.Drawing.ColorTranslator.FromOle(iOleColor)
r_bBoldFont = colColorableItems.Bold
bResult = True
End If
Catch objException As Exception
MessageBox.Show(objException.ToString)
End Try
Return bResult
End Function
Public Function GetTextEditorFontAndColorsItems(ByVal objDTE As EnvDTE.DTE, ByRef r_sFontFamily As String, _
ByRef r_sngFontSize As Single, ByRef r_colFontsAndColorsItems As EnvDTE.FontsAndColorsItems) As Boolean
Const CATEGORY_FONTS_AND_COLORS As String = "FontsAndColors"
Const PAGE_TEXT_EDITOR As String = "TextEditor"
Const PROPERTY_FONT_SIZE As String = "FontSize"
Const PROPERTY_FONT_FAMILY As String = "FontFamily"
Const PROPERTY_FONTS_AND_COLORS_ITEMS As String = "FontsAndColorsItems"
Dim colProperties As EnvDTE.Properties
Dim objValue As Object
Dim bResult As Boolean = False
Try
colProperties = objDTE.Properties(CATEGORY_FONTS_AND_COLORS, PAGE_TEXT_EDITOR)
If Not (colProperties Is Nothing) Then
objValue = colProperties.Item(PROPERTY_FONT_FAMILY).Value
r_sFontFamily = objValue.ToString
objValue = colProperties.Item(PROPERTY_FONT_SIZE).Value
r_sngFontSize = CType(objValue, Single)
objValue = colProperties.Item(PROPERTY_FONTS_AND_COLORS_ITEMS).Object
r_colFontsAndColorsItems = DirectCast(objValue, EnvDTE.FontsAndColorsItems)
bResult = True
End If
Catch objException As Exception
MessageBox.Show(objException.ToString)
End Try
Return bResult
End Function
End Class