Identation d'un code source vb

Description

Comme l'indique le titre, ce petit programme réalise une identation d'un code source vb,
c'est-à-dire pour ceux qui se poseraient la question, qu'il rajoute des espaces devant certaines lignes qui suivent les if, ou les boucles par exemple...

Ce programme gère :

les if - else - end if
les for - next
les do - loop
les while - wend
les select case - case - end select
les subs et end sub
...

En pratique, vous mettez votre code source dans la zone de texte, vous cliquez sur identer, et il idente le code...
Si le code était déjà indenté mais pas partout, il n'y a aucun problème de double indentation...

Voilà voilà...

Source / Exemple :


'copiez ça dans un fichier txt et renommer le en .frm
' c'est pour les objets

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form frmPrinc 
   Caption         =   "Identateur"
   ClientHeight    =   10170
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7680
   Icon            =   "frmPrinc.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   10170
   ScaleWidth      =   7680
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame framPrinc 
      Height          =   1455
      Left            =   0
      TabIndex        =   1
      Top             =   8640
      Width           =   7695
      Begin VB.TextBox txtChar 
         Height          =   285
         Left            =   3720
         TabIndex        =   6
         Top             =   960
         Width           =   3855
      End
      Begin VB.CommandButton cmdGo 
         Caption         =   "Indenter le code"
         Height          =   495
         Left            =   240
         TabIndex        =   5
         TabStop         =   0   'False
         Top             =   480
         Width           =   2175
      End
      Begin VB.OptionButton optTab 
         Caption         =   "Utiliser la tabulation comme caractère d'indentation"
         Height          =   255
         Left            =   2760
         TabIndex        =   4
         Top             =   240
         Value           =   -1  'True
         Width           =   4815
      End
      Begin VB.OptionButton optSpace 
         Caption         =   "Utiliser un espace comme caractère d'indentation"
         Height          =   255
         Left            =   2760
         TabIndex        =   3
         Top             =   600
         Width           =   4815
      End
      Begin VB.OptionButton optOther 
         Caption         =   "Autre :"
         Height          =   255
         Left            =   2760
         TabIndex        =   2
         Top             =   960
         Width           =   855
      End
   End
   Begin RichTextLib.RichTextBox rtfPrinc 
      Height          =   8655
      Left            =   0
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   0
      Width           =   7695
      _ExtentX        =   13573
      _ExtentY        =   15266
      _Version        =   393217
      ScrollBars      =   3
      AutoVerbMenu    =   -1  'True
      TextRTF         =   $"frmPrinc.frx":030A
   End
End
Attribute VB_Name = "frmPrinc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Sub cmdGo_Click()

    Dim buffer As String * 128
    Dim r As Integer
    Dim lng As String
    Dim nbreDeDents As Integer
    Dim char As String
    Dim longueur As Integer
    Dim temppath As String
    Dim dent As String
    
    r = GetTempPath(128, buffer)
    temppath = Left(buffer, r)

    rtfPrinc.Text = Replace(rtfPrinc.Text, Chr(9), "")

    Open temppath & "tempfile.tmp" For Output As #1
    Print #1, rtfPrinc.Text
    Close
    
    Open temppath & "tempfle2.tmp" For Output As #1
    Open temppath & "tempfile.tmp" For Input As #2
    
    nbreDeDents = 0
    
    If optTab.Value = True Then
        char = Chr(9)
        longueur = 1
    ElseIf optSpace.Value = True Then
        char = " "
        longueur = 1
    Else
        char = txtChar.Text
        longueur = Len(txtChar.Text)
    End If
    
    Do
        Line Input #2, lng
        lng = Trim(lng)
        If UCase(Left(lng, 3)) = "IF " And UCase(Right(lng, 5)) = " THEN" Then
            lng = dent & lng
            Print #1, lng
            nbreDeDents = nbreDeDents + 1
            dent = String(longueur * nbreDeDents, char)
        ElseIf UCase(Left(lng, 11)) = "SELECT CASE" Then
            lng = dent & lng
            Print #1, lng
            nbreDeDents = nbreDeDents + 2
            dent = String(longueur * nbreDeDents, char)
        ElseIf UCase(Left(lng, 11)) = "PRIVATE SUB" Or UCase(Left(lng, 16)) = "PRIVATE FUNCTION" Or UCase(Left(lng, 10)) = "PUBLIC SUB" Or UCase(Left(lng, 15)) = "PUBLIC FUNCTION" Then
            lng = dent & lng
            Print #1, lng
            nbreDeDents = nbreDeDents + 1
            dent = String(longueur * nbreDeDents, char)
        ElseIf UCase(Left(lng, 4)) = "SUB " Or UCase(Left(lng, 8)) = "FUNCTION " Then
            lng = dent & lng
            Print #1, lng
            nbreDeDents = nbreDeDents + 1
            dent = String(longueur * nbreDeDents, char)
        ElseIf UCase(Left(lng, 2)) = "DO" Or UCase(Left(lng, 6)) = "WHILE " Then
            lng = dent & lng
            Print #1, lng
            nbreDeDents = nbreDeDents + 1
            dent = String(longueur * nbreDeDents, char)
        ElseIf UCase(Left(lng, 4)) = "FOR " Then
            lng = dent & lng
            Print #1, lng
            nbreDeDents = nbreDeDents + 1
            dent = String(longueur * nbreDeDents, char)
        ElseIf UCase(Left(lng, 6)) = "END IF" Then
            nbreDeDents = nbreDeDents - 1
            dent = String(longueur * nbreDeDents, char)
            lng = dent & lng
            Print #1, lng
        ElseIf UCase(Left(lng, 10)) = "END SELECT" Then
            nbreDeDents = nbreDeDents - 2
            dent = String(longueur * nbreDeDents, char)
            lng = dent & lng
            Print #1, lng
        ElseIf UCase(Left(lng, 7)) = "END SUB" Or UCase(Left(lng, 12)) = "END FUNCTION" Then
            nbreDeDents = nbreDeDents - 1
            dent = String(longueur * nbreDeDents, char)
            lng = dent & lng
            Print #1, lng
        ElseIf UCase(Left(lng, 4)) = "LOOP" Or UCase(Left(lng, 4)) = "WEND" Then
            nbreDeDents = nbreDeDents - 1
            dent = String(longueur * nbreDeDents, char)
            lng = dent & lng
            Print #1, lng
        ElseIf UCase(Left(lng, 4)) = "NEXT" Then
            nbreDeDents = nbreDeDents - 1
            dent = String(longueur * nbreDeDents, char)
            lng = dent & lng
            Print #1, lng
        ElseIf UCase(Left(lng, 4)) = "ELSE" Or UCase(Left(lng, 6)) = "ELSEIF" Then
            lng = String(nbreDeDents - 1, Chr(9)) & lng
            Print #1, lng
        ElseIf UCase(Left(lng, 4)) = "CASE" Then
            lng = String(nbreDeDents - 1, Chr(9)) & lng
            Print #1, lng
        Else
            lng = dent & lng
            Print #1, lng
        End If
    Loop While Not EOF(2)
    Close

    rtfPrinc.LoadFile temppath & "tempfle2.tmp"
    
    Kill temppath & "tempfle2.tmp"
    Kill temppath & "tempfile.tmp"
    

End Sub

Private Sub Form_Resize()

    If Me.Height < 3000 Then
        Me.Height = 3000
    End If

    If Me.Width < 3000 Then
        Me.Width = 3000
    End If
    
    rtfPrinc.Width = Me.Width - 50
    rtfPrinc.Height = Me.Height - 1750
    
    framPrinc.Top = rtfPrinc.Height
    framPrinc.Height = 1300
    framPrinc.Width = Me.Width - 150
    
End Sub

'J'utilise cette fonction parce que j'ai mon CD de VB6 qui ne marche plus et je roule donc avec
'vb5, mais dans vb5, la fonction replace n'existe pas, donc voilà, mais si vous avez
'vb6 il faut supprimer cette partie...
'pour info c'est une fonction écrite par blq : http://www.vbfrance.com/article.asp?Val=313

Private Function Replace(ByVal laChaine As String, ByVal old_car As String, ByVal new_car As String) As String
        
        Dim ncar As Integer, lng As Integer, result As String, txt As String
        
        
        lng = Len(old_car)
        txt = laChaine
        
        If lng <= 0 Then
                Replace = txt
                
                Exit Function
        End If
        
        On Error GoTo ErrChangeCaractre
        
        If lng <= 0 Or Len(Trim(txt)) <= 0 Then
                Replace = txt
                
                Exit Function
        End If
        
        result = vbNullString
        ncar = InStr(txt, old_car)
        
        Do While ncar
                If Len(result) > 0 Then
                        If lng > 1 Then
                                If ncar = 1 Then
                                        result = result & new_car
                                Else
                                        result = result & Left(txt, ncar - 1) & new_car
                                End If
                        Else
                                result = result & Left(txt, ncar - 1) & new_car
                        End If
                Else
                        result = Left(txt, ncar - 1) & new_car
                End If
                
                If lng > 1 Then
                        txt = Right(txt, Len(txt) - ncar - (lng - 1))
                Else
                        txt = Right(txt, Len(txt) - ncar)
                End If
                
                ncar = InStr(txt, old_car)
        Loop
        
        If Len(txt) > 0 Then result = result & txt
        
        Replace = result
        
        Exit Function
        
ErrChangeCaractre:
        Replace = result
End Function

Conclusion :


Comme ça vous aurez plus d'excuse pour pas publier vos sources en disant, "Ouais mais elles sont trop pourries, pas identées et tout..."

Ah oui, un dernier truc, comme j'ai plus vb6, je me sers de vb5 et j'ai mis une fonction replace faite maison, si vous avez vb6 faut la virer...

Et commentez SVP...

Codes Sources

A voir également

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.