capoueidiablo : une methode asser lourde mais relativement simple a mettre en oeuvre est de faire une boucle qui a partir de la position de ton curseur (rtb.selpos ou qqc comme sa) teste caractère par caractère en reculant pour trouver un vbcrlf (ou ch(13) ) dès que tu le trouve ou si tu est au début du document tu mémorise la position. tu refait la meme chose en avançant (sauf que tu test si tu est a la fin du texte à la place du début).
fait attention car le vbcrlf prend 2 caractères (vbcr + vblf).
Jéspère que j'ai été clair.
Bonne Prog.
SupraDolph
Renfield => tu devrai mettre un espace avant et après chaque mot à rechercher car si tu ecris des mots contenant une partie de ceux rehercher cela changerons quand meme de couleurs.
All => Vous ne sauriez pas comment je pourai faire pour recuperer la ligne courante dans une rtb par hasard ?
petite mise a jour pour le changement de couleur de mots contenus dans un rtf ( ici , pas de detection des guillements ni des commentaires , attention , pour bien faire , il faudrait créer un parseur qui decoupe la chaine et applique le style , je vais en realiser un , mais pour le c , a suivre......)
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
attention je viens de m'apercevoir que certain caractère ne sont pas pris en compte dans la boite des commentaires
pour avoir la source correcte faites moi signe
A++
j'ai pris beaucoup de plaisir sur ce code source je propose une autre solution attention je n'ai travaillé que sur les mot fonction
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
'-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
En fait je n'ai trouver de doc pour la colorisation du Richtextbox j'ai enregistrer qq mots en differentes couleur et j'ai analyser c assez simple a comprendre toute les police, les couleurs,... st referencée au debut avec un code. aprés qq bugs g remarquer que la richtextbox utilisait aussi ANTISLASH et { }les acolades
c'est une autre méthode de colorisation que je ne connaissais pas.
très beau travail ,ou à tu trouver la doc pour la colorisation du Richtexbox
bonne continuation
A++
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é.... ;-)
fait attention car le vbcrlf prend 2 caractères (vbcr + vblf).
Jéspère que j'ai été clair.
Bonne Prog.
SupraDolph
All => Vous ne sauriez pas comment je pourai faire pour recuperer la ligne courante dans une rtb par hasard ?
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
pour 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
très beau travail ,ou à tu trouver la doc pour la colorisation du Richtexbox
bonne continuation
A++
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