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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 5 005 fois - Téléchargée 18 fois

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

Ajouter un commentaire

Commentaires

Messages postés
6
Date d'inscription
samedi 17 juin 2006
Statut
Membre
Dernière intervention
23 mars 2011

Merci beaucoup,

J'ai pas encore regardé, là je par du taff (1h45 de sup aujourd'hui pour un cumul qui dépasse les 30h... faut pas trop pousser non plus :P), mais dès que j'ai le temps je zieute.
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
63
http://www.csharpfr.com/codes/RICHTEXTBOX-COLORATION-SYNTAXIQUE-TEMPS-REEL_52966.aspx

Facilement convertible en VB.Net, je pense...
(merci http://tools.codes-sources.com/DotNetCodeConverter.aspx )

Pour l'exemple, j'ai configuré la chose pour colorier du SQL ^^
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
63
C:\Windows\System32\RichEd20.dll
Messages postés
6
Date d'inscription
samedi 17 juin 2006
Statut
Membre
Dernière intervention
23 mars 2011

Ok, merci pour ce code.

Je suis pas doué pour convertir du C# en VB mais j'ai pu trouver la classe TOM sur le site de Microsoft (Msftedit.dll).

J'ai commencé à regarder, je comprend pas pour le moment mais j'ai déjà des idées qui me viennent avec ça pour avoir un code optimisé.

Je posterais surement ici le résultat final et dans un autre poste mon projet final qui en résultera (Un mini SQL manager pour IBM Universe), mais pour celui-ci ce ne sera pas avant quelque temps.
Messages postés
6
Date d'inscription
samedi 17 juin 2006
Statut
Membre
Dernière intervention
23 mars 2011

Merci Renfield, j'avoue que je n'ai rien trouvé sur google avec seulement le terme "TOM".
Ceci dit je n'ai trouvé à peine plus d'info avec le terme "Text Object Model" et je sais pas trop ou regarder.

Actuellement je teste une autre méthode qui est assez bricolage mais beaucoup plus performante, pas de sélection visible et pas de ralentissement, mais à coté de ça, il faut accepter de perdre totalement les fonctions de "Undo"/"Redo" ce qui me gène.

(En même temps, a mon avis temps que je passerais pas par TOM, le Undo/Redo sera toujours faussé).

La dernière méthode à l'essai et en fait, d'avoir dans ma classe héritée, un Rtb invisible dans lequel je copie tout le texte pour effectuer les fonctions de coloration, une fois fini je renvoi le tout dans le Rtb visible (celui ou on saisi) en remettant le curseur à la position qu'il avait.

De plus j'ai abandonnée l'idée de rechercher le dernier mot écrit pour l'analyser, il y a beaucoup trop de code rien que pour ça, cette fois je fait tout simplement un find en boucle de chaque mot recherché, je sélectionne et applique la coloration. Enfin j'applique le texte au format Rtf de mon Rtb2 vers mon Rtb1.

Cette méthode à pour inconvénient de faire perdre tout notion d'Undo/redo car à chaque envoi du texte du Rtb2 vers le Rtb1 on supprime tout pour tout remettre.

J'aime assé cette dernière méthode de recherche (rapide et efficace), couplé à un système de recherche par expressions régulières pour ce qui est entre guillemet le tout fonctionnant en TOM et j'aurais trouvé ce que je cherche a faire exactement.
Afficher les 10 commentaires

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.