COULEUR VB CHANGE LA COULEUR D'UN DOCUMENT POUR LUI DONNER UN STYLE VB
Alan71
Messages postés
530
Date d'inscription
lundi 3 juin 2002
Statut
Membre
Dernière intervention
13 juin 2004
-
30 déc. 2002 à 20:32
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 - 13 oct. 2003 à 09:35
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 - 13 oct. 2003 à 09:35
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
13 oct. 2003 à 09:35
Const 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é.... ;-)
11 oct. 2003 à 11:47
fait attention car le vbcrlf prend 2 caractères (vbcr + vblf).
Jéspère que j'ai été clair.
Bonne Prog.
SupraDolph
10 oct. 2003 à 17:11
All => Vous ne sauriez pas comment je pourai faire pour recuperer la ligne courante dans une rtb par hasard ?
26 févr. 2003 à 00:15
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")
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
10 janv. 2003 à 20:22
4 janv. 2003 à 00:17
pour avoir la source correcte faites moi signe
A++
4 janv. 2003 à 00:13
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
3 janv. 2003 à 01:03
2 janv. 2003 à 15:32
31 déc. 2002 à 14:35
très beau travail ,ou à tu trouver la doc pour la colorisation du Richtexbox
bonne continuation
A++
31 déc. 2002 à 11:36
31 déc. 2002 à 02:22
R1.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
30 déc. 2002 à 20:37
30 déc. 2002 à 20:32