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
| unit Unit2;
interface
uses
Windows, Messages, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, XPMan, ComCtrls;
type
TDynArrayC = class(TObject)
private
FTab : PChar;
FHauteur, FLargeur : cardinal;
function GetLigne( i : cardinal ): PChar;
function GetChar ( i , j : cardinal): char;
procedure SetChar ( i , j : cardinal ; Valeur : char );
public
constructor Create( Hauteur , Largeur : cardinal );
destructor Destroy; override;
property Tab[i , j : cardinal] : char read GetChar write SetChar; default;
property Ligne[i : cardinal] : PChar read GetLigne;
property Hauteur : cardinal read FHauteur;
property Largeur : cardinal read FLargeur;
end;
TMainForm = class(TForm)
Memo: TMemo;
ButtonTest: TButton;
Panel: TPanel;
EditChar: TEdit;
EditTaille: TEdit;
ProgressBar: TProgressBar;
XPManifest1: TXPManifest;
procedure ButtonTestClick(Sender: TObject);
procedure EditTailleExit(Sender: TObject);
private
{ Déclarations privées }
Taille : cardinal ;
public
{ Déclarations publiques }
end;
var
MainForm: TMainForm;
implementation
uses
SysUtils;
{$R *.dfm}
function Power( Base , Exp : Cardinal ) : Cardinal ;
begin
Result := 1;
while Exp <> 0 do
begin
if Exp mod 2 = 1 then Result := Result * Base;
Base := Base*Base;
Exp := Exp div 2 ;
end;
end;
function possibilites3( Elts : string ; TailleMot : Cardinal ) : TDynArrayC;
var NbElts ,Hauteur : Cardinal; i,j,k,l, Limitej, Limitei : Cardinal;
begin
NbElts := Length( Elts );
Hauteur := Power( NbElts , TailleMot );
Result := TDynArrayC.Create( Hauteur , TailleMot+1);
for i := 0 to Hauteur - 1 do
begin
Result[i,TailleMot] := #0;
end;
Limitej := 1;
Limitei := Hauteur div NbElts;
for l := 0 to TailleMot - 1 do
begin
for j := 0 to Limitej-1 do
for k := 0 to NbElts-1 do
for i := 0 to Limitei-1 do
Result[j*NbElts*Limitei + k*Limitei + i,l] := Elts[k+1];
Limitei := Limitei div NbElts;
Limitej := Limitej*NbElts;
end;
end;
{ TDynArrayC }
constructor TDynArrayC.Create(Hauteur, Largeur: cardinal);
begin
inherited Create;
FHauteur := Hauteur;
FLargeur := Largeur;
GetMem(FTab,Hauteur*Largeur);
end;
destructor TDynArrayC.Destroy;
begin
FreeMem( FTab, FHauteur*FLargeur );
inherited;
end;
function TDynArrayC.GetChar(i, j: cardinal): char;
begin
Result := FTab[i*FLargeur+j];
end;
function TDynArrayC.GetLigne(i: cardinal): PChar;
begin
Result := @FTab[i*FLargeur];
end;
procedure TDynArrayC.SetChar( i, j: cardinal ; Valeur: char);
begin
FTab[i*FLargeur+j] := Valeur;
end;
procedure TMainForm.ButtonTestClick(Sender: TObject);
var Resultat : TDynArrayC ; i : cardinal ; str : string;
Start,Stop,Frequency : Int64; Temps : Extended;
begin
str := EditChar.Text ;
if str = '' then Exit;
If Not QueryPerformanceCounter(Start) Then
raise Exception.Create('Pas de compteur hautes performances.');
Resultat := possibilites3( EditChar.Text , Taille );
QueryPerformanceCounter(Stop) ;
QueryPerformanceFrequency(Frequency);
Temps := (Stop-Start)/Frequency ;
if MessageDlg( IntToStr( Resultat.Hauteur ) + ' possibilités trouvées en '
+FloatToStr( Temps ) + sLineBreak + 'Les afficher ?' ,
mtInformation , [mbYes, mbNo], 0 ) <> mrYes then
begin
Resultat.Free;
Exit ;
end;
ProgressBar.Min := 0;
ProgressBar.Max := Resultat.Hauteur- 1 ;
ProgressBar.Position := 0 ;
ProgressBar.Visible := true;
Memo.Lines.BeginUpdate;
Memo.Clear;
for i := 0 to Resultat.Hauteur- 1 do
begin
Memo.Lines.Add( Resultat.Ligne[i] );
ProgressBar.Position := i;
end;
Memo.Lines.EndUpdate;
ProgressBar.Visible := false;
Resultat.Free;
end;
procedure TMainForm.EditTailleExit(Sender: TObject);
begin
try
Taille := StrToInt64( EditTaille.Text );
except
Taille := 0;
end;
EditTaille.Text := IntToStr(Taille);
end;
end. |
Répondre avec citation
)
)
Envoyé par Gilbert Geyer
Partager