Colorisation syntaxique
Description
Voici le problème de la colorisation syntaxique expliqué partiellement.
Cette source est hyper commenté et destinée aux plus débutants qui y apprendront de nombreuses choses.
La routine reste à être amélioré pour être utilisée serieusement mais les bases sont là.
Cependant, l'ayant fait sur un 2 Ghz, je me demande comment il tourne sur un plus petit (style 300 Mhz). Si vous êtes dans ce cas, tenez-moi informé des performances.
Tout est dans le ZIP.
Cette source est hyper commenté et destinée aux plus débutants qui y apprendront de nombreuses choses.
La routine reste à être amélioré pour être utilisée serieusement mais les bases sont là.
Cependant, l'ayant fait sur un 2 Ghz, je me demande comment il tourne sur un plus petit (style 300 Mhz). Si vous êtes dans ce cas, tenez-moi informé des performances.
Tout est dans le ZIP.
Source / Exemple :
'Cette variable sert à ne pas réappeler
' une procédure en cours...
Private AntiRecursif As Boolean
Private CoulRouge As Byte
Private CoulVerte As Byte
Private CoulBleue As Byte
Private Couleur As Long
Private CoulRougeElement As Byte
Private CoulVerteElement As Byte
Private CoulBleueElement As Byte
Private CouleurElement As Long
Private varItem As Long
'================================================================
' INITIALISATION DU PROGRAMME
'================================================================
Private Sub Form_Load()
varItem = 0
End Sub
'================================================================
'================================================================
'================================================================
'================================================================
' GESTION DES COULEURS
'================================================================
Private Sub HScrollRouge_Change(): Call HScrollRouge_Scroll: End Sub
Private Sub HScrollRouge_Scroll()
CoulRouge = HScrollRouge.Value
'Note: Cstr permet de convertir un nombre
' en texte sans ajouter d'espace avant
' comme le fait Str().
ztxRouge.Text = CStr(CoulRouge)
Call CouleurChanged
End Sub
Private Sub HScrollVerte_Change(): Call HScrollVerte_Scroll: End Sub
Private Sub HScrollVerte_Scroll()
CoulVerte = HScrollVerte.Value
ztxVerte.Text = CStr(CoulVerte)
Call CouleurChanged
End Sub
Private Sub HScrollBleue_Change(): Call HScrollBleue_Scroll: End Sub
Private Sub HScrollBleue_Scroll()
CoulBleue = HScrollBleue.Value
ztxBleue.Text = CStr(CoulBleue)
Call CouleurChanged
End Sub
Private Sub CouleurChanged()
'Notes :
'La fonction RGB permet d'obtenir le numéro d'une couleur
' en fonction des 3 composantes rouge, vert et bleu.
' Ce nombre est compris (lorsqu'on travail en 24 bits comme
' dans la pluspart des cas) entre 0 et 16'777'215.
' 24 bits = 2 puissance 24 = 16'777'216 couleurs possibles
' La variable devra donc être de type Long et non de de type
' Integer. Par contre, les sub-pixels, eux, varient de 0 à 255
' (soit 256 nuances) et sont donc de type Byte.
'La fonction CByte convertie un texte en nombre de type Byte justement.
Couleur = RGB(CByte(ztxRouge.Text), CByte(ztxVerte.Text), CByte(ztxBleue.Text))
ShapeCouleur.BackColor = Couleur
End Sub
'================================================================
'================================================================
'================================================================
'================================================================
' GESTION DE LA LISTE
'================================================================
Private Sub ztxElement_KeyUp(KeyCode As Integer, Shift As Integer)
'Static veut dire que la variable sera conservée
' après chaque appel de cette procédure.
'Autrement dit, elle ne sera pas détruite à la fin.
'On utilise cette technique parce que cette procédure
' est appelée souvent.
Static t As Integer 'Variable temporaire
Static varModifier As Boolean 'Variable de détection
If AntiRecursif = True Then Exit Sub
AntiRecursif = True
'Dès qu'on appuye sur une touche,
If ztxElement.Text = "" Then
'Désactive le bouton Ajouter et Modifier s'il n'y a pas de texte
btnAjouter.Enabled = False
btnModifier.Enabled = False
Else
'S'il y a du texte :
'Il faut parcourir la liste pour savoir
' si ce texte existe déjà ou non.
'S'il existe déjà, on active le bouton Modifier
' et on désactive le bouton Ajouter.
'Dans le cas contraire, on fait l'inverse.
varModifier = False
If ListeDesMots.ListCount > 0 Then
'Ne teste ça que si il y au moins un mot dans la liste
For t = 0 To (ListeDesMots.ListCount - 1)
If ListeDesMots.List(t) = ztxElement.Text Then varModifier = True: Exit For
Next t
End If
If varModifier = True Then
btnModifier.Enabled = True
btnAjouter.Enabled = False
Else
btnModifier.Enabled = False
btnAjouter.Enabled = True
End If
End If
AntiRecursif = False
End Sub
Private Sub btnAjouter_Click()
'Test de sécurité...
If ztxElement.Text = "" Then Exit Sub
varItem = varItem + 1
ListeDesMots.AddItem ztxElement.Text
ListeDesCouleurs.AddItem CStr(CouleurElement)
ListeDesMots.ItemData(ListeDesMots.NewIndex) = varItem
ListeDesCouleurs.ItemData(ListeDesCouleurs.NewIndex) = varItem
ListeDesMots.ListIndex = ListeDesMots.NewIndex
btnModifier.Enabled = True
btnAjouter.Enabled = False
btnSupprimer.Enabled = True
End Sub
Private Sub btnSupprimer_Click()
Static t As Long
If ListeDesMots.ListIndex < 0 Then btnSupprimer.Enabled = False: Exit Sub
For t = 0 To (ListeDesCouleurs.ListCount - 1)
If ListeDesMots.ItemData(ListeDesMots.ListIndex) = ListeDesCouleurs.ItemData(t) Then
ListeDesCouleurs.RemoveItem t
Exit For
End If
Next t
t = ListeDesMots.ListIndex
ListeDesMots.RemoveItem ListeDesMots.ListIndex
If ListeDesMots.ListCount < 1 Then
ztxElement.Text = ""
CouleurElement = 0
ShapeCouleurElement.BackColor = 0
btnModifier.Enabled = False
btnAjouter.Enabled = False
btnSupprimer.Enabled = False
Else
If t > (ListeDesMots.ListCount - 1) Then t = (ListeDesMots.ListCount - 1)
ListeDesMots.ListIndex = t
btnModifier.Enabled = True
btnAjouter.Enabled = False
btnSupprimer.Enabled = True
End If
End Sub
Private Sub btnModifier_Click()
Static t As Long
If ztxElement = "" Then btnModifier.Enabled = False: Exit Sub
For t = 0 To (ListeDesCouleurs.ListCount - 1)
If ListeDesCouleurs.ItemData(t) = ListeDesMots.ItemData(ListeDesMots.ListIndex) Then
ListeDesCouleurs.ItemData(t) = CouleurElement
End If
Next t
End Sub
Private Sub btnChangerCouleur_Click()
ShapeCouleurElement.BackColor = Couleur
CouleurElement = Couleur
End Sub
Private Sub ListeDesMots_Click()
Static BackCouleur As Long
Static t As Long
If ListeDesMots.ListIndex < 0 Then
ztxElement.Text = ""
CouleurElement = 0
ShapeCouleurElement.BackColor = 0
btnModifier.Enabled = False
btnAjouter.Enabled = False
btnSupprimer.Enabled = False
Else
ztxElement.Text = ListeDesMots.List(ListeDesMots.ListIndex)
For t = 0 To (ListeDesCouleurs.ListCount - 1)
If ListeDesCouleurs.ItemData(t) = _
ListeDesMots.ItemData(ListeDesMots.ListIndex) Then _
CouleurElement = CLng(ListeDesCouleurs.List(t))
Next t
ShapeCouleurElement.BackColor = CouleurElement
btnModifier.Enabled = True
btnAjouter.Enabled = False
btnSupprimer.Enabled = True
End If
End Sub
'================================================================
' COLORATION SYNTAXIQUE
'================================================================
'Note: Cette méthode pourait aussi, pour rendre l'utilisation
' moins lourde, se lancer toutes les x millisecondes via
' un timer. Pour cela, il faudrait placer tout ce code
' dans la procédure d'événement du timer...
Private Sub RichTextBox1_KeyPress(KeyAscii As Integer)
'Méthode par recherche :
'(méthode lente mais c'est pour l'exemple)
Static t As Single
Static tt As Single
Static TextRechercher As String
Static Position As Single
Static varDebut As Single
Static Coul As Long
Static RechercheTerminer As Boolean
'La méthode consiste à recherche tous les mots de la liste
' et à reconsituer les balises RTF.
'Note : plus il y a de mots, plus le programme sera lent!
'Tout d'abord, on récupère la position actuelle du curseur.
Position = RichTextBox1.SelStart
'Efface toutes les couleurs du texte
' Note: une méthode plus fine pourrait être trouvée...
RichTextBox1.SelStart = 1
RichTextBox1.SelLength = Len(RichTextBox1.Text)
RichTextBox1.SelColor = 0 'Encre Noir par défaut...
'Un autre moyen :
'RichTextBox1.TextRTF = RichTextBox1.Text
'S'il n'y a aucun mot, on sort.
If ListeDesMots.ListCount < 1 Then
RichTextBox1.SelStart = Position
Exit Sub
End If
For t = 0 To (ListeDesMots.ListCount - 1)
RechercheTerminer = False
TextRechercher = ListeDesMots.List(t)
For tt = 0 To (ListeDesCouleurs.ListCount - 1)
If ListeDesCouleurs.ItemData(tt) = ListeDesMots.ItemData(t) Then _
Coul = ListeDesCouleurs.List(tt): Exit For
Next tt
varDebut = 1
RichTextBox1.SelStart = varDebut
Do
'rtfMatchCase = Respecter la casse
' (c.a.d. les majuscules et les minuscules)
' Puisque la "Fin" est omise, toutes les recherches
' s'effecturons jusqu'a la fin texte.
'rtfWholeWord = Rechercher par mot.
tt = RichTextBox1.Find(TextRechercher, varDebut, , rtfWholeWord + rtfMatchCase)
If tt = -1 Then
'Il n'y a plus d'occurrence
RechercheTerminer = True
Else
'La recherche à aboutie. Il faut remplacer le mot
' par le mot + les balises RTF de couleur.
'Il faut ensuite placer le curseur à la fin du
' mot pour poursuivre la recherche.
RichTextBox1.SelColor = Coul
varDebut = varDebut + RichTextBox1.SelLength
End If
Loop While RechercheTerminer <> True
Next t
RichTextBox1.SelStart = Position
End Sub
'================================================================
'================================================================
'================================================================
'================================================================
' NOTES DE FIN
'================================================================
' La routine de recherche n'est pas très fine (surtout s'agissant
' de la gestion des espaces et des cas particuliers) mais c'est
' à vous d'en faire ce que vous voudrez.
' Il ne reste plus qu'a rajouter la gestion de l'enregistrement
' des fichiers (RTF ou TXT).
' Notez que ma gestion des couleurs n'est pas très performante.
' Il vaudrait mieux utiliser des PictureBox et utiliser le
' contrôle ActiveX "Microsoft CommonDialog"...
' Je n'ai pas non plus filtré les entrées texte (p.ex. enlever
' les espaces de début et de fin des expressions).
'
' A VOUS DE JOUER !
'================================================================
'================================================================
'================================================================
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.