Couleur vb

Télécharger le projet
Commenter

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
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (patdeterre)