none
VB.NET: Syntax Highlighting in a RichTextBox control

    Question

  • Using: Microsoft Visual Studio 2005

    HI,

     

    I am currently working on a code editor program for Linden Scripting Language (Second Life Code) and I am having a lot of trouble using the Syntax Highlighting class which i have found on a website (http://pietschsoft.com/post/2005/05/VBNET-Syntax-Highlighting-in-a-RichTextBox-control.aspx) I dont understand, the Class inherits the System.Windows.Forms.RichTextBox so it should change the color of the text if i type one of the keywords shouldnt it and i should not have to do any codeing for the RTB (or do i?) Any help will be greatly appriciated

     

    Code Snippet

    Public Class SyntaxRTB

    Inherits System.Windows.Forms.RichTextBox

     

    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _

    (ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

     

    Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWnd As Integer) As Integer

     

    Private _SyntaxHighlight_CaseSensitive As Boolean = False

    Private Words As New DataTable

     

    'Contains Windows Messages for the SendMessage API call

    Private Enum EditMessages

    LineIndex = 187

    LineFromChar = 201

    GetFirstVisibleLine = 206

    CharFromPos = 215

    PosFromChar = 1062

    End Enum

     

    Protected Overrides Sub OnTextChanged(ByVal e As System.EventArgs)

    ColorVisibleLines()

    End Sub

     

    Public Sub ColorRtb()

    Dim FirstVisibleChar As Integer

    Dim i As Integer = 0

    While i < Me.Lines.Length

    FirstVisibleChar = GetCharFromLineIndex(i)

    ColorLineNumber(i, FirstVisibleChar)

    i += 1

    End While

    End Sub

     

    Public Sub ColorVisibleLines()

    Dim FirstLine As Integer = FirstVisibleLine()

    Dim LastLine As Integer = LastVisibleLine()

    Dim FirstVisibleChar As Integer

    If (FirstLine = 0) And (LastLine = 0) Then

    'If there is no text it will error, so exit the sub

    Exit Sub

    Else

    While FirstLine < LastLine

    FirstVisibleChar = GetCharFromLineIndex(FirstLine)

    ColorLineNumber(FirstLine, FirstVisibleChar)

    FirstLine += 1

    End While

    End If

    End Sub

     

    Public Sub ColorLineNumber(ByVal LineIndex As Integer, ByVal lStart As Integer)

    Dim i As Integer = 0

    Dim Instance As Integer

    Dim LeadingChar, TrailingChar As String

    Dim SelectionAt As Integer = Me.SelectionStart

    Dim MyRow As DataRow

    Dim Line() As String, MyI As Integer, MyStr As String

    ' Lock the update

    LockWindowUpdate(Me.Handle.ToInt32)

    MyI = lStart

    If CaseSensitive Then

    Line = Split(Me.Lines(LineIndex).ToString, " ")

    Else

    Line = Split(Me.Lines(LineIndex).ToLower, " ")

    End If

    For Each MyStr In Line

    Me.SelectionStart = MyI

    Me.SelectionLength = MyStr.Length

    If Words.Rows.Contains(MyStr) Then

    MyRow = Words.Rows.Find(MyStr)

    If (Not CaseSensitive) Or (CaseSensitive And MyRow("Word") = MyStr) Then

    Me.SelectionColor = Color.FromName(MyRow("Color"))

    End If

    Else

    Me.SelectionColor = Color.Black

    End If

    MyI += MyStr.Length + 1

    Next

    ' Restore the selectionstart

    Me.SelectionStart = SelectionAt

    Me.SelectionLength = 0

    Me.SelectionColor = Color.Black

    ' Unlock the update

    LockWindowUpdate(0)

    End Sub

     

    Public Function GetCharFromLineIndex(ByVal LineIndex As Integer) As Integer

    Return SendMessage(Me.Handle, EditMessages.LineIndex, LineIndex, 0)

    End Function

     

    Public Function FirstVisibleLine() As Integer

    Return SendMessage(Me.Handle, EditMessages.GetFirstVisibleLine, 0, 0)

    End Function

     

    Public Function LastVisibleLine() As Integer

    Dim LastLine As Integer = FirstVisibleLine() + (Me.Height / Me.Font.Height)

    If LastLine > Me.Lines.Length Or LastLine = 0 Then

    LastLine = Me.Lines.Length

    End If

    Return LastLine

    End Function

     

    Public Sub New()

    Dim MyRow As DataRow

    Dim arrKeyWords() As String, strKW As String

    Me.AcceptsTab = True

    ''Load all the keywords and the colors to make them

    Words.Columns.Add("Word")

    Words.PrimaryKey = New DataColumn() {Words.Columns(0)}

    Words.Columns.Add("Color")

    arrKeyWords = New String() {"select", "insert", "delete", _

    "truncate", "from", "where", "into", "inner", "update", _

    "outer", "on", "is", "declare", "set", "use", "values", "as", _

    "order", "by", "drop", "view", "go", "trigger", "cube", _

    "binary", "varbinary", "image", "char", "varchar", "text", _

    "datetime", "smalldatetime", "decimal", "numeric", "float", _

    "real", "bigint", "int", "smallint", "tinyint", "money", _

    "smallmoney", "bit", "cursor", "timestamp", "uniqueidentifier", _

    "sql_variant", "table", "nchar", "nvarchar", "ntext", "left", _

    "right", "like", "and", "all", "in", "null", "join", "not", "or"}

    For Each strKW In arrKeyWords

    MyRow = Words.NewRow()

    MyRow("Word") = strKW

    MyRow("Color") = Color.LightCoral.Name

    Words.Rows.Add(MyRow)

    Next

    End Sub

     

    Public Property CaseSensitive() As Boolean

    Get

    Return _SyntaxHighlight_CaseSensitive

    End Get

    Set(ByVal Value As Boolean)

    _SyntaxHighlight_CaseSensitive = Value

    End Set

    End Property

     

     

    End Class

     

     

     

    Wednesday, April 23, 2008 9:03 AM

Answers

  • If what you are trying to do is change color of key -words, here is code I just wrote to do this.  It assumes if you have a form with RTF box called RichTextBox1.  Paste this event handler into this form

     

    Code Snippet

    Private Sub RichTextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RichTextBox1.TextChanged

    Dim words As New List(Of String)

    words.Add("Select")

    words.Add("Insert")

    If RichTextBox1.Text.Length > 0 Then

    Dim selectStart As Integer = RichTextBox1.SelectionStart

    RichTextBox1.Select(0, RichTextBox1.Text.Length)

    RichTextBox1.SelectionColor = Color.Black

    RichTextBox1.DeselectAll()

    For Each oneWord As String In words

    Dim pos As Integer = 0

    Do While RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos) >= 0

    pos = RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos)

    RichTextBox1.Select(pos, oneWord.Length)

    RichTextBox1.SelectionColor = Color.Blue

    pos += 1

    Loop

    Next

    RichTextBox1.SelectionStart = selectStart

    End If

    End Sub

     

     

     

    Thursday, April 24, 2008 1:59 AM

All replies

  • If what you are trying to do is change color of key -words, here is code I just wrote to do this.  It assumes if you have a form with RTF box called RichTextBox1.  Paste this event handler into this form

     

    Code Snippet

    Private Sub RichTextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RichTextBox1.TextChanged

    Dim words As New List(Of String)

    words.Add("Select")

    words.Add("Insert")

    If RichTextBox1.Text.Length > 0 Then

    Dim selectStart As Integer = RichTextBox1.SelectionStart

    RichTextBox1.Select(0, RichTextBox1.Text.Length)

    RichTextBox1.SelectionColor = Color.Black

    RichTextBox1.DeselectAll()

    For Each oneWord As String In words

    Dim pos As Integer = 0

    Do While RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos) >= 0

    pos = RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos)

    RichTextBox1.Select(pos, oneWord.Length)

    RichTextBox1.SelectionColor = Color.Blue

    pos += 1

    Loop

    Next

    RichTextBox1.SelectionStart = selectStart

    End If

    End Sub

     

     

     

    Thursday, April 24, 2008 1:59 AM
  • Thanks for your previous post. The code works! but theres a problem. When there is some text in the RichTextBox, if a person goes back to edit a word or sentence it starts selecting words in front of the text cursor which cause the person to start overwriting.

     

    Is there a way to fix this?

     

     

    Thursday, April 24, 2008 12:41 PM
  • Just add RichTextBox1.SelectionLength = 0 at the very bottom of the code before End If and after RichTextBox1.SelectionStart = ...
    Sunday, May 18, 2008 7:13 PM
  • Thanks for this code I was close When i was making it myself, But after i found this code I used it because Its abit more clean then mine, so how can i add it more then once So like words = the and bob ect... but I make a new dim call it words 2 = for next then ect... diffrent color I do this and it cancels out the blue the first one, so like this

      Dim words As New List(Of String)
            Dim words2 As New List(Of String)

       words.Add("and")
            words2.Add("for")

     

      If RichTextBox1.Text.Length > 0 Then

                Dim selectStart As Integer = RichTextBox1.SelectionStart

                RichTextBox1.Select(0, RichTextBox1.Text.Length)

                RichTextBox1.SelectionColor = Color.Black

                RichTextBox1.DeselectAll()

                For Each oneWord As String In words
                   
                    Dim pos As Integer = 0

                    Do While RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos) >= 0

                        pos = RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos)

                        RichTextBox1.Select(pos, oneWord.Length)

                        RichTextBox1.SelectionColor = Color.Blue

                        pos += 1


                    Loop

                Next

                RichTextBox1.SelectionLength = 0
                    RichTextBox1.SelectionStart = selectStart

            End If

     If RichTextBox1.Text.Length > 0 Then

                Dim selectStart As Integer = RichTextBox1.SelectionStart

                RichTextBox1.Select(0, RichTextBox1.Text.Length)

                RichTextBox1.SelectionColor = Color.Black

                RichTextBox1.DeselectAll()

                For Each oneWord As String In words2

                    Dim pos As Integer = 0

                    Do While RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos) >= 0

                        pos = RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos)

                        RichTextBox1.Select(pos, oneWord.Length)

                        RichTextBox1.SelectionColor = Color.Purple

                        pos += 1


                    Loop

                Next

                RichTextBox1.SelectionLength = 0
                RichTextBox1.SelectionStart = selectStart

            End If
    So then i try it purple works but now blue does not.... Thanks in advance!!!  Waiting reply!

    Please help me on this code i do not want any other code i know its possible with this one! All i want is to be able to add other words in a different color! Because this code works like a charm

    Wednesday, September 29, 2010 9:45 PM
  • I know this may be a little late but taking the above code and modifying it you can acheive what you desire. Here is an example of what I did to produce multicolored words that you seek. Looking at the code you can see what I did and know how to add more colors and words if desired. Just be careful and watch for "END IF" statements. Should only exist at end of code else first color hit would end sub I think.

    Private

    Sub RichTextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RichTextBox1.TextChanged

     

    Dim wordsRED As New List(Of String)

     

    Dim wordsBLUE As New List(Of String)

     

    Dim wordsPURPLE As New List(Of String)

     

    Dim wordsGREEN As New List(Of String)

     

    'Red Word List

    wordsRED.Add(

    "RED")

    wordsRED.Add(

    "bike")

     

    'Blue Word List

    wordsBLUE.Add(

    "BLUE")

    wordsBLUE.Add(

    "dog")

     

    'Purple Word List

    wordsPURPLE.Add(

    "PURPLE")

    wordsPURPLE.Add(

    "cat")

     

    'Green Word List

    wordsGREEN.Add(

    "GREEN")

    wordsGREEN.Add(

    "torch")

     

    If RichTextBox1.Text.Length > 0 Then

     

    Dim selectStart As Integer = RichTextBox1.SelectionStart

    RichTextBox1.Select(0, RichTextBox1.Text.Length)

    RichTextBox1.SelectionColor = Color.Black

    RichTextBox1.DeselectAll()

     

    'Red Colored Words

     

    For Each oneWord As String In wordsRED

     

    Dim pos As Integer = 0

     

    Do While RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos) >= 0

    pos = RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos)

    RichTextBox1.Select(pos, oneWord.Length)

    RichTextBox1.SelectionColor = Color.Red

    pos += 1

     

    Loop

     

    Next

    RichTextBox1.SelectionStart = selectStart

     

    'Blue Colored Words

     

    For Each oneWord As String In wordsBLUE

     

    Dim pos As Integer = 0

     

    Do While RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos) >= 0

    pos = RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos)

    RichTextBox1.Select(pos, oneWord.Length)

    RichTextBox1.SelectionColor = Color.Blue

    pos += 1

     

    Loop

     

    Next

    RichTextBox1.SelectionStart = selectStart

     

    'Purple Colored Words

     

    For Each oneWord As String In wordsPURPLE

     

    Dim pos As Integer = 0

     

    Do While RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos) >= 0

    pos = RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos)

    RichTextBox1.Select(pos, oneWord.Length)

    RichTextBox1.SelectionColor = Color.Purple

    pos += 1

     

    Loop

     

    Next

    RichTextBox1.SelectionStart = selectStart

     

    'Green Colored Words

     

    For Each oneWord As String In wordsGREEN

     

    Dim pos As Integer = 0

     

    Do While RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos) >= 0

    pos = RichTextBox1.Text.ToUpper.IndexOf(oneWord.ToUpper, pos)

    RichTextBox1.Select(pos, oneWord.Length)

    RichTextBox1.SelectionColor = Color.Green

    pos += 1

     

    Loop

     

    Next

    RichTextBox1.SelectionStart = selectStart

     

    End If

     

    End Sub
    Monday, March 21, 2011 4:43 PM