Magisches Quadrat - Delphi/Pascal

[xDIMAx]

Hallo, ich soll ein "Magisches Quadrat" in Delphi 7 programmieren. Zum Großteil hab ich es schon fertig nur hab ich das Problem, dass ich es in 3x3, 5x5 und 7x7 programmieren soll, es aber nur in 3x3 funktioniert. Und das auch nur, wenn ich zuerst einmal 5x5 oder 7x7 generiert habe. Hoffe mir kann jemand helfen.

Aufgabenstellung:
http://s.gullipics.com/image/z/x/l/h...-rxkj/img.jpeg

Programm:
https://docs.google.com/open?id=0B_X...FhzY0ExTmVsd2M
Einfach STRG+S drücken.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, ExtCtrls, Spin;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Button1: TButton;
    Label1: TLabel;
    RadioGroup1: TRadioGroup;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  Gr: integer;  //Größe des Quadrats
  Quadrat: array of array of integer;
  X, Y, X1, Y1, I: Integer;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
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);
  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]));
  for I:=2 to Gr*Gr+2*Gr+1 do
    begin
      if StringGrid1.Cells[X+1, Y+1]='' then
        begin
          X:=X+1;
          Y:=Y+1;
        end
      else
        begin
          X:=X+3;
          Y:=Y+2;
        end;
      if X>Gr then
        begin
          X:=X-Gr-1;
        end;
      if Y>Gr then
        begin
          Y:=Y-Gr-1;
        end;
      Quadrat[X, Y]:=I;
      StringGrid1.Cells[X, Y]:=IntToStr(Quadrat[X, Y]);
      Memo1.Lines.Add('Quadrat['+IntToStr(X)+','+IntToStr(Y)+'] '
                                +'= '+IntToStr(Quadrat[X, Y]));
    end;
end;

end.

[Bummi]

Zur 3*3 Ausgabe
Wenn Du Deine "Debugausgaben" im Memo anschaust siehst Du dass der der Fehler an 7
auftritt, die Prüfung nach 6
if StringGrid1.Cells[X+1, Y+1]='' then verwendet hier X und Y jeweils 2 und greift hiermit auf [3,3] zu welche gar nicht definiert ist.

Der ganze Aufbau ist fehleranfällig und unnötig kompliziert.
Schreibe doch den Algorithmus ohne Stringgrid nur mit dem Array (initialisiert mit 0).
Statt auf [X+1,Y+1]zu prüfen inkrementiere die Variablen direkt, verarbeite den Überlauf und prüfe dann im Array, wenn dort nicht 0 steht die Folgeschritte entsprechend.
Am Schluss das Array im Stringgrid ausgeben.

[xDIMAx]

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
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+1 do
    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;
      X:=X+1;
      Y:=Y+1;
      if Quadrat[X, Y]<>0 then
        begin
          X:=X+2;
          Y:=Y+1;
        end;
      if X>Gr then X:=X-Gr-1;
      if Y>Gr then Y:=Y-Gr-1;
      Quadrat[X, Y]:=I;
    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;

Ich glaube ich hab nur noch mehr falsch gemacht, aber wenigstens hab ich schon mal eine Basis. :/
Sorry, bin ein Neuling auf dem Gebiet.

Programm:
https://docs.google.com/open?id=0B_X...HYxRmtncmxSM0U

[Bummi]

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;

[xDIMAx]

Großen Dank! Werde versuchen mir den Quelltext zu verinnerlichen. Beim zweiten Text wird's wohl noch etwas zum Verständnis brauchen. Werde auf der Basis weiterarbeiten.

Einfach nur Vielen Dank!