Magisches Quadrat - Delphi/Pascal

[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;