1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
| Option Explicit
' Module pour tracer les appels récursifs
' User - 20/03/2019
' Type énumératif pour le type de sortie
Public Enum TypeSortie
Fenetre_Execution = 1
Fichier_texte = 2
End Enum
' Chaîne de caractères contenant le résultat en sortie
Dim stSortie As String
' Indice de colonne
Dim idColonne As Long
Dim flag As Boolean
' Type de sortie
Dim tpSortie As TypeSortie
Dim nbAppels As Long ' Nombre total d'appels du traçage, si 0 alors on va à la fin de la procédure
Dim idAppel As Long ' Indice d'appel
' Largeur des colonnes en sortie
Dim lgColonne As Long
Public Function InitDebug(Optional nbCalls As Long = 0, Optional lgColumn As Long = 15, Optional tpOut As TypeSortie = 1)
' Initialisation des paramètres de traçage ; nbCalls : nombre d'appels ; lgColumn : largeur des colonnes du tableau;
' tpOut : Type de sortie (fenêtre d'exécution, fichier texte)
idColonne = 0 ' Indice de colonne
idAppel = 0 ' On inilialise le compteur d'appels
lgColonne = lgColumn ' Largeur des colonnes en nombre de caractères
tpSortie = tpOut ' Type de sortie (fenêtre d'exécution ou fichier texte)
stSortie = vbNullString ' Chaîne contenant le résultat en sortie
nbAppels = nbCalls ' On initialise le nombre d'appels maxi
flag = True ' le flag permet de marquer le début et la fin du traçage
End Function
Public Sub BeginSub()
' Marqueur du début dans le code de la procédure
idAppel = idAppel + 1 ' On incrémente le compteur d'appels
' On affiche en sortie un appel de procédure
If idAppel = 1 Then ' Si 1er appel
stSortie = String(idColonne * lgColonne, " ") & "Apple n°" & idAppel & "->" ' On imprime Appel n°1
Else ' sinon on imprime Appel n°_ avec un décallage de idColonne
stSortie = stSortie & vbNewLine & String(idColonne * lgColonne, " ") & "Apple n°" & idAppel & "->"
End If
idColonne = idColonne + 1 ' On incrémente l'indice de colonne
End Sub
Public Sub EndSub()
' Marqueur de fin dans le code de la procédure
idColonne = idColonne - 1 ' On remonte les appels
If flag Then
If (idColonne = 0) Then ' si traçage complet terminé
flag = False ' indicateur de fin de traçage
StopDebug ' procédure d'arrêt du traçage
Else
If ((idAppel >= nbAppels) And (nbAppels > 0)) Then ' si nombre d'appels demandés dépassé
flag = False ' indicateur de fin de traçage
StopDebug ' procédure d'arrêt du traçage
End If
End If
End If
End Sub
Sub PrintDebug(s As String)
'Ajoute dans la chaîne de sortie le contenu du texte à afficher sur la bonne colonne
stSortie = stSortie & vbNewLine & String(idColonne * lgColonne, " ") & s ' La fonction String permet de décaller le texte
End Sub
Public Function Factorielle(n As Long) As Long
On Error GoTo erreur_Factorielle
BeginSub ' Marqueur de début de procédure
' On imprime du texte sur le traçage
PrintDebug "(n=" & n & ")"
If n = 0 Then
Factorielle = 1
Else
Factorielle = n * Factorielle(n - 1)
End If
' On imprime du texte sur le traçage
PrintDebug "(Fact(" & n & ")=" & CStr(Factorielle) & ")"
EndSub ' Marqueur de fin de procédure
erreur_Factorielle:
If Err.Number <> 0 Then
StopDebug ' Gestion de l'erreur : arrêt du traçage
On Error GoTo 0 ' Annule la gestion d'erreur
Resume ' Retourne sur la ligne qui a déclenché l'erreur
End If
End Function
Function Fibonacci(n As Long) As Long
' Code de la fonction Fibonacci avec les différentes balises
On Error GoTo erreur_Fibonacci
BeginSub
' On imprime du texte sur le traçage
PrintDebug "(n=" & n & ")"
If (n = 0) Then
Fibonacci = 0
Else
If (n = 1) Then
Fibonacci = 1
Else
Fibonacci = Fibonacci(n - 2) + Fibonacci(n - 1)
End If
End If
' On imprime du texte sur le traçage
PrintDebug "(Fibo(" & n & ")=" & Fibonacci & ")"
EndSub ' Marquage de fin de la procédure
erreur_Fibonacci:
If Err.Number <> 0 Then
StopDebug ' Gestion de l'erreur : arrêt du traçage
On Error GoTo 0 ' Annule la gestion d'erreur
Resume ' Retourne sur la ligne qui a déclenché l'erreur
End If
End Function
Function Combinaisons(x As Long, y As Long) As Long
' Code de la fonction Combinaisons avec les différentes balises
On Error GoTo erreur_Combinaisons
BeginSub
' On imprime du texte sur le traçage
PrintDebug "(" & x & "," & y & ")"
If (x = y) Or (y = 0) Then
Combinaisons = 1
Else
If (y = 1) Then
Combinaisons = x
Else
Combinaisons = Combinaisons(x - 1, y - 1) + Combinaisons(x - 1, y)
End If
End If
' On imprime du texte sur le traçage
PrintDebug "(Combin(" & x & "," & y & ")=" & Combinaisons & ")"
EndSub
erreur_Combinaisons:
If Err.Number <> 0 Then
StopDebug ' Gestion de l'erreur : arrêt du traçage
On Error GoTo 0 ' Annule la gestion d'erreur
Resume ' Retourne sur la ligne qui a déclenché l'erreur
End If
End Function
Public Function TestFactorielle(n As Long)
' Exemple de test pour la fonction Factorielle
InitDebug ' Initialisation des paramètres par défaut
Call Factorielle(n) ' Exécution de la fonction
End Function
Public Function TestFibonacci(n As Long)
' Exemple de test pour la fonction de Fibonacci
InitDebug , 20, Fichier_texte ' Initialisation des paramètres
Call Fibonacci(n) ' Exécution de la fonction
End Function
Public Function TestCombinaisons(x As Long, y As Long)
' Exemple de test pour la fonction Combinaisons
InitDebug , , Fichier_texte ' Initialisation des paramètres par défaut
Call Combinaisons(x, y) ' Exécution de la fonction
End Function
Public Sub CreateTextFile(chemin, s As String)
' Procédure de création du fichier texte
Open chemin For Output As #1
Print #1, s
Close #1
End Sub
Public Sub StopDebug()
' Procédure d'arrêt du traçage
Dim chemin As String
If (tpSortie = Fenetre_Execution) Then ' Si la sortie se fait dans la fenête d'exécution
Debug.Print stSortie
Else
If (tpSortie = Fichier_texte) Then
chemin = CurDir & "\Sortie.txt"
CreateTextFile chemin, stSortie ' Création du fichier Texte
Call Shell("notepad.exe """ & chemin & """", vbNormalFocus) ' Ouverture du fichier avec notepad
End If
End If
if (nbAppels > 0) And Not (flag) Then ' Si un nombre appels limité a été demandé ou si on est pas sorti sur une erreur
End ' stop la procédure principale et initialise les variables
End If
End Sub |
Consulter le profil
Marquer ce blog comme lu
