Couleur vb

1/5 (4 avis)

Vue 8 147 fois - Téléchargée 322 fois

Description

Comme tu le sais, lorsque tu imprime ton code avec VB. Il ne met pas les couleurs. Alors que c'est très pratique et cela te permet de mieux te situer.
Le programme va mettre les couleurs comme VB. Tu pourra l'imprimer ou faire un copier coller vers Word. Il garde les couleurs c'est çà qui est intéressant.

Source / Exemple :


'----------------- Commentaire ----------------------------------------------------------------------------------------
' Créer : 21/05/2002
' Version 1.0   : Dernier modif le 07/04/2002

'Ajoute dans un formulaire
  - un richtextbox : rtbProgram
  - un boite texte : txtEtat
  - un progress bar : pgb
  - un commandbutton : cmdCouleur
'---------------------------------------------------------------------------------------------------------

Option Explicit

Const BLEU = 8650752
Const VERT = 33280
Const NOIR = 0

Dim ListMot

Private Sub Form_Load()
  ListMot = Array("And", "As", "Boolean", "ByRef", "Byte", "ByVal", "Call", "Case" _
    , "Case Is", "Close", "Const", "Declare", "Dim", "Do", "DoEvents", "Else" _
    , "ElseIf", "End", "Enum", "Error", "Events", "Exit", "Exit For", "False" _
    , "FileCopy", "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", "String", "Sub", "Then", "To", "True", "Type", "Wend", "While", "With")

  With rtbProgram.Font
    .Name = "Courier New"
    .Size = 8.5
    .Bold = False
    .Italic = False
  End With
  rtbProgram.Text = ""

End Sub

Private Sub cmdCouleur_Click()
Dim i As Long
Dim Debut As Long, DebutMot As Long
Dim posGuilD As Long, posGuilF As Long, nbGuil As Integer
Dim TextLine As String, LinePrec As String
  If rtbProgram.Text = "" Then Exit Sub
  txtEtat.Visible = True
  rtbProgram.Visible = False
  If Mid(rtbProgram.Text, 1, 2) <> vbCrLf Then rtbProgram.Text = vbCrLf & rtbProgram.Text
  'Permet d'avoir un progress bar fluide
  pgb.Min = 0
  pgb.Max = 100
  pgb.Visible = True
  pgb.Value = 0
  
  rtbProgram.SelStart = 0
  rtbProgram.SelLength = Len(rtbProgram.Text)
  With rtbProgram.Font
    .Name = "Courier New"
    .Size = 8.5
    .Bold = False
    .Italic = False
  End With
  'Recherche les mots en bleu
  DoEvents
  For i = 0 To UBound(ListMot)
    Debut = 1
    Do
      DebutMot = InStr(Debut, rtbProgram.Text, ListMot(i), vbBinaryCompare)
      If DebutMot <> 0 Then
        Debut = DebutMot + Len(ListMot(i))
        TextLine = Mid(rtbProgram.Text, DebutMot - 1, 1)
        If (Mid(rtbProgram.Text, DebutMot - 2, 2) = vbCrLf Or TextLine = " " Or TextLine = "(" Or TextLine = "(" Or TextLine = ")") Then
          TextLine = Mid(rtbProgram.Text, Debut, 1)
          If (Mid(rtbProgram.Text, Debut, 2) = vbCrLf Or TextLine = " " Or TextLine = "," Or TextLine = "(" Or TextLine = ")" Or TextLine = ":") Then
            rtbProgram.SelStart = DebutMot - 1
            rtbProgram.SelLength = Len(ListMot(i)) + 1
            rtbProgram.SelColor = BLEU
          End If
        End If
      End If
    Loop While DebutMot <> 0
    pgb.Value = (i + 1) * 75 / UBound(ListMot)
  Next i
  
  'Ce qui est compliqué là de dans c'est que j'utilise mais variable pour tout et n'importe quoi
  'Met en vert les commentaires
  Debut = 1
  Do
    'Verifie que le commentaire n'est pes entre Guillemet
    DebutMot = InStr(Debut, rtbProgram.Text, "'", vbTextCompare)
    If DebutMot <> 0 Then
      pgb.Value = 75 + (DebutMot * 25 / Len(rtbProgram.Text))
      'Enregistre la ligne qui contient le caractère "'" dans TextLine
      Debut = InStr(DebutMot, rtbProgram.Text, vbCrLf, vbTextCompare)
      posGuilD = InStrRev(rtbProgram.Text, vbCrLf, Debut)
      TextLine = Mid(rtbProgram.Text, posGuilD + 2, Debut - posGuilD - 2)
      'Recherche la position du guillemet suivant
      posGuilF = InStr(DebutMot - posGuilD, TextLine, Chr(34), vbTextCompare)
      'Compte le nombre de guillemet
      nbGuil = -1
      posGuilD = DebutMot - posGuilD
      Do
        nbGuil = nbGuil + 1
        posGuilD = InStrRev(TextLine, Chr(34), posGuilD) - 1
      Loop While posGuilD <> -1
      'S'il n'y a pas de guillemet devant ou s'il y en un nombre pair de guillemet
      'devant c'est bon, c'est un commentaire
      If posGuilF = 0 Or nbGuil Mod 2 = 0 Then
        rtbProgram.SelStart = DebutMot - 1
        rtbProgram.SelLength = Debut - DebutMot
        rtbProgram.SelColor = VERT
      End If
    End If
    Debut = DebutMot + 1
    DoEvents
  Loop While DebutMot <> 0

  pgb.Value = pgb.Max
  rtbProgram.SelStart = 0
  rtbProgram.SelLength = 0
  txtEtat.Visible = False
  rtbProgram.Visible = True
  rtbProgram.SetFocus
End Sub

Conclusion :


Pour avoir des explications ou pour avoir la dernière version envoyer moi un mail sur patdeterre@aol.com

Codes Sources

A voir également

Ajouter un commentaire Commentaires
cs_ghuysmans99 Messages postés 3983 Date d'inscription jeudi 14 juillet 2005 Statut Membre Dernière intervention 30 juin 2013 16
9 oct. 2005 à 14:01
Ca me sera utile ...

9,5/10
psy4meuh Messages postés 23 Date d'inscription jeudi 5 juin 2003 Statut Membre Dernière intervention 23 août 2006
1 juil. 2003 à 15:35
Nikel...
pour la vitesse, fo juste cacher le RTB quand tu le modifie...
8/10
grosiflex Messages postés 19 Date d'inscription jeudi 4 octobre 2001 Statut Membre Dernière intervention 21 octobre 2004
19 mars 2003 à 10:47
Trs bonne idée je trouve !!!!
cs_max12 Messages postés 1491 Date d'inscription dimanche 19 novembre 2000 Statut Modérateur Dernière intervention 7 juillet 2014
5 juil. 2002 à 18:27
C'est cool, mais faudrais que tu laisse tomber sellenght et tout sa, au lieux faudrais que tu trouve le moyen de générer ton texte au lieux de le modifier, sa serais BEAUCOUPS plus vite

A+

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.