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