AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Magisches Quadrat - Delphi/Pascal

Ein Thema von xDIMAx · begonnen am 1. Mai 2012 · letzter Beitrag vom 2. Mai 2012
Antwort Antwort
xDIMAx

Registriert seit: 4. Feb 2012
5 Beiträge
 
#1

Magisches Quadrat - Delphi/Pascal

  Alt 1. Mai 2012, 21:47
Delphi-Version: 7
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.
  Mit Zitat antworten Zitat
Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#2

AW: Magisches Quadrat - Delphi/Pascal

  Alt 1. Mai 2012, 23:38
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.
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat
xDIMAx

Registriert seit: 4. Feb 2012
5 Beiträge
 
#3

AW: Magisches Quadrat - Delphi/Pascal

  Alt 2. Mai 2012, 18:34
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
  Mit Zitat antworten Zitat
Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#4

AW: Magisches Quadrat - Delphi/Pascal

  Alt 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)
  Mit Zitat antworten Zitat
xDIMAx

Registriert seit: 4. Feb 2012
5 Beiträge
 
#5

AW: Magisches Quadrat - Delphi/Pascal

  Alt 2. Mai 2012, 20:34
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!
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:10 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz