[vb.net] class de coloration syntaxique "on the fly"

Commenter

Contenu du snippet

Bonjour,

Voici un essais de coloration syntaxique dans un RichTextBox.
Code bricolage à base de SelectionStart - Selectionlength

Source / Exemple : 


Public Class CsRichTextBox
    Inherits RichTextBox

    Private Dcolor As System.Drawing.Color = Color.Black
    Private Dsyntaxe As Font = New Font("Microsoft Sans Serif", 8, FontStyle.Regular)
    Private Citationcolor As System.Drawing.Color = Color.Gray
    Private Citationsyntaxe As Font = New Font("Microsoft Sans Serif", 8, FontStyle.Italic)
    Private Integercolor As System.Drawing.Color = Color.Red
    Private Integersyntaxe As Font = New Font("Microsoft Sans Serif", 8, FontStyle.Bold)

    Private Nbwords As Integer = 0
    Private Nbponctuation As Integer = 0
    Private Cwords() As String = New String(999) {}
    Private Cponctuation() As String = New String(999) {}
    Private Ccolor() As System.Drawing.Color = New System.Drawing.Color(999) {}
    Private Csyntaxe() As Font = New Font(999) {}

    Private AccesEvent As Boolean = True

    Private PositionCurseur As Integer = 0
    Private PositionPrecedentCurseur As Integer = 0

    Private StartWord As Integer = New Integer
    Private EndWord As Integer = New Integer
    Private EndPaste As Integer = New Integer

    Delegate Sub WordFindHandler(ByVal sender As Object, ByVal e As WordFind)
    Public Event WordFindEvent As WordFindHandler

'Ajout d'un mot pour lequel nous definissons une mise en forme automatique
    Public Sub AddWord(ByVal word As String, ByVal color As System.Drawing.Color, ByVal Syntaxe As Font, ByVal Ponctuation As Boolean)
        If Ponctuation Then
            Cponctuation(Nbponctuation) = word
            Nbponctuation = Nbponctuation + 1
        End If

        Cwords(Nbwords) = word
        Ccolor(Nbwords) = color
        Csyntaxe(Nbwords) = Syntaxe

        Nbwords = Nbwords + 1
    End Sub
'Type de mise en forme du texte de commentaire
    Public Sub DefaultCS(ByVal color As System.Drawing.Color, ByVal Syntaxe As Font)
        Dcolor = color
        Dsyntaxe = Syntaxe
    End Sub
'Type de mise en forme du texte entre guillemet
    Public Sub CitationCS(ByVal color As System.Drawing.Color, ByVal Syntaxe As Font)
        Citationcolor = color
        Citationsyntaxe = Syntaxe
    End Sub
'Type de mise en forme du texte de type Integer (Nombre)
    Public Sub IntegerCS(ByVal color As System.Drawing.Color, ByVal Syntaxe As Font)
        Integercolor = color
        Integersyntaxe = Syntaxe
    End Sub

'Selectionne le dernier mot ecrit ou en cours d'ecriture à chaque modification dans le textbox
    Private Sub Me_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Me.TextChanged
        If AccesEvent Then 'Permet d'eviter une boucle infini lors de la detection d'un mot à mettre en forme (Changement du contenu de la textbox lors du changement de mise en forme)
            Dim i As Integer = Me.SelectionStart - PositionCurseur

            If i > 1 Then
                Dim Length As Integer = Me.SelectionStart - PositionCurseur
                Me.SelectionStart = PositionCurseur
                Me.SelectionLength = Length

                EndPaste = PositionCurseur + Length

                Me.CodePaste()
            Else
                If PositionCurseur <> Me.SelectionStart Then
                    PositionPrecedentCurseur = PositionCurseur
                End If
                PositionCurseur = Me.SelectionStart

                Try
                    StartWord = Me.Find(Chr(32), 0, PositionPrecedentCurseur, RichTextBoxFinds.Reverse Or RichTextBoxFinds.NoHighlight) + 1
                    EndWord = Me.Find(Chr(32), PositionPrecedentCurseur, RichTextBoxFinds.NoHighlight)
                Catch
                End Try

                If StartWord = -1 Then
                    StartWord = 0
                End If
                If EndWord = -1 Then
                    EndWord = 0
                End If

                Me.AnalyseWord()
            End If
        End If
    End Sub
'Selectionne le dernier mot ecrit avant de quitter le focus du textbox
    Private Sub Me_LostFocus(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Me.LostFocus
        If AccesEvent Then
            If PositionCurseur <> Me.SelectionStart Then
                PositionPrecedentCurseur = PositionCurseur
            End If
            PositionCurseur = Me.SelectionStart

            Try
                StartWord = Me.Find(Chr(32), 0, PositionPrecedentCurseur, RichTextBoxFinds.Reverse Or RichTextBoxFinds.NoHighlight) + 1
                EndWord = Me.Find(Chr(32), PositionPrecedentCurseur, RichTextBoxFinds.NoHighlight)
            Catch
            End Try

            If StartWord = -1 Then
                StartWord = 0
            End If
            If EndWord = -1 Then
                EndWord = 0
            End If

            Me.AnalyseWord()
        End If
    End Sub
'Selectionne le dernier mot ecrit lors d'un changement de position du curseur via la sourie
    Private Sub Me_click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Me.Click
        If AccesEvent Then
            If PositionCurseur <> Me.SelectionStart Then
                PositionPrecedentCurseur = PositionCurseur
            End If
            PositionCurseur = Me.SelectionStart

            Try
                StartWord = Me.Find(Chr(32), 0, PositionPrecedentCurseur, RichTextBoxFinds.Reverse Or RichTextBoxFinds.NoHighlight) + 1
                EndWord = Me.Find(Chr(32), PositionPrecedentCurseur, RichTextBoxFinds.NoHighlight)
            Catch
            End Try

            If StartWord = -1 Then
                StartWord = 0
            End If
            If EndWord = -1 Then
                EndWord = 0
            End If

            Me.AnalyseWord()
        End If
    End Sub

'Analyse du mot selectionné pour le mettre en forme si necessaire
    Private Sub AnalyseWord()
        AccesEvent = False

        Dim SearchPonctuation As Boolean = True
        Dim EndPonctuation As Boolean = False

        If (EndWord - StartWord) > 0 Then
            Me.SelectionStart = Me.StartWord
            Me.SelectionLength = Me.EndWord - Me.StartWord

            Me.SelectionColor = Me.Dcolor
            Me.SelectionFont = Me.Dsyntaxe

            Try
                Dim test As Integer = CInt(Me.SelectedText)
                Me.SelectionColor = Integercolor
                Me.SelectionFont = Integersyntaxe
            Catch
                For Indice2 = 0 To Nbwords - 1
                    If Me.SelectedText = Cwords(Indice2) Then
                        RaiseEvent WordFindEvent(Me, New WordFind(Indice2, Me.SelectionStart, Me.SelectionLength))
                        Exit For
                    End If
                Next
            End Try

            If SearchPonctuation Then
                Dim NextPonctuation As Boolean = True
                Dim IndicePonctuation As Integer = -1
                Dim IndicePosition As Integer = Me.SelectedText.Length + 2

                While NextPonctuation
                    For Indice = 0 To Nbponctuation - 1
                        If Me.SelectedText.IndexOf(Cponctuation(Indice)) >= 0 Then
                            If IndicePosition > Me.SelectedText.IndexOf(Cponctuation(Indice)) Then
                                IndicePosition = Me.SelectedText.IndexOf(Cponctuation(Indice))
                                IndicePonctuation = Indice

                                If IndicePosition = 0 Then
                                    Exit For
                                End If
                            End If
                        End If
                    Next

                    If IndicePonctuation >= 0 Then
                        While Me.SelectedText.IndexOf(Cponctuation(IndicePonctuation)) >= 0
                            Dim SelWord1Start As Integer = Me.SelectionStart
                            Dim SelWord1Length As Integer = (Me.SelectionStart + Me.SelectedText.IndexOf(Cponctuation(IndicePonctuation))) - Me.SelectionStart
                            Dim SelPonctuationStart As Integer = Me.SelectedText.IndexOf(Cponctuation(IndicePonctuation)) + Me.SelectionStart
                            Dim SelPonctuationLength As Integer = Cponctuation(IndicePonctuation).Length
                            Dim SelWord2Start As Integer = SelPonctuationStart + Cponctuation(IndicePonctuation).Length
                            Dim SelWord2Length As Integer = Me.SelectionLength + Me.SelectionStart - SelWord2Start

                            Me.SelectionStart = SelWord1Start
                            Me.SelectionLength = SelWord1Length

                            If SelWord1Start - SelPonctuationLength > 0 Then
                                Try
                                    If Me.Text.Substring(SelWord1Start - SelPonctuationLength, SelPonctuationLength) = Me.Text.Substring(SelPonctuationStart, SelPonctuationLength) Then
                                        Me.SelectionColor = Citationcolor
                                        Me.SelectionFont = Citationsyntaxe
                                    Else
                                        Try
                                            Dim test As Integer = CInt(Me.SelectedText)
                                            Me.SelectionColor = Integercolor
                                            Me.SelectionFont = Integersyntaxe
                                        Catch
                                            For Indice2 = 0 To Nbwords - 1
                                                If Me.SelectedText = Cwords(Indice2) Then
                                                    RaiseEvent WordFindEvent(Me, New WordFind(Indice2, Me.SelectionStart, Me.SelectionLength))
                                                    Exit For
                                                End If
                                            Next
                                        End Try
                                    End If
                                Catch
                                    Try
                                        Dim test As Integer = CInt(Me.SelectedText)
                                        Me.SelectionColor = Integercolor
                                        Me.SelectionFont = Integersyntaxe
                                    Catch
                                        For Indice2 = 0 To Nbwords - 1
                                            If Me.SelectedText = Cwords(Indice2) Then
                                                RaiseEvent WordFindEvent(Me, New WordFind(Indice2, Me.SelectionStart, Me.SelectionLength))
                                                Exit For
                                            End If
                                        Next
                                    End Try
                                End Try
                            Else
                                Try
                                    Dim test As Integer = CInt(Me.SelectedText)
                                    Me.SelectionColor = Integercolor
                                    Me.SelectionFont = Integersyntaxe
                                Catch
                                    For Indice2 = 0 To Nbwords - 1
                                        If Me.SelectedText = Cwords(Indice2) Then
                                            RaiseEvent WordFindEvent(Me, New WordFind(Indice2, Me.SelectionStart, Me.SelectionLength))
                                            Exit For
                                        End If
                                    Next
                                End Try
                            End If

                            Me.SelectionStart = SelPonctuationStart
                            Me.SelectionLength = SelPonctuationLength

                            For Indice2 = 0 To Nbwords - 1
                                If Me.SelectedText = Cwords(Indice2) Then
                                    RaiseEvent WordFindEvent(Me, New WordFind(Indice2, Me.SelectionStart, Me.SelectionLength))
                                    Exit For
                                End If
                            Next

                            Me.SelectionStart = SelWord2Start
                            Me.SelectionLength = SelWord2Length

                            For Indice2 = 0 To Nbwords - 1
                                If Me.SelectedText = Cwords(Indice2) Then
                                    RaiseEvent WordFindEvent(Me, New WordFind(Indice2, Me.SelectionStart, Me.SelectionLength))
                                    EndPonctuation = True
                                    Exit For
                                End If
                            Next

                            If EndPonctuation Then
                                NextPonctuation = False
                            Else
                                Me.SelectionStart = SelWord2Start
                                Me.SelectionLength = SelWord2Length
                            End If
                        End While

                        IndicePosition = Me.SelectedText.Length + 2
                        IndicePonctuation = -1
                    Else
                        NextPonctuation = False
                    End If
                End While
            End If
        End If

        Me.SelectionStart = Me.PositionCurseur
        Me.SelectionLength = 0

        AccesEvent = True
    End Sub
'Analyse complete du text coller dans la textbox
    Private Sub CodePaste()
        While Me.SelectedText.IndexOf(Chr(32)) >= 0
            Dim SelWord1Start As Integer
            Dim SelWord1Length As Integer
            Dim SelWord2Start As Integer
            Dim SelWord2Length As Integer

            SelWord1Start = Me.SelectionStart
            SelWord1Length = Me.SelectedText.IndexOf(Chr(32))
            SelWord2Start = Me.SelectionStart + Me.SelectedText.IndexOf(Chr(32)) + 1
            SelWord2Length = Me.SelectionLength + Me.SelectionStart - SelWord2Start

            Me.SelectionStart = SelWord1Start
            Me.SelectionLength = SelWord1Length
            StartWord = SelWord1Start
            EndWord = SelWord1Start + SelWord1Length

            Me.AnalyseWord()

            Me.SelectionStart = SelWord2Start
            Me.SelectionLength = SelWord2Length
        End While

        If Me.SelectedText.IndexOf(Chr(32)) = -1 And Me.SelectionLength > 0 Then
            StartWord = Me.SelectionStart
            EndWord = StartWord + Me.SelectionLength

            Me.AnalyseWord()
        End If

        Me.SelectionStart = EndPaste
        Me.SelectionLength = 0
    End Sub

'Application de la mise en forme sur un mot détécté
   Private Sub _ModifWord(ByVal sender As System.Object, ByVal e As WordFind) Handles Me.WordFindEvent
        Dim Infos() As String = e.wordfind()

        Me.SelectionStart = Infos(1)
        Me.SelectionLength = Infos(2)

        Me.SelectionColor = Ccolor(CInt(Infos(0)))
        Me.SelectionFont = Csyntaxe(CInt(Infos(0)))
    End Sub
End Class

'
Public Class WordFind
    Inherits System.EventArgs

    Private IndiceWord As Integer
    Private StartIndex As Integer = 0
    Private Length As Integer = 0

    Public Sub New(ByVal Indice As Integer, ByVal StIndex As Integer, ByVal Wdlength As Integer)
        IndiceWord = Indice
        StartIndex = StIndex
        Length = Wdlength
    End Sub
    Public ReadOnly Property wordfind() As Object
        Get
            Dim IndiceReturn() As String = New String(2) {IndiceWord.ToString, StartIndex.ToString, Length.ToString}
            IndiceWord = Nothing
            StartIndex = 0
            Length = 0

            Return IndiceReturn
        End Get
    End Property
End Class

'################################################################
Pour l'utiliser, il faut indiquer ceci  dans votre fonction :
'################################################################

Dim Rtb As New CsRichTextBox

Rtb.Size = New System.Drawing.Size(400, 150)
Rtb.Location = New System.Drawing.Point(10, 10)
Rtb.Name = "MyRtb"

Me.Controls.Add(Rtb)

Rtb.AddWord("SELECT", Color.Blue, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), False)
Rtb.AddWord("INSERT", Color.Blue, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), False)
Rtb.AddWord("UPDATE", Color.Blue, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), False)
Rtb.AddWord("FROM", Color.Blue, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), False)
Rtb.AddWord("INTO", Color.Blue, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), False)
Rtb.AddWord("WHERE", Color.Blue, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), False)
Rtb.AddWord("ORDER", Color.Blue, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), False)
Rtb.AddWord("GROUP", Color.Blue, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), False)
Rtb.AddWord("BY", Color.Blue, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), False)
Rtb.AddWord("LIMIT", Color.Blue, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), False)
Rtb.AddWord("VALUES", Color.Blue, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), False)
Rtb.AddWord("AND", Color.Red, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), False)
Rtb.AddWord("OR", Color.Red, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), False)
Rtb.AddWord("+", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord("-", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord("*", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord("/", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord("=", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord("(", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord(")", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord("'", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord(",", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord(".", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord(";", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord("<", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord(">", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord("<>", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord(">=", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord("<=", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)
Rtb.AddWord("""", Color.Green, New Font("Microsoft Sans Serif", 8, FontStyle.Bold), True)

Conclusion :


Le code fonctionne mais ne me convient pas, il peut neanmoins peut être aider quelqu'un pour certaines parties.

Il y a surment possibilité de l'améliorer, ceci dit j'en ai pas l'intention, la coloration syntaxique "Propre" ne passe surment pas par ce type de méthode.

Si quelqu'un sait comment s'y prendre pour en faire une dite "Propre" (sans clignotement et plus performant) je suis preneur.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.