Signaler

COULEUR VB CHANGE LA COULEUR D'UN DOCUMENT POUR LUI DONNER UN STYLE VB

Messages postés
530
Date d'inscription
lundi 3 juin 2002
Statut
Membre
Dernière intervention
13 juin 2004
 - - Dernière réponse : Renfield
Messages postés
17280
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
21 juillet 2019
 - 13 oct. 2003 à 09:35
Commentaires sur une source Signaler
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

Signaler
Renfield
Messages postés
17280
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
21 juillet 2019
 58 -
la methode est en fait très très simple !!!!!


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é.... ;-)
Signaler
SupraDolph
Messages postés
196
Date d'inscription
samedi 12 janvier 2002
Statut
Membre
Dernière intervention
1 septembre 2008
 1 -
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
Signaler
capoueidiablo
Messages postés
316
Date d'inscription
jeudi 9 janvier 2003
Statut
Membre
Dernière intervention
1 février 2010
 1 -
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 ?
Signaler
Renfield
Messages postés
17280
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
21 juillet 2019
 58 -
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......)

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
Signaler
SupraDolph
Messages postés
196
Date d'inscription
samedi 12 janvier 2002
Statut
Membre
Dernière intervention
1 septembre 2008
 1 -
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 .
Signaler
cs_BFR
Messages postés
88
Date d'inscription
mardi 30 juillet 2002
Statut
Membre
Dernière intervention
1 mars 2008
 -
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++
Signaler
cs_BFR
Messages postés
88
Date d'inscription
mardi 30 juillet 2002
Statut
Membre
Dernière intervention
1 mars 2008
 -
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

'-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
Signaler
DHKold
Messages postés
153
Date d'inscription
vendredi 6 décembre 2002
Statut
Membre
Dernière intervention
29 mai 2005
 -
Ah oui maintenant c ok, bravo
Signaler
SupraDolph
Messages postés
196
Date d'inscription
samedi 12 janvier 2002
Statut
Membre
Dernière intervention
1 septembre 2008
 1 -
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
Signaler
cs_BFR
Messages postés
88
Date d'inscription
mardi 30 juillet 2002
Statut
Membre
Dernière intervention
1 mars 2008
 -
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++
Signaler
jpujol95
Messages postés
60
Date d'inscription
dimanche 20 octobre 2002
Statut
Membre
Dernière intervention
5 septembre 2004
 1 -
ca sert a rien sans etre mechant...
Signaler
DHKold
Messages postés
153
Date d'inscription
vendredi 6 décembre 2002
Statut
Membre
Dernière intervention
29 mai 2005
 -
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
Signaler
SupraDolph
Messages postés
196
Date d'inscription
samedi 12 janvier 2002
Statut
Membre
Dernière intervention
1 septembre 2008
 1 -
je ne connai pas très bien le js si qqn ve le fair ...
Signaler
Alan71
Messages postés
530
Date d'inscription
lundi 3 juin 2002
Statut
Membre
Dernière intervention
13 juin 2004
 -
nickel, maintenant, la meme chose en js (ca me lourde de le fer)