Blog de Gilles Vasseur - Pascal et compagnie

Voici en guise de mise en bouche pour la seconde série d’articles consacrés à la POO avec Free Pascal et Lazarus, une unité appelée scores qui contient ce qui est nécessaire pour gérer un tableau de meilleurs scores : ajout, test avant ajout, remise à zéro, nombre maximum de scores à mémoriser, nombre de scores mémorisés, accès direct ou séquentiel aux scores, chargement et sauvegarde.

L’ensemble est automatisé : à partir du nombre maximum autorisé de scores et de ceux déjà enregistrés, il suffit d’envoyer à une instance de la classe principale un enregistrement contenant un nom et un score pour que l’ajout se fasse ou non. Un éventuel score devenu caduque est évidemment retiré de la liste.

Pour fonctionner, l’unité utilise des éléments classiques (propriétés indexées, propriété par défaut et gestionnaire d’événement, par exemple), mais aussi des nouveautés (enregistrements étendus, surcharge d’opérateurs, énumérateur, spécialisation d’une classe générique).

Code pascal :

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
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
{ |========================================================================|
  |                                                                       
  |                  Description : POO - classe pour les meilleurs scores
  |                  Unité : scores.pas    
  |                  Site : www.developpez.com 
  |                  Copyright : © Gilles VASSEUR 2016
  |                  Date:    12/09/2016 17:28:10  
  |                  Version : 1.0.0  |========================================================================| }
 
// HISTORIQUE
// 12/09/2016 17:28:10 - 1.0.0 - première version opérationnelle
 
// SCORES - part of "Aller plus loin avec Lazarus"
// Copyright © Gilles VASSEUR 2016
//
// This program is free software: you can redistribute it and/or modify it
// under the terms of the GNU General Public License as published by the
// Free Software Foundation, either version 3 of the License,
// or (at your option) any later version.
//
// This program is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY;
// without even the implied warranty of MERCHANTABILITY or
// FITNESS FOR A PARTICULAR PURPOSE.
// See the GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with this program.
// If not, see <http://www.gnu.org/licenses/>.
 
unit scores;
 
{$mode objfpc}{$H+}
{$modeswitch advancedrecords}
 
interface
 
uses
  Classes, SysUtils,
  fgl;
 
const
  CMaxScoresDefault = 8;
 
type
 
  { TScore }
 
  TScore = record
    Name: string;
    Score: Integer;
    class operator < (const Score1, Score2: TScore): Boolean;
    class operator = (const Score1, Score2: TScore): Boolean;
    class operator > (const Score1, Score2: TScore): Boolean;
    class operator >= (const Score1, Score2: TScore): Boolean;
  end;
 
  TScoresList = specialize TFPGList<TScore>;
 
  { TBestScores }
 
  TBestScores = class;
 
  { TBestScoresEnumerator }
 
  TBestScoresEnumerator = class
  private
    fScores: TBestScores;
    fCurrent: TScore;
    fN: Integer;
  public
    constructor Create(AScores: TBestScores);
    function MoveNext: Boolean;
    property Current: TScore read fCurrent;
  end;
 
  TBestScores = class
  strict private
    fMaxScores: Cardinal;
    fOnChange: TNotifyEvent;
    fScores: TScoresList;
    function GetScore(N: Cardinal): TScore;
    procedure SetMaxScores(AValue: Cardinal);
  protected
    procedure Change; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function Count: Integer;
    function GetEnumerator: TBestScoresEnumerator;
    procedure SaveToFile(const FileName: string);
    procedure LoadFromFile(const FileName: string);
    function IsBestScore(const AScore: TScore): Boolean;
    procedure TryToAddToBestScores(AScore: TScore; var IsBest: Boolean);
    property MaxScores: Cardinal read fMaxScores write SetMaxScores default CMaxScoresDefault;
    property Scores[N: Cardinal]: TScore read GetScore; default;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  end;
 
  function CompareScores(const AScore1, AScore2: TScore): Integer;
 
implementation
 
function CompareScores(const AScore1, AScore2: TScore): Integer;
// *** comparaison de deux scores : ordre inversé ! ***
begin
  Result := 0;
  if AScore1 < AScore2 then
    Result := 1
  else
  if AScore1 > AScore2 then
    Result := -1;
end;
 
{ TBestScoresEnumerator }
 
constructor TBestScoresEnumerator.Create(AScores: TBestScores);
// *** création de l'énumérateur de scores ***
begin
  inherited Create;
  fScores := AScores;
  fN := -1;
end;
 
function TBestScoresEnumerator.MoveNext: Boolean;
// *** score suivant possible ? ***
begin
  Inc(fN);
  Result := (fN < (fScores.Count));
  if Result then
    fCurrent := fScores[fN];
end;
 
{ TBestScores }
 
procedure TBestScores.SetMaxScores(AValue: Cardinal);
// *** nombre de scores au maximum ***
begin
  if fMaxScores = AValue then
    Exit;
  while (fScores.Count > AValue) do
      fScores.Delete(fScores.Count - 1);
  fMaxScores := AValue;
  Change;
end;
 
procedure TBestScores.Change;
// *** notification d'un changement ***
begin
  if Assigned(fOnChange) then
    fOnChange(Self);
end;
 
function TBestScores.GetScore(N: Cardinal): TScore;
// *** accès aux scores ***
begin
  Result := fScores[N];
end;
 
constructor TBestScores.Create;
// *** constructeur ***
begin
  fScores := TScoresList.Create;
  fMaxScores := CMaxScoresDefault;
end;
 
destructor TBestScores.Destroy;
// *** destruction ***
begin
  fScores.Free;
  inherited Destroy;
end;
 
procedure TBestScores.Clear;
// *** remise à zéro des scores ***
begin
  fScores.Clear;
  Change;
end;
 
function TBestScores.Count: Integer;
// *** nombre de scores ***
begin
  Result := fScores.Count;
end;
 
function TBestScores.GetEnumerator: TBestScoresEnumerator;
// *** acquisition d'un énumérateur ***
begin
  Result := TBestScoresEnumerator.Create(Self);
end;
 
procedure TBestScores.SaveToFile(const FileName: string);
// *** sauvegarde des scores ***
var
  LStList: TStringList;
  LScore: TScore;
begin
  LStList := TStringList.Create;
  try
    for LScore in fScores do
    begin
      LStList.Add(Trim(LScore.Name));
      LStList.Add(IntToStr(LScore.Score));
    end;
    LStList.SaveToFile(FileName);
  finally
    LStList.Free;
  end;
end;
 
procedure TBestScores.LoadFromFile(const FileName: string);
// *** chargement d'un fichier de scores ***
var
  LStList: TStringList;
  LScore: TScore;
  Li: Integer;
  LDummy: Boolean;
begin
  LStList := TStringList.Create;
  LDummy := False;
  try
    LStList.LoadFromFile(FileName);
    if not Odd(LStList.Count) then
      for Li := 0 to LStList.Count - 1 do
        if not Odd(Li) then
        begin
          LScore.Name := LStList[Li];
          if not TryStrToInt(LStList[Li + 1], LScore.Score) then
            Break;
          TryToAddToBestScores(LScore, LDummy);
        end;
  finally
    LStList.Free;
  end;
end;
 
function TBestScores.IsBestScore(const AScore: TScore): Boolean;
// *** est-ce un score enregistrable ? ***
var
  LScore: TScore;
begin
  Result := (fScores.Count = 0) or (fScores.Count < fMaxScores);
  if not Result then
    for LScore in fScores do
    begin
      if AScore >= LScore then
      begin
        Result := True;
        Exit;
      end;
    end;
end;
 
procedure TBestScores.TryToAddToBestScores(AScore: TScore; var IsBest: Boolean);
// *** essai d'enregistrer un score ***
begin
  IsBest := IsBestScore(AScore);
  if IsBest then
  begin
    fScores.Add(AScore);
    fScores.Sort(@CompareScores);
    if (fScores.Count > fMaxScores) then
      fScores.Delete(fMaxScores);
    Change;
  end;
end;
 
{ TScore }
 
class operator TScore.<(const Score1, Score2: TScore): Boolean;
// *** opérateur < ***
begin
  Result := (Score1.Score < Score2.Score);
end;
 
class operator TScore.=(const Score1, Score2: TScore): Boolean;
// *** opérateur = ***
begin
  Result := (Score1.Score = Score2.Score);
end;
 
class operator TScore.>(const Score1, Score2: TScore): Boolean;
// *** opérateur > ***
begin
  Result := (Score1.Score > Score2.Score);
end;
 
class operator TScore.>=(const Score1, Score2: TScore): Boolean;
// *** opérateur >= ***
begin
  Result := (Score1.Score >= Score2.Score);
end;
 
end.

Amusez-vous bien