Couleur vb

Soyez le premier à donner votre avis sur cette source.

Vue 7 503 fois - Téléchargée 307 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

Messages postés
3983
Date d'inscription
jeudi 14 juillet 2005
Statut
Membre
Dernière intervention
30 juin 2013
12
Ca me sera utile ...

9,5/10
Messages postés
23
Date d'inscription
jeudi 5 juin 2003
Statut
Membre
Dernière intervention
23 août 2006

Nikel...
pour la vitesse, fo juste cacher le RTB quand tu le modifie...
8/10
Messages postés
19
Date d'inscription
jeudi 4 octobre 2001
Statut
Membre
Dernière intervention
21 octobre 2004

Trs bonne idée je trouve !!!!
Messages postés
1491
Date d'inscription
dimanche 19 novembre 2000
Statut
Modérateur
Dernière intervention
7 juillet 2014

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.