COULEUR VB

---

Commentaire sur cette source (4)
Ajouter un commentaire et/ou une note

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.

'----------------- 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

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

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

• CRAPETTE
• GAGNER AU LOTO
• AOL CONNECTEUR ( AOLDECO )
• CONTROLE WINAMP COMPLETEMENT

• WORKTRACKER
• ETEINDRE L'ORDINATEUR DE DIFFERENTES MANIÈRES
• TABLEAU PERIDOQUES
• BUDGET MENSUEL
• VOCAL CITATION