combinaisons dans un tlist

**Sylvain255** · 06/12/2023, 00h05

Bonjour j'ai un TList<tcarte> mon record tcarte n'est pas intéressant ici et je voudrais une fonction getCombinaisons (liste:tlist<tcarte>; n :integer):tlist<tlist<tcarte>> qui me retourne toutes les combinaisons de n tcarte dans ma liste SVP
N'étant pas très doué en maths et en algorithmie je m'en remets à vous.
Merci
Bien cordialement

**SergioMaster** · 06/12/2023, 07h57

Bonjour,

Qui dit cartes (certainement de Tarot) dit plutôt tirage (aléatoire de surcroit) que combinaison, non ?

Une discussion avait été ouverte plus ou moins sur un sujet identique s'il s'agit d'un tirage par patdu26 voir ici
et j'en ai fait ensuite, dans la même veine, un jeu de loto d'abord familial pour dériver ensuite en ajoutant le bingo et la loterie nationale, les sources sont ici

**Sylvain255** · 06/12/2023, 12h50

non c'est pas pöur le tirage c'est pour le calcul du chien du CPU je veux toutes les combinaisons de chien possibles

**ShaiLeTroll** · 06/12/2023, 14h51

Si ce sont toutes les combinaisons, il serait plus simple de l'exprimer sous la forme d'un alphabet, ensuite, c'est juste un calcul de base, par exemple 123456789VDR comme alphabet, c'est une base 12 et obtenir le n-iéme tirage, c'est convertir n de la base décimal à la base 12
Et ce n'est pas toutes les combinaisons dont tu as besoin même plutôt tous les "Arrangements sans Répétition" ou "Combinaison sans répétition"

Il y a plein de sujet sur cela
Pour toutes les combinaisons, l'alphabet cela peut être aussi un tableau d'objet, il n'y a pas réellement de différence de produire un tableau de char d'un tableau de pointeur dans ce cas là
Pour tous les Arrangements sans Répétition, cela se complique un peu et c'est a peu près pareil pour les "Combinaison sans répétition" où l'absence d'ordre simplifie la chose.

Voir
- Algorithme de combinaisons
- Comment trouver toutes les combinaisons possibles ?
- calculer des combinaisons et les afficher

j'ai cela qui traine mais c'est les combinaisons, cela ne doit pas fonctionner pour "Arrangements sans Repetition" ni pour "Combinaison sans répétition" puis que le CombinaisonSet n'est pas réduit au fur et à mesure.

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
function CalculCombinatoire(CombinaisonLength: Integer; CombinaisonSet: string): TStringDynArray;
var
  IndexResult: Integer;
  OffSet: Integer;
  Threshold, iStep: Integer;
  IndexCS, LenCS: Integer;
  PointerResult: TIntegerDynArray;
var
  I: Integer;
begin
  LenCS := Length(CombinaisonSet);
  SetLength(Result, Round(Power(LenCS, CombinaisonLength)));
  SetLength(PointerResult, Length(Result));
  for I := Low(Result) to High(Result) do
  begin
    SetLength(Result[I], CombinaisonLength);
    PointerResult[I] := Integer(PChar(Result[I])) - 1;
  end;
 
  Threshold := Length(Result);
  for OffSet := 1 to CombinaisonLength do
  begin
    Threshold := Threshold div LenCS;
    iStep := 0;
    IndexCS := 1;
    for IndexResult := Low(Result) to High(Result) do
    begin
      PChar(PointerResult[IndexResult]+OffSet)^ := CombinaisonSet[IndexCS];
 
      Inc(iStep);
      if iStep = Threshold then
      begin
        iStep := 0;
        Inc(IndexCS);
        if IndexCS > LenCS then
          IndexCS := 1;
      end;
    end;
  end;
end;

je vais tenter de la passer depuis un string/array of string vers TList<>

**ShaiLeTroll** · 06/12/2023, 15h24

Déjà une modélisation pour s'amuser un peu

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
type
  TCarteColor = (ccCoeur, ccCarreaux, ccTrefle, ccPiques);
  TCarteType = (ctAutre, ctNumber, ctFigure, ctAtout);
  TCarteFigure = (cfValet, cfCavalier, cfDame, cfRoi);
 
  TCarte = class(TObject)
  strict private
    FName: string;
    FCarteType: TCarteType;
  public
    constructor Create(const AName: string; const ACarteType: TCarteType);
    function Clone(): TCarte; virtual;
 
    property Name: string read FName;
    property CarteType: TCarteType read FCarteType;
  end;
 
  TCarteWithCouleur = class(TCarte)
  public
    const
      COLORS: array[TCarteColor] of string = ('Coeur', 'Carreaux', 'Trefle', 'Piques');
  strict private
    FNumber: string;
    FCarteColor: TCarteColor;
  public
    constructor Create(const ANumber: string; const ACarteColor: TCarteColor; const ACarteType: TCarteType = ctNumber);
    function Clone(): TCarte; override;
 
    property Number: string read FNumber;
    property CarteColor: TCarteColor read FCarteColor;
  end;
 
  TCarteWithFigure = class(TCarteWithCouleur)
  public
    const
      FIGURES: array[TCarteFigure] of string = ('Valet', 'Cavalier', 'Dame', 'Roi');
      VALET = 11;
      CAVALIER = 12;
      DAME = 13;
      ROI = 14;
  strict private
    FCarteFigure: TCarteFigure;
  public
    constructor Create(const ACarteFigure: TCarteFigure; const ACarteColor: TCarteColor);
    function Clone(): TCarte; override;
 
    property CarteFigure: TCarteFigure read FCarteFigure;
  end;
 
  TCartes = class(System.Generics.Collections.TObjectList<TCarte>)
  private
    function GetCarte(Index: Integer): TCarte;
  public
    constructor Create(AOwnsCartes: Boolean = True);
 
    function Clone(): TCartes;
    procedure ToStrings(AStrings: TStrings; DoClear: Boolean = True);
 
    property Cartes[Index: Integer]: TCarte read GetCarte; default;
  end;
 
  TDecks = class(System.Generics.Collections.TObjectList<TCartes>)
  public
    constructor Create(AOwnsCartes: Boolean = True);
 
    procedure ToStrings(AStrings: TStrings; DoClear: Boolean = True);
  end;
 
  TTarot = class(TObject)
  public
    const
      NUMBERS: array[1..10] of string = ('As', 'Deux', 'Trois', 'Quatre', 'Cinq', 'Six', 'Sept', 'Huit', 'Neuf', 'Dix');
  private
    FAvailableCartes: TCartes;
    FAvailableAtouts: TCartes;
    FAvailableCouleurs: array[TCarteColor] of TCartes;
 
    procedure FillAvailableCartes();
  private
    function GetAvailableCouleurs(Index: TCarteColor): TCartes;
  public
    constructor Create();
    destructor Destroy(); override;
 
    property AvailableCartes: TCartes read FAvailableCartes;
    property AvailableAtouts: TCartes read FAvailableAtouts;
    property AvailableCouleurs[Index: TCarteColor]: TCartes read GetAvailableCouleurs;
  end;

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
{ TCarte }
 
constructor TCarte.Create(const AName: string; const ACarteType: TCarteType);
begin
  inherited Create();
 
  FName := AName;
  FCarteType := ACarteType;
end;
 
function TCarte.Clone(): TCarte;
begin
  Result := TCarte.Create(FName, FCarteType);
end;
 
{ TCarteWithCouleur }
 
constructor TCarteWithCouleur.Create(const ANumber: string; const ACarteColor: TCarteColor; const ACarteType: TCarteType = ctNumber);
begin
  inherited Create(Format('%s de %s', [ANumber, COLORS[ACarteColor]]), ACarteType);
 
  FNumber := ANumber;
  FCarteColor := ACarteColor;
end;
 
function TCarteWithCouleur.Clone(): TCarte;
begin
  Result := TCarteWithCouleur.Create(FNumber, FCarteColor);
end;
 
{ TCarteWithFigure }
 
constructor TCarteWithFigure.Create(const ACarteFigure: TCarteFigure; const ACarteColor: TCarteColor);
begin
  inherited Create(FIGURES[ACarteFigure], ACarteColor, ctFigure);
 
  FCarteFigure := ACarteFigure;
end;
 
function TCarteWithFigure.Clone(): TCarte;
begin
  Result := TCarteWithFigure.Create(FCarteFigure, CarteColor);
end;
 
{ TCartes }
 
constructor TCartes.Create(AOwnsCartes: Boolean = True);
begin
  inherited Create(AOwnsCartes);
end;
 
function TCartes.GetCarte(Index: Integer): TCarte;
begin
  Result := Items[Index - 1];
end;
 
procedure TCartes.ToStrings(AStrings: TStrings; DoClear: Boolean = True);
var
  C: TCarte;
begin
  AStrings.BeginUpdate();
  try
    if DoClear then
      AStrings.Clear();
    for C in Self do
      AStrings.Add(C.Name);
 
  finally
    AStrings.EndUpdate();
  end;
end;
 
function TCartes.Clone(): TCartes;
var
  C: TCarte;
begin
  Result := TCartes.Create(True);
  for C in Self do
    Result.Add(C.Clone());
end;
 
{ TDecks }
 
constructor TDecks.Create(AOwnsCartes: Boolean = True);
begin
  inherited Create(AOwnsCartes);
end;
 
procedure TDecks.ToStrings(AStrings: TStrings; DoClear: Boolean = True);
var
  C: TCartes;
begin
  AStrings.BeginUpdate();
  try
    if DoClear then
      AStrings.Clear();
    for C in Self do
    begin
      C.ToStrings(AStrings, False);
      AStrings.Add('');
    end;
  finally
    AStrings.EndUpdate();
  end;
end;
 
{ TTarot }
 
constructor TTarot.Create();
var
  C: TCarteColor;
begin
  inherited Create();
 
  FAvailableCartes := TCartes.Create(True);
  FAvailableAtouts := TCartes.Create(False);
  for C := Low(C) to High(C) do
    FAvailableCouleurs[C] := TCartes.Create(False);
 
  FillAvailableCartes();
end;
 
destructor TTarot.Destroy();
var
  C: TCarteColor;
begin
  for C := Low(C) to High(C) do
    FreeAndNil(FAvailableCouleurs[C]);
  FreeAndNil(FAvailableAtouts);
  FreeAndNil(FAvailableCartes);
 
  inherited Destroy();
end;
 
procedure TTarot.FillAvailableCartes();
var
  I: Integer;
  C: TCarteColor;
  F: TCarteFigure;
  Carte: TCarte;
begin
  for C := Low(C) to High(C) do
  begin
    for I := 1 to 10 do
      FAvailableCartes.Add(TCarteWithCouleur.Create(NUMBERS[I], C));
 
    for F := Low(F) to High(F) do
     FAvailableCartes.Add(TCarteWithFigure.Create(F, C));
  end;
 
  for I := 1 to 21 do
    FAvailableCartes.Add(TCarte.Create(Format('%d d''Atout', [I]), ctAtout));
 
  FAvailableCartes.Add(TCarte.Create('L''excuse', ctAutre));
 
  for Carte in FAvailableCartes do
  begin
    if Carte is TCarteWithCouleur then
      FAvailableCouleurs[TCarteWithCouleur(Carte).CarteColor].Add(Carte)
    else if Carte.CarteType = ctAtout then
      FAvailableAtouts.Add(Carte);
  end;
 
end;
 
function TTarot.GetAvailableCouleurs(Index: TCarteColor): TCartes;
begin
  Result := FAvailableCouleurs[Index];
end;

**ShaiLeTroll** · 06/12/2023, 17h28

Une version récursive , j'avoue ne pas savoir comment l'écrire en itératif sans une effrayante lourdeur !

On peut calculer d'avance le résultat avec un Coefficient Binomial
Ce code est évidemment très lent car cela duplique beaucoup, utilise un Delete ... c'est assez vilain
Avec un Liste type Buffer Ring, on pourrait déjà amélioré les performances puisque le tirage n-1 cartes parmis n se ferait par un simple parcours de l'anneau n fois

Evidemement, il ne faut pas espérer obtenir 6 cartes parmis 72 par un système en mémoire, c'est impossible, il faut un fichier pour stocker autant combinaison
Faudrait vérifier ça fait 256 851 595 "combinaisons sans répétition", rien que les pointeurs des tlist<tcarte> c'est 1 797 961 165 octets, donc en 32Bits on oublie, il faut ajouter à cela toutes les données d'un TCarte ... on parle en Tera Octets, si tu cherches sur le forum, j'ai fait le code d'un combinatoire (arrangements avec répétition), le fichier faisait 40Go et ce n'était que quelques lettres dans un alphanumérique.

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
 
unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
  System.Math,
  Unit2;
 
{ TForm1 }
 
function GetAllTirages(ACartes: TCartes; Count: Integer; ATirages: TDecks; const AOffset: Integer = -1): Integer; forward;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  Tirages: TDecks;
  Choix: TCartes;
  Carte: TCarte;
begin
  with TTarot.Create() do
  try
    AvailableCartes.ToStrings(Memo1.Lines);
    Memo1.Lines.Add('---');
 
    Tirages := TDecks.Create(True);
    try
      GetAllTirages(AvailableAtouts, AvailableAtouts.Count, Tirages);
      Tirages.ToStrings(Memo1.Lines, False);
    finally
      Tirages.Free();
    end;
    Memo1.Lines.Add('---');
 
    Choix := TCartes.Create(False);
    try
      Choix.Add(AvailableAtouts[1]);
      Choix.Add(AvailableAtouts[21]);
      for Carte in AvailableCartes do
        if Carte.CarteType = ctAutre then
          Choix.Add(Carte);
      Choix.Add(AvailableCouleurs[ccCoeur][1]);
 
      // Moi le Tarot, j'ai oublié, je me souviens plutot du Nain Jaune
      Choix.Add(AvailableCouleurs[ccCarreaux][7]);
      Choix.Add(AvailableCouleurs[ccCarreaux][10]);
      Choix.Add(AvailableCouleurs[ccTrefle][TCarteWithFigure.VALET]);
      Choix.Add(AvailableCouleurs[ccPiques][TCarteWithFigure.DAME]);
      Choix.Add(AvailableCouleurs[ccCoeur][TCarteWithFigure.ROI]);
 
 
      Choix.ToStrings(Memo1.Lines, False);
      Memo1.Lines.Add('---');
 
      Tirages := TDecks.Create(True);
      try
        GetAllTirages(Choix, Choix.Count - 2, Tirages);
        Tirages.ToFlatStrings(Memo1.Lines, False);
      finally
        Tirages.Free();
      end;
    finally
      Choix.Free();
    end;
    Memo1.Lines.Add('---');
 
  finally
    Free();
  end;
end;
 
function GetAllTirages(ACartes: TCartes; Count: Integer; ATirages: TDecks; const AOffset: Integer = -1): Integer;
 
 
  function CoefficientBinomial(N, K: Integer): Integer;
  var
    D: Integer;
    CB: Double;
  begin
    if N < K then
      Abort;
 
    if N = K then
      Exit(1);
 
    if N = K + 1 then
      Exit(N);
 
    CB := 1;
    D := N - K;
    while D > 0 do
    begin
      CB := CB * (N / D);
      Dec(N);
      Dec(D);
    end;
    Result := Trunc(CB);
  end;
 
var
  Remaining: TCartes;
  I, K: Integer;
  TirageCount: Integer;
begin
  if not Assigned(ATirages) then
    Abort;
 
  if AOffset = -1 then
    ATirages.Clear();
 
  if ACartes.Count < Count then
    Exit(0);
 
  if ACartes.Count = Count then
  begin
    ATirages.Add(ACartes.Clone());
    Exit(1);
  end;
 
  if AOffset = -1 then
  begin
    TirageCount := CoefficientBinomial(ACartes.Count, Count);
    if ATirages.Capacity < TirageCount then
      ATirages.Capacity := TirageCount;
  end
  else
    TirageCount := -1;
 
  K := Max(AOffset, 0);
  for I := K to ACartes.Count - 1 do
  begin
    Remaining := ACartes.Clone();
    try
      Remaining.Delete(I);
 
      GetAllTirages(Remaining, Count, ATirages, K);
      Inc(K);
 
    finally
      Remaining.Free();
    end;
  end;
 
  if TirageCount > 0 then
    Assert(TirageCount = ATirages.Count);
 
  Result := ATirages.Count;
end;
 
end.

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
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
unit Unit2;
 
interface
 
uses System.Classes, System.Generics.Collections;
 
type
  TCarteColor = (ccCoeur, ccCarreaux, ccTrefle, ccPiques);
  TCarteType = (ctAutre, ctNumber, ctFigure, ctAtout);
  TCarteFigure = (cfValet, cfCavalier, cfDame, cfRoi);
 
  TCarte = class(TObject)
  strict private
    FName: string;
    FCarteType: TCarteType;
  public
    constructor Create(const AName: string; const ACarteType: TCarteType);
    function Clone(): TCarte; virtual;
 
    property Name: string read FName;
    property CarteType: TCarteType read FCarteType;
  end;
 
  TCarteWithCouleur = class(TCarte)
  public
    const
      COLORS: array[TCarteColor] of string = ('Coeur', 'Carreaux', 'Trefle', 'Piques');
  strict private
    FNumber: string;
    FCarteColor: TCarteColor;
  public
    constructor Create(const ANumber: string; const ACarteColor: TCarteColor; const ACarteType: TCarteType = ctNumber);
    function Clone(): TCarte; override;
 
    property Number: string read FNumber;
    property CarteColor: TCarteColor read FCarteColor;
  end;
 
  TCarteWithFigure = class(TCarteWithCouleur)
  public
    const
      FIGURES: array[TCarteFigure] of string = ('Valet', 'Cavalier', 'Dame', 'Roi');
      VALET = 11;
      CAVALIER = 12;
      DAME = 13;
      ROI = 14;
  strict private
    FCarteFigure: TCarteFigure;
  public
    constructor Create(const ACarteFigure: TCarteFigure; const ACarteColor: TCarteColor);
    function Clone(): TCarte; override;
 
    property CarteFigure: TCarteFigure read FCarteFigure;
  end;
 
  TCartes = class(System.Generics.Collections.TObjectList<TCarte>)
  private
    function GetCarte(Index: Integer): TCarte;
  public
    constructor Create(AOwnsCartes: Boolean = True);
 
    function Clone(): TCartes;
    procedure ToStrings(AStrings: TStrings; DoClear: Boolean = True);
    procedure ToFlatStrings(AStrings: TStrings; DoClear: Boolean = True);
 
    property Cartes[Index: Integer]: TCarte read GetCarte; default;
  end;
 
  TDecks = class(System.Generics.Collections.TObjectList<TCartes>)
  public
    constructor Create(AOwnsCartes: Boolean = True);
 
    procedure ToStrings(AStrings: TStrings; DoClear: Boolean = True);
    procedure ToFlatStrings(AStrings: TStrings; DoClear: Boolean = True);
  end;
 
  TTarot = class(TObject)
  public
    const
      NUMBERS: array[1..10] of string = ('As', 'Deux', 'Trois', 'Quatre', 'Cinq', 'Six', 'Sept', 'Huit', 'Neuf', 'Dix');
  strict private
    FAvailableCartes: TCartes;
    FAvailableAtouts: TCartes;
    FAvailableCouleurs: array[TCarteColor] of TCartes;
 
    procedure FillAvailableCartes();
  private
    function GetAvailableCouleurs(Index: TCarteColor): TCartes;
  public
    constructor Create();
    destructor Destroy(); override;
 
    property AvailableCartes: TCartes read FAvailableCartes;
    property AvailableAtouts: TCartes read FAvailableAtouts;
    property AvailableCouleurs[Index: TCarteColor]: TCartes read GetAvailableCouleurs;
  end;
 
implementation
 
uses System.SysUtils;
 
{ TCarte }
 
constructor TCarte.Create(const AName: string; const ACarteType: TCarteType);
begin
  inherited Create();
 
  FName := AName;
  FCarteType := ACarteType;
end;
 
function TCarte.Clone(): TCarte;
begin
  Result := TCarte.Create(FName, FCarteType);
end;
 
{ TCarteWithCouleur }
 
constructor TCarteWithCouleur.Create(const ANumber: string; const ACarteColor: TCarteColor; const ACarteType: TCarteType = ctNumber);
begin
  inherited Create(Format('%s de %s', [ANumber, COLORS[ACarteColor]]), ACarteType);
 
  FNumber := ANumber;
  FCarteColor := ACarteColor;
end;
 
function TCarteWithCouleur.Clone(): TCarte;
begin
  Result := TCarteWithCouleur.Create(FNumber, FCarteColor);
end;
 
{ TCarteWithFigure }
 
constructor TCarteWithFigure.Create(const ACarteFigure: TCarteFigure; const ACarteColor: TCarteColor);
begin
  inherited Create(FIGURES[ACarteFigure], ACarteColor, ctFigure);
 
  FCarteFigure := ACarteFigure;
end;
 
function TCarteWithFigure.Clone(): TCarte;
begin
  Result := TCarteWithFigure.Create(FCarteFigure, CarteColor);
end;
 
{ TCartes }
 
constructor TCartes.Create(AOwnsCartes: Boolean = True);
begin
  inherited Create(AOwnsCartes);
end;
 
function TCartes.GetCarte(Index: Integer): TCarte;
begin
  Result := Items[Index - 1];
end;
 
procedure TCartes.ToStrings(AStrings: TStrings; DoClear: Boolean = True);
var
  C: TCarte;
begin
  AStrings.BeginUpdate();
  try
    if DoClear then
      AStrings.Clear();
    for C in Self do
      AStrings.Add(C.Name);
 
  finally
    AStrings.EndUpdate();
  end;
end;
 
procedure TCartes.ToFlatStrings(AStrings: TStrings; DoClear: Boolean = True);
var
  C: TCarte;
  I: Integer;
  S: string;
begin
  AStrings.BeginUpdate();
  try
    if DoClear then
      AStrings.Clear();
    if Count > 1 then
    begin
      S := Items[0].Name;
      for I := 1 to Count - 1 do
        S := S + ' + ' + Items[I].Name;
    end;
    AStrings.Add(S);
 
  finally
    AStrings.EndUpdate();
  end;
end;
 
 
 
function TCartes.Clone(): TCartes;
var
  C: TCarte;
begin
  Result := TCartes.Create(True);
  for C in Self do
    Result.Add(C.Clone());
end;
 
{ TDecks }
 
constructor TDecks.Create(AOwnsCartes: Boolean = True);
begin
  inherited Create(AOwnsCartes);
end;
 
procedure TDecks.ToStrings(AStrings: TStrings; DoClear: Boolean = True);
var
  C: TCartes;
begin
  AStrings.BeginUpdate();
  try
    if DoClear then
      AStrings.Clear();
    for C in Self do
    begin
      C.ToStrings(AStrings, False);
      AStrings.Add('');
    end;
  finally
    AStrings.EndUpdate();
  end;
end;
 
procedure TDecks.ToFlatStrings(AStrings: TStrings; DoClear: Boolean = True);
var
  C: TCartes;
begin
  AStrings.BeginUpdate();
  try
    if DoClear then
      AStrings.Clear();
    for C in Self do
      C.ToFlatStrings(AStrings, False);
  finally
    AStrings.EndUpdate();
  end;
end;
 
{ TTarot }
 
constructor TTarot.Create();
var
  C: TCarteColor;
begin
  inherited Create();
 
  FAvailableCartes := TCartes.Create(True);
  FAvailableAtouts := TCartes.Create(False);
  for C := Low(C) to High(C) do
    FAvailableCouleurs[C] := TCartes.Create(False);
 
  FillAvailableCartes();
end;
 
destructor TTarot.Destroy();
var
  C: TCarteColor;
begin
  for C := Low(C) to High(C) do
    FreeAndNil(FAvailableCouleurs[C]);
  FreeAndNil(FAvailableAtouts);
  FreeAndNil(FAvailableCartes);
 
  inherited Destroy();
end;
 
procedure TTarot.FillAvailableCartes();
var
  I: Integer;
  C: TCarteColor;
  F: TCarteFigure;
  Carte: TCarte;
begin
  for C := Low(C) to High(C) do
  begin
    for I := 1 to 10 do
      FAvailableCartes.Add(TCarteWithCouleur.Create(NUMBERS[I], C));
 
    for F := Low(F) to High(F) do
     FAvailableCartes.Add(TCarteWithFigure.Create(F, C));
  end;
 
  for I := 1 to 21 do
    FAvailableCartes.Add(TCarte.Create(Format('%d d''Atout', [I]), ctAtout));
 
  FAvailableCartes.Add(TCarte.Create('L''excuse', ctAutre));
 
  for Carte in FAvailableCartes do
  begin
    if Carte is TCarteWithCouleur then
      FAvailableCouleurs[TCarteWithCouleur(Carte).CarteColor].Add(Carte)
    else if Carte.CarteType = ctAtout then
      FAvailableAtouts.Add(Carte);
  end;
 
end;
 
function TTarot.GetAvailableCouleurs(Index: TCarteColor): TCartes;
begin
  Result := FAvailableCouleurs[Index];
end;
 
end.

le résultat

Code Cartes, Choix et Tirage :

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
As de Coeur
Deux de Coeur
Trois de Coeur
Quatre de Coeur
Cinq de Coeur
Six de Coeur
Sept de Coeur
Huit de Coeur
Neuf de Coeur
Dix de Coeur
Valet de Coeur
Cavalier de Coeur
Dame de Coeur
Roi de Coeur
As de Carreaux
Deux de Carreaux
Trois de Carreaux
Quatre de Carreaux
Cinq de Carreaux
Six de Carreaux
Sept de Carreaux
Huit de Carreaux
Neuf de Carreaux
Dix de Carreaux
Valet de Carreaux
Cavalier de Carreaux
Dame de Carreaux
Roi de Carreaux
As de Trefle
Deux de Trefle
Trois de Trefle
Quatre de Trefle
Cinq de Trefle
Six de Trefle
Sept de Trefle
Huit de Trefle
Neuf de Trefle
Dix de Trefle
Valet de Trefle
Cavalier de Trefle
Dame de Trefle
Roi de Trefle
As de Piques
Deux de Piques
Trois de Piques
Quatre de Piques
Cinq de Piques
Six de Piques
Sept de Piques
Huit de Piques
Neuf de Piques
Dix de Piques
Valet de Piques
Cavalier de Piques
Dame de Piques
Roi de Piques
1 d'Atout
2 d'Atout
3 d'Atout
4 d'Atout
5 d'Atout
6 d'Atout
7 d'Atout
8 d'Atout
9 d'Atout
10 d'Atout
11 d'Atout
12 d'Atout
13 d'Atout
14 d'Atout
15 d'Atout
16 d'Atout
17 d'Atout
18 d'Atout
19 d'Atout
20 d'Atout
21 d'Atout
L'excuse
---
1 d'Atout
2 d'Atout
3 d'Atout
4 d'Atout
5 d'Atout
6 d'Atout
7 d'Atout
8 d'Atout
9 d'Atout
10 d'Atout
11 d'Atout
12 d'Atout
13 d'Atout
14 d'Atout
15 d'Atout
16 d'Atout
17 d'Atout
18 d'Atout
19 d'Atout
20 d'Atout
21 d'Atout

---
1 d'Atout
21 d'Atout
L'excuse
As de Coeur
Sept de Carreaux
Dix de Carreaux
Valet de Trefle
Dame de Piques
Roi de Coeur
---
L'excuse + As de Coeur + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
21 d'Atout + As de Coeur + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
21 d'Atout + L'excuse + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
21 d'Atout + L'excuse + As de Coeur + Dix de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
21 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
21 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Dix de Carreaux + Dame de Piques + Roi de Coeur
21 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Roi de Coeur
21 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Dame de Piques
1 d'Atout + As de Coeur + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
1 d'Atout + L'excuse + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
1 d'Atout + L'excuse + As de Coeur + Dix de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
1 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
1 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Dix de Carreaux + Dame de Piques + Roi de Coeur
1 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Roi de Coeur
1 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Dame de Piques
1 d'Atout + 21 d'Atout + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
1 d'Atout + 21 d'Atout + As de Coeur + Dix de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
1 d'Atout + 21 d'Atout + As de Coeur + Sept de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
1 d'Atout + 21 d'Atout + As de Coeur + Sept de Carreaux + Dix de Carreaux + Dame de Piques + Roi de Coeur
1 d'Atout + 21 d'Atout + As de Coeur + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Roi de Coeur
1 d'Atout + 21 d'Atout + As de Coeur + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Dame de Piques
1 d'Atout + 21 d'Atout + L'excuse + Dix de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
1 d'Atout + 21 d'Atout + L'excuse + Sept de Carreaux + Valet de Trefle + Dame de Piques + Roi de Coeur
1 d'Atout + 21 d'Atout + L'excuse + Sept de Carreaux + Dix de Carreaux + Dame de Piques + Roi de Coeur
1 d'Atout + 21 d'Atout + L'excuse + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Roi de Coeur
1 d'Atout + 21 d'Atout + L'excuse + Sept de Carreaux + Dix de Carreaux + Valet de Trefle + Dame de Piques
1 d'Atout + 21 d'Atout + L'excuse + As de Coeur + Valet de Trefle + Dame de Piques + Roi de Coeur
1 d'Atout + 21 d'Atout + L'excuse + As de Coeur + Dix de Carreaux + Dame de Piques + Roi de Coeur
1 d'Atout + 21 d'Atout + L'excuse + As de Coeur + Dix de Carreaux + Valet de Trefle + Roi de Coeur
1 d'Atout + 21 d'Atout + L'excuse + As de Coeur + Dix de Carreaux + Valet de Trefle + Dame de Piques
1 d'Atout + 21 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Dame de Piques + Roi de Coeur
1 d'Atout + 21 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Valet de Trefle + Roi de Coeur
1 d'Atout + 21 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Valet de Trefle + Dame de Piques
1 d'Atout + 21 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Dix de Carreaux + Roi de Coeur
1 d'Atout + 21 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Dix de Carreaux + Dame de Piques
1 d'Atout + 21 d'Atout + L'excuse + As de Coeur + Sept de Carreaux + Dix de Carreaux + Valet de Trefle
---

combinaisons dans un tlist

Delphi

Vue hybride

Discussions similaires

Partager

Partager