et voila !!! c'est pas une methode lourde, et c'est instantané.... ;-)
SupraDolph
Messages postés196Date d'inscriptionsamedi 12 janvier 2002StatutMembreDernière intervention 1 septembre 20081 11 oct. 2003 à 11:47
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
capoueidiablo
Messages postés316Date d'inscriptionjeudi 9 janvier 2003StatutMembreDernière intervention 1 février 20101 10 oct. 2003 à 17:11
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 ?
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 26 févr. 2003 à 00:15
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
SupraDolph
Messages postés196Date d'inscriptionsamedi 12 janvier 2002StatutMembreDernière intervention 1 septembre 20081 10 janv. 2003 à 20:22
oui c pas trop mal je comptai le revoir totale ment pour le faire aussi dans un tableau. g un pote qui bosse dessus aussi .
cs_BFR
Messages postés88Date d'inscriptionmardi 30 juillet 2002StatutMembreDernière intervention 1 mars 2008 4 janv. 2003 à 00:17
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++
cs_BFR
Messages postés88Date d'inscriptionmardi 30 juillet 2002StatutMembreDernière intervention 1 mars 2008 4 janv. 2003 à 00:13
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
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
DHKold
Messages postés153Date d'inscriptionvendredi 6 décembre 2002StatutMembreDernière intervention29 mai 20052 3 janv. 2003 à 01:03
Ah oui maintenant c ok, bravo
SupraDolph
Messages postés196Date d'inscriptionsamedi 12 janvier 2002StatutMembreDernière intervention 1 septembre 20081 2 janv. 2003 à 15:32
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
cs_BFR
Messages postés88Date d'inscriptionmardi 30 juillet 2002StatutMembreDernière intervention 1 mars 2008 31 déc. 2002 à 14:35
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++
jpujol95
Messages postés60Date d'inscriptiondimanche 20 octobre 2002StatutMembreDernière intervention 5 septembre 20041 31 déc. 2002 à 11:36
ca sert a rien sans etre mechant...
DHKold
Messages postés153Date d'inscriptionvendredi 6 décembre 2002StatutMembreDernière intervention29 mai 20052 31 déc. 2002 à 02:22
Très bien $-) Juste un ptit truc:
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
SupraDolph
Messages postés196Date d'inscriptionsamedi 12 janvier 2002StatutMembreDernière intervention 1 septembre 20081 30 déc. 2002 à 20:37
je ne connai pas très bien le js si qqn ve le fair ...
Alan71
Messages postés530Date d'inscriptionlundi 3 juin 2002StatutMembreDernière intervention13 juin 2004 30 déc. 2002 à 20:32
nickel, maintenant, la meme chose en js (ca me lourde de le fer)
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