Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
Delphi XE3 Enterprise
|
AW: Magisches Quadrat - Delphi/Pascal
2. Mai 2012, 19:49
ich habe ein paar Anmerkungen hinzugepackt, allerdings wird es für > 3 nicht magisch die Diagonalen passen nicht
Delphi-Quellcode:
procedure TForm5.Button1Click(Sender: TObject);
Procedure Ueberlauf;
begin
if X>Gr then X := 0;
if Y>Gr then Y := 0;
end;
begin
case RadioGroup1.ItemIndex of
0: Gr:=2;
1: Gr:=4;
2: Gr:=6;
else exit;
end;
for I:=0 to Gr do
begin
StringGrid1.Rows[I].Clear;
StringGrid1.Cols[I].Clear;
end;
Memo1.Clear;
StringGrid1.ColCount:=Gr+1;
StringGrid1.RowCount:=Gr+1;
SetLength(Quadrat, Gr*Gr, Gr*Gr);
for I:=0 to Gr*Gr+2*Gr do // 0 Basiert
begin
if I=0 then
begin
X:=Gr-trunc(Gr/2);
Y:=Gr-trunc(Gr/2)+1;
Quadrat[X, Y]:=1;
StringGrid1.Cells[X, Y]:=IntToStr(Quadrat[X, Y]);
Memo1.Lines.Add('Quadrat['+IntToStr(X)+','+IntToStr(Y)+'] '
+'= '+IntToStr(Quadrat[X, Y]));
end
else
begin // Begin fehlt
X:=X+1;
Y:=Y+1;
Ueberlauf; // Überlauf prüfen
While Quadrat[X, Y]<>0 do // mehrfach prüfen
begin
X:=X+2;
Y:=Y+1;
Ueberlauf; // Überlauf prüfen
end;
Quadrat[X, Y]:=I + 1;
end;
end;
for X:=0 to Gr do
begin
for Y:=0 to Gr do
begin
Memo1.Lines.Add('Quadrat['+IntToStr(X)+','+IntToStr(Y)+'] '
+'= '+IntToStr(Quadrat[X, Y]));
StringGrid1.Cells[X, Y]:=IntToStr(Quadrat[X, Y]);
end;
end;
end;
zwei Vorschläge Magic_0 entspricht Deinem Code Magic hält sich nicht an die Vorgaben liefert aber in sich magische Quadrate
Delphi-Quellcode:
uses math;
{$R *.dfm}
Type
TArr=Array of Array of Integer;
Function Magic_0(dim:Integer;sg:TStringGrid=nil):TArr;
var
i,x,y,Size:Integer;
Procedure Ueberlauf;
begin
if X > dim - 1 then X := 0
else if x<0 then x := dim - 1;
if Y > dim - 1 then Y := 0
else if y<0 then y := dim - 1;
end;
Procedure Ausgabe;
begin
Result[X,Y] := i + 1;
if Assigned(sg) then sg.Cells[X,Y] := IntToStr(Result[X,Y]);
if Result[X,Y] <>0 then
begin
inc(y);
inc(x);
Ueberlauf;
end;
end;
begin
if Assigned(sg) then
begin
sg.RowCount := dim;
sg.ColCount := dim;
end;
SetLength(Result,dim,dim);
Size := Round(Power(dim,2));
X := dim div 2;
Y := dim - 1;
for I := 0 to Size - 1 do
begin
if Result[X,Y]=0 then
begin
Ausgabe;
end
else
begin
while Result[X,Y]<>0 do
begin
inc(y);
inc(x,2);
Ueberlauf;
end;
Ausgabe;
end;
end;
end;
Function Magic(dim:Integer;sg:TStringGrid=nil):TArr;
var
i,x,y,Size:Integer;
Procedure Ueberlauf;
begin
if X > dim - 1 then X := 0
else if x<0 then x := dim - 1;
if Y > dim - 1 then Y := 0
else if y<0 then y := dim - 1;
end;
Procedure Ausgabe;
begin
Result[X,Y] := i + 1;
if Assigned(sg) then sg.Cells[X,Y] := IntToStr(Result[X,Y]);
if (Result[X,Y] MOD dim)<>0 then
begin
dec(y);
inc(x);
end
else
begin
inc(y);
end;
Ueberlauf;
end;
begin
if Assigned(sg) then
begin
sg.RowCount := dim;
sg.ColCount := dim;
end;
SetLength(Result,dim,dim);
Size := Round(Power(dim,2));
X := dim div 2;
Y := 0;
for I := 0 to Size - 1 do
begin
if Result[X,Y]=0 then
begin
Ausgabe;
end;
end;
end;
procedure TForm5.Button1Click(Sender: TObject);
begin
Magic_0(3,StringGrid1);
Magic(7,StringGrid2);
end;
Thomas Wassermann H₂♂ Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂♂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
Geändert von Bummi ( 2. Mai 2012 um 19:53 Uhr)
|