COULEUR VB CHANGE LA COULEUR D'UN DOCUMENT POUR LUI DONNER UN STYLE VB
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/5505-couleur-vb-change-la-couleur-d-un-document-pour-lui-donner-un-style-vb
https://codes-sources.commentcamarche.net/source/5505-couleur-vb-change-la-couleur-d-un-document-pour-lui-donner-un-style-vb
- Messages postés
- 17286
- Date d'inscription
- mercredi 2 janvier 2002
- Statut
- Modérateur
- Dernière intervention
- 23 décembre 2019
61Const EM_LINEFROMCHAR = &hC9
et tu fais un SendMessage :
NbLigne = SendMessage ( Rtf.hwnd , EM_LINEFROMCHAR , -1 , byval 0& )
et voila !!! c'est pas une methode lourde, et c'est instantané.... ;-)
- Messages postés
- 196
- Date d'inscription
- samedi 12 janvier 2002
- Statut
- Membre
- Dernière intervention
- 1 septembre 2008
1fait attention car le vbcrlf prend 2 caractères (vbcr + vblf).
Jéspère que j'ai été clair.
Bonne Prog.
SupraDolph
- Messages postés
- 316
- Date d'inscription
- jeudi 9 janvier 2003
- Statut
- Membre
- Dernière intervention
- 1 février 2010
1All => Vous ne sauriez pas comment je pourai faire pour recuperer la ligne courante dans une rtb par hasard ?
- Messages postés
- 17286
- Date d'inscription
- mercredi 2 janvier 2002
- Statut
- Modérateur
- Dernière intervention
- 23 décembre 2019
61ListMot = Array("And", "As", "Boolean", "ByRef", "Byte", "ByVal", "Call", "Case" _
, "Case Is", "Close", "Const", "Currency", "Date", "Declare", "Dim", "Do" _
, "DoEvents", "Double", "Else", "ElseIf", "End", "Enum", "Error", "Events" _
, "Exit", "Exit For", "False", "For", "Function", "GoTo", "If", "Input" _
, "Integer", "Line", "Long", "Loop", "New", "Next", "Not", "Object", "On" _
, "Open", "Option Explicit", "Or", "Output", "Print", "Private", "Public" _
, "Resume", "Select", "Set", "Single", "Step", "String", "Sub", "Then", "To" _
, "True", "Type", "Variant", "Wend", "While", "With")
For Each Word In Words
a = RichTextBox1.Find(Word, 0)
While (a <> -1)
RichTextBox1.SelStart = a
RichTextBox1.SelLength = Len(Word)
RichTextBox1.SelColor = RGB(255, 0, 0)
a = RichTextBox1.Find(Word, a + Len(Word))
Wend
Next Word
- Messages postés
- 196
- Date d'inscription
- samedi 12 janvier 2002
- Statut
- Membre
- Dernière intervention
- 1 septembre 2008
1pour avoir la source correcte faites moi signe
A++
A++
Private Sub ColorisationVB(R1 As RichTextBox, RGBCouleurComentaire As RVB, RGBCouleurFonction As RVB, RGBCouleurTexte As RVB)
On Error Resume Next
Text = R1.Text 'On utilise une variable pour la rapiditée
Text = Replace(Text, "", "") 'On Modifie tous les caractères spéciaux
Text = Replace(Text, "{", "{") 'à la richtextbox
Text = Replace(Text, "}", "}")
Text = " " & Text & " "
'<><><><><><><>
'<> Fonction <>
'<><><><><><><>
'-TABLEAU
'-Liste des mots a mettre en Fonction :
ListMot = Array("And", "As", "Boolean", "ByRef", "Byte", "ByVal", "Call", "Case" _
, "Case Is", "Close", "Const", "Currency", "Date", "Declare", "Dim", "Do" _
, "DoEvents", "Double", "Else", "ElseIf", "End", "Enum", "Error", "Events" _
, "Exit", "Exit For", "False", "For", "Function", "GoTo", "If", "Input" _
, "Integer", "Line", "Long", "Loop", "New", "Next", "Not", "Object", "On" _
, "Open", "Option Explicit", "Or", "Output", "Print", "Private", "Public" _
, "Resume", "Select", "Set", "Single", "Step", "String", "Sub", "Then", "To" _
, "True", "Type", "Variant", "Wend", "While", "With")
'-Déclarations
Dim Tableau() As String '-Tableau principal
Dim LecTmp As String
Dim PosNull As Long
Dim Z As Long
'-Vérification présence du VbCrlf à la fin de la chaine pour la séparation dans le tableau
If Right(R1.Text, 1) <> vbCrLf Then R1.Text = R1.Text & vbCrLf
'-Découpage de la chaine dans un "Tableau"
Tableau() = Split(R1.Text, vbCrLf)
'-Boucle de lecture des lignes du tableau
For Z = 0 To UBound(Tableau)
'-Vérification présence d'un espace à la fin de la chaine pour le tableau
If Right(Tableau(Z), 1) <> " " Then Tableau(Z) = Tableau(Z) & " "
Do
'-RAZ var
LecTmp = ""
'-Recherche position "Espace"
PosNull = InStr(Tableau(Z), " ")
'-Extraction du mot à comparer
LecTmp = Left$(Tableau(Z), PosNull - 1)
'-Réduction de la chaîne en enlevant le mot à comparer
Tableau(Z) = Mid(Tableau(Z), PosNull + 1)
'-Boucle de lecture de comparaison des mots clefs
For i = 0 To UBound(ListMot)
'-Comparaison
Pos = InStr(1, LecTmp, ListMot(i), vbTextCompare)
'-Sortie boucle si présence mot trouvé
If Pos Then Exit For
Next i
'-Mot trouvé
If Pos = 1 And LecTmp <> "" Then
Tmp = Tmp & "cf2" & LecTmp & "cf3 "
Else '-Mot non trouvé
Tmp = Tmp & LecTmp & " "
End If
'-Remettre les mots colorisé dans la ligne du tableau
If PosNull 0 Then Tableau(Z) Tmp: Tmp = ""
Loop Until PosNull = 0
Next Z
'-Joindre le tableau
Text = Join(Tableau, vbCrLf)
Text = Replace(Text, vbCr, "par ")
Text = Left(Text, Len(Text) - 1)
Texttmp = "{
tf1ansiansicpg1252deff0{fonttbl{f0fnilfcharset0 Courier New;}}" 'Police utilisée
'-cf1 vert
'-cf2 bleu clair
'-cf3 noir
'-cf4 rouge
'-cf5 bleu foncé
'-cf6 orange
Texttmp = Texttmp & vbCrLf & "{colortbl ;
ed0green130lue0;
ed0green0lue255;
ed0green0lue0;
ed255green0lue0;
ed0green0lue132;
ed255green128lue0;}" 'Couleurs utilisées
Texttmp = Texttmp & vbCrLf & "viewkind4uc1pardlang1036f0fs20 " 'Language
Texttmp = Texttmp & Text 'On met le text
Texttmp = Texttmp & "cf0fs24" & vbCrLf & "par }" 'On indique que c'est la fin
R1.TextRTF = Texttmp
End Sub
- Messages postés
- 196
- Date d'inscription
- samedi 12 janvier 2002
- Statut
- Membre
- Dernière intervention
- 1 septembre 2008
1très beau travail ,ou à tu trouver la doc pour la colorisation du Richtexbox
bonne continuation
A++
- Messages postés
- 60
- Date d'inscription
- dimanche 20 octobre 2002
- Statut
- Membre
- Dernière intervention
- 5 septembre 2004
1R1.Text = "Private Sub Command1_Click()"
il met le sub en bleu, alors qu'il se trouve entre "", faudrait arranger cela autrement c ok.
Bye... DHKold
- Messages postés
- 196
- Date d'inscription
- samedi 12 janvier 2002
- Statut
- Membre
- Dernière intervention
- 1 septembre 2008
1