Bonjour

j'ai une version d'un programme écrit en Pascal, sur lequel je dois effectuer une "revue de code".
Je sollicite votre aide pour une analyse de code, une recherche d'erreurs sur le code, les erreurs de syntaxe, du code mort , des méthodes et fonctions incohérentes ou inutiles...

Merci
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
unit Main;
{
UNITE = PACKAGE comprenant une seule CLASSE TrMain dérivant de TForm
}
//=============================================================================
interface
 
// Utilisation d'autres UNITES : PACKAGE (dans les interfaces)---------------
// L'interface contient des Classes et Types définies dans les packages
// listés dans la clause USES.
// Association
uses
  SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, StrUtils, LResources;
 
// Déclaration des classes et Types -----------------------------------------
type
  TXOPosArray = array [1..3, 1..3] of Integer;
 
type
 
  { TfrMain }
 
  TfrMain = class(TForm)
    lblCell0: TLabel;
    lblCell1: TLabel;
    lblCell2: TLabel;
    lblCell3: TLabel;
    lblCell4: TLabel;
    lblCell5: TLabel;
    lblCell6: TLabel;
    lblCell7: TLabel;
    lblCell8: TLabel;
    gbScoreBoard: TGroupBox;
    rgPlayFirst: TRadioGroup;
    lblX: TLabel;
    lblMinus: TLabel;
    Label1: TLabel;
    lblXScore: TLabel;
    lblColon: TLabel;
    lblOScore: TLabel;
    btnNewGame: TButton;
    btnResetScore: TButton;
    procedure FormCreate(Sender: TObject);
    procedure lblCell0Click(Sender: TObject);
    procedure btnNewGameClick(Sender: TObject);
    procedure btnResetScoreClick(Sender: TObject);
  private
 
    procedure Switchplayer;
    procedure WinMessage;
  public
    procedure InitPlayGround;
    function CheckWin(iPos : TXOPosArray) : integer;
    function Autoplay(Cell : integer):integer;
    function GamePlay(xo_Move : Integer) : integer;
  end;
//=============================================================================
 
var
  frMain: TfrMain;
 
  iXPos : TXOPosArray;
  iOPos : TXOPosArray;
  sPlaySign : String;
  bGameOver,bwin : Boolean;
  iMove : Integer;       // nombre de case cochée
  iXScore : Integer;
  iOScore : Integer;
  CellIndexPlay : Integer;
//=============================================================================
implementation
//--------------------------------------------------------------------------
procedure TfrMain.InitPlayGround;
// le plateau est composé de 9 Composants TLabel nommée de 0 à 8 : LblCell0 à LblCell8
// Cette fonction initialise donc le "Caption" à blanc, c'est à dire vide le plateau
// Repèrage entre les composants Tlabel et la matrice fictive 3 X 3 (cf clacul de k)
var
 i, j, k: integer;
begin
  for i := 1 to 3 do
  begin
    for j := 1 To 3 do
    begin
      k:= (i - 1) * 3 + j - 1; // 0 .. 8
      TLabel(FindComponent('lblCell' + IntToStr(k))).Caption := '';
      iXPos[i, j] := 0;
      iOPos[i][j] := 0;
    end;
  end;
 
 if rgPlayFirst.ItemIndex = 0 then sPlaySign := 'X';
 if rgPlayFirst.ItemIndex = 1 then sPlaySign := 'O';
 bGameOver := False;
 iMove := 0;
end;
//--------------------------------------------------------------------------
// à la création de la forme, initialisation du plateau
procedure TfrMain.FormCreate(Sender: TObject);
begin
 iXScore := 0;
 iOScore := 0;
 InitPlayGround;
end;
//--------------------------------------------------------------------------
// Vérifie si des croix ou des ronds sont allignés
function TfrMain.CheckWin(iPos : TXOPosArray) : Integer;
var
 iScore : Integer;
 i : Integer;
 j : Integer;
begin
 Result := -1;
 //lignes
 iScore := 0;
 for i := 1 to 3 do
 begin
  iScore := 0;
  Inc(Result);
  for j := 1 To 3 do Inc(iScore, iPos[i,j]);
  if iScore = 3 Then Exit
 end;//for i
 
 // diagonale gauche?
 iScore := 0;
 Inc(Result);
 for i := 1 to 3 do Inc(iScore, iPos[i,i]);
 if iScore = 3 then Exit;
 
 // diagonale droite?
 iScore := 0;
 Inc(Result);
 for i := 1 to 3 do Inc(iScore, iPos[i,4-i]);
 if iScore = 3 then Exit;
 
 //colonnes
 for i := 1 to 3 do
 begin
  iScore := 0;
  Inc(Result);
  for j := 1 to 3 do Inc(iScore, iPos[j,i]);
  if iScore = 3 then Exit;
 end;//for i
 
 Result := -1;
end;
//--------------------------------------------------------------------------
// affiche les messages à l'écran en cas de gain ou de partie terminée
procedure TfrMain.WinMessage;
begin
if bwin or bgameover then switchplayer();
 
        if bwin then ShowMessage(sPlaySign + ' - Gagné!');
        if bgameover then
        ShowMessage(sPlaySign + ' - C''est fini!');
end;
//--------------------------------------------------------------------------
// Fonction de vérification du gain et de positionnement des valeurs du
// tableau de la matrice de jeu
function TfrMain.GamePlay(xo_Move : Integer):integer;
var
 x, y : 1..3;
 iWin : integer;
begin
 Result := -1;
 
 Inc(iMove);
 x := (xo_Move Div 3) + 1;
 y := (xo_Move Mod 3) + 1;
 
 if sPlaySign = 'O' then
 begin
   iOPos[x,y] := 1;
   iWin := CheckWin(iOPos);
 end
 else
 begin
   iXPos[x,y] := 1;
   iWin := CheckWin(iXPos);
 end;
 
 TLabel(FindComponent('lblCell' + IntToStr(xo_Move))).Caption := sPlaySign;
 
 Result := iWin;
 bwin := false;
 
 if iWin >= 0 then
 begin
   bGameOver := True;
   //victoire
   bwin := true;
   if sPlaySign = 'X' then
   begin
    iXScore := iXScore + 1;
    lblXScore.Caption := IntToStr(iXScore);
   end
   else
   begin
    iOScore := iOScore + 1;
    lblOScore.Caption := IntToStr(iOScore);
   end;
 
  // ShowMessage(sPlaySign + ' - Gagné!');
 end;
 
 if (iMove = 9) AND (bGameOver = False) Then
 begin
  // ShowMessage('Fini');
  bGameOver := True
 end;
 
 
end;
//--------------------------------------------------------------------------
// Switch entre les joueurs
procedure  TfrMain.Switchplayer;
begin
  if sPlaySign = 'O' Then
   sPlaySign := 'X'
 else
   sPlaySign := 'O';
end  ;
//--------------------------------------------------------------------------
// Procédure associée au click sur une des cases
procedure TfrMain.lblCell0Click(Sender: TObject);
var
  iWin : integer;
  CellIndex : 0..8;
begin
 if bGameOver = True Then Exit;
 if TLabel(Sender).Caption <> '' then
 begin
  ShowMessage('Cellule occupée!');
  Exit;
 end;
 CellIndex := StrToInt(RightStr(TLabel(Sender).Name,1));
 iWin := GamePlay(CellIndex);
 Switchplayer() ;
 AutoPlay(CellIndex);
 WinMessage();
end;
//--------------------------------------------------------------------------
// Procédure associée au bouton Nouvelle partie
procedure TfrMain.btnNewGameClick(Sender: TObject);
begin
 if bGameOver = False then
 begin
  if MessageDlg('Fin du jeu', mtConfirmation, mbOKCancel,0) = mrCancel then Exit;
 end;
 InitPlayGround;
end;
//--------------------------------------------------------------------------
// Procédure associée au bouton reset des scores
procedure TfrMain.btnResetScoreClick(Sender: TObject);
begin
 if MessageDlg('Reset des scores?',mtConfirmation,mbOKCancel,0) = mrCancel then Exit;
     iXScore := 0;
     iOScore := 0;
     lblXScore.Caption := IntToStr(iXScore);
     lblOScore.Caption := IntToStr(iOScore);
end;
//--------------------------------------------------------------------------
// function de jeu automatique heuristique 1
function TfrMain.Autoplay(Cell : integer):integer ;
begin
result := Cell;
end;
//--------------------------------------------------------------------------
// Initialization du package (unité)
initialization
  {$i Main.lrs}
end.