unit dame2u;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    GroupBox1: TGroupBox;
    ListBox1: TListBox;
    GroupBox2: TGroupBox;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Shape4: TShape;
    Shape5: TShape;
    Shape6: TShape;
    Shape7: TShape;
    Shape8: TShape;
    Shape9: TShape;
    Shape10: TShape;
    Shape11: TShape;
    Shape12: TShape;
    Shape13: TShape;
    Shape14: TShape;
    Shape15: TShape;
    Shape16: TShape;
    Shape17: TShape;
    Shape18: TShape;
    Shape19: TShape;
    Shape20: TShape;
    Shape21: TShape;
    Shape22: TShape;
    Shape23: TShape;
    Shape24: TShape;
    Shape25: TShape;
    Shape26: TShape;
    Shape27: TShape;
    Shape28: TShape;
    Shape29: TShape;
    Shape30: TShape;
    Shape31: TShape;
    Shape32: TShape;
    Shape33: TShape;
    Shape34: TShape;
    Shape35: TShape;
    Shape36: TShape;
    Shape37: TShape;
    Shape38: TShape;
    Shape39: TShape;
    Shape40: TShape;
    Shape41: TShape;
    Shape42: TShape;
    Shape43: TShape;
    Shape44: TShape;
    Shape45: TShape;
    Shape46: TShape;
    Shape47: TShape;
    Shape48: TShape;
    Shape49: TShape;
    Shape50: TShape;
    Shape51: TShape;
    Shape52: TShape;
    Shape53: TShape;
    Shape54: TShape;
    Shape55: TShape;
    Shape56: TShape;
    Shape57: TShape;
    Shape58: TShape;
    Shape59: TShape;
    Shape60: TShape;
    Shape61: TShape;
    Shape62: TShape;
    Shape63: TShape;
    Shape64: TShape;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    Label27: TLabel;
    Label28: TLabel;
    Label29: TLabel;
    Label30: TLabel;
    Label31: TLabel;
    Label32: TLabel;
    Label33: TLabel;
    BitBtn8: TBitBtn;
    BitBtn7: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn5: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn1: TBitBtn;
    GroupBox3: TGroupBox;
    BitBtn9: TBitBtn;
    BitBtn10: TBitBtn;
    BitBtn11: TBitBtn;
    BitBtn12: TBitBtn;
    GroupBox4: TGroupBox;
    Label34: TLabel;
    Edit1: TEdit;
    Label35: TLabel;
    Edit2: TEdit;
    BitBtn13: TBitBtn;
    procedure ListBox1Click(Sender: TObject);
    procedure BitBtn9Click(Sender: TObject);
    procedure BitBtn10Click(Sender: TObject);
    procedure BitBtn11Click(Sender: TObject);
    procedure BitBtn12Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
const
  l=392; {Starthöhe der Buttons, die die Damen darstellen}
implementation

{$R *.dfm}
{Aufgabe war es das 8-Damen-Problem zu lösen, d. h. alle Möglichkeiten zu finden,
 wie man 8 Damen auf einem Schachbrett anordnet ohne das sie sich bedrohen, also
 in einer Spalte, Reihe oder Diagonale stehen. Aus der Lösungen kann man eine
 Teilmenge der echten Lösungen herausfiltern. In dieser Menge ergibt sich kein
 Element durch Spiegelung oder Drehung eines anderen Elements. Außerdem sollte
 die Möglichkeit geschaffen werden, den 'Gedankengang' des Computers graphisch
 darzustellen.}
procedure TForm1.ListBox1Click(Sender: TObject);
var
  x:integer;{Schleifenvariable}
begin
  for x:=1 to 8 do
  begin {begin of for1}
    tbitbtn(findcomponent('BitBtn'+IntToStr(x))).Left:=
    tshape(findcomponent('Shape'+IntToStr(x))).Left;
    tbitbtn(findcomponent('BitBtn'+IntToStr(x))).Top:=
    tshape(findcomponent('Shape'+IntToStr(8*StrToInt
    (Copy(Listbox1.Items.Strings[Listbox1.ItemIndex],4*x,1))-7))).Top;
    {Da 2 Damen nicht die gleiche x-Koordinate haben dürfen, gilt ohne
    Beschränkung der Allgemeinheit, dass die erste Dame in der ersten
    Spalte ist, die zweite in der zweiten, usw.. Jede vierte Stelle des
    Listeneintrags (der eine Lösung angibt) wird herauskopiert und damit
    legt das Programm die y-Koordinate der 8 Damen fest. Mit Hilfe der 2
    Koordinaten kann die Dame nun die gleiche Position wie das aus der
    Liste gefolgerte Schachfeld annehmen.} 
  end; {end of for1}
  end;

procedure TForm1.BitBtn9Click(Sender: TObject);
var
  a,b,c,d,e,f,g,h:integer; {y-Koordinate der 8 Damen}
begin
  Listbox1.Items.Clear; {Löschen der Ausgabeliste}
  for a:=1 to 8 do
  begin {begin of for1}
    for b:=1 to 8 do
    begin {begin of for2}
      if ((b<>a)and((b-a)*(b-a)<>1))
      then
      begin {begin of then1}
        for c:=1 to 8 do
        begin {begin of for3}
          if ((c<>a)and(c<>b)and((c-a)*(c-a)<>4)and((c-b)*(c-b)<>1))
          then
          begin {begin of then2}
            for d:=1 to 8 do
            begin {begin of for4}
              if ((d<>a)and(d<>b)and(d<>c)and((d-a)*(d-a)<>9)and((d-b)*(d-b)<>4)
              and((d-c)*(d-c)<>1))
              then
              begin {begin of then3}
                for e:=1 to 8 do
                begin {begin of for5}
                  if ((e<>a)and(e<>b)and(e<>c)and(e<>d)and((e-a)*(e-a)<>16)
                  and((e-b)*(e-b)<>9)and((e-c)*(e-c)<>4)and((e-d)*(e-d)<>1))
                  then
                  begin {begin of then4}
                    for f:=1 to 8 do
                    begin {begin of for6}
                      if ((f<>a)and(f<>b)and(f<>c)and(f<>d)and(f<>e)and
                      ((f-a)*(f-a)<>25)and((f-b)*(f-b)<>16)and((f-c)*(f-c)<>9)
                      and((f-d)*(f-d)<>4)and((f-e)*(f-e)<>1))
                      then
                      begin {begin of then5}
                        for g:=1 to 8 do
                        begin {begin of for7}
                          if ((g<>a)and(g<>b)and(g<>c)and(g<>d)and(g<>e)and(g<>f)
                          and((g-a)*(g-a)<>36)and((g-b)*(g-b)<>25)and
                          ((g-c)*(g-c)<>16)and((g-d)*(g-d)<>9)and((g-e)*(g-e)<>4)
                          and((g-f)*(g-f)<>1))
                          then {begin of for6}
                          begin
                            for h:=1 to 8 do
                            begin {begin of for8}
                              if ((h<>a)and(h<>b)and(h<>c)and(h<>d)and(h<>e)
                              and(h<>f)and(h<>g)and((h-a)*(h-a)<>49)and
                              ((h-b)*(h-b)<>36)and((h-c)*(h-c)<>25)and
                              ((h-d)*(h-d)<>16)and((h-e)*(h-e)<>9)
                              and((h-f)*(h-f)<>4)and((h-g)*(h-g)<>1))
                              then
                              begin {begin of then7}
                                Listbox1.Items.Add('  a'+IntToStr(a)+'; b'+IntToStr(b)
                                +'; c'+IntToStr(c)+'; d'+IntToStr(d)+'; e'+IntToStr(e)
                                +'; f'+IntToStr(f)+'; g'+IntToStr(g)+'; h'+IntToStr(h));
                              end;{begin of then7}
                            end;{begin of for8}
                          end;{begin of then6}
                        end;{begin of for7}
                      end;{begin of then5}
                    end;{begin of for6}
                  end;{begin of then4}
                end;{begin of for5}
              end;{begin of then3}
            end;{begin of for4}
          end;{begin of then2}
        end;{begin of for3}
      end;{begin of then1}
    end;{begin of for2}
  end;{begin of for1}
  {In den verschachtelten for-Schleifen werden die Kompinationen der 8
  verschieden y-Koordinatender Damen durchprobiert. Steht eine der y-Koordinaten
  im Widerspruch zu den anderen Koordinaten (if-Anweisung) wird eine neue
  y-Koordinate dieser Dame ausprobiert. Zum Widerspruch kommt es, wenn die
  y-Koordinate der Dame einer y-Koordinate der vorigen Damen entspricht
  (gleiche Zeile) oder wenn der Betrag der Differenz zweier y-Koordinaten dem
  Betrag der Differenz zweier entsprechender x-Koordinaten entspricht. Da ich
  nicht wusste wie man den Betrag realisiert, habe ich das beide Beträge
  quadriert, was zu einer äquvivalenten Aussage führt. Da die x-Koordinaten
  bekannt sind (siehe Kommentar zu ListBox1Click), kann man für das Quadrat der
  Beträge der Differenzen der x-Koordinaten konkrete Zahlen angeben. Führen alle
  8 y-Koordinaten zu keinem Widerspruch (die x-Koordinaten führen ja sowieso zu
  keinem Wiederspruch) werden sie in Schachschreibweise in einem Listeneintrag
  gespeichert.}
  Label1.Caption:='Es gibt '+IntToStr(Listbox1.Items.Count)+' Möglichkeiten!';
  {Am Schluss erfolgt die Auszählung der Listeneinträge, welche der Anzahl
  der Lösungen entspricht.}
end;

procedure TForm1.BitBtn10Click(Sender: TObject);
var
  a,b,c,d,e,f,g,h{y-Koordinate der 8 Damen},i{Anzahl der bereits ausgeführten
  Schritte},zeit{Dauer der Verzögerung},schritte{maximale Anzahl der Schritte}
  :integer;
begin
  Listbox1.Items.Clear; {Löschen der Ausgabeliste}
  schritte:=StrToInt(Edit2.Text); {Einlesen der maximalen Anzahl von Schritten}
  zeit:=StrToInt(Edit1.Text); {Einlesen der Dauer der Verzögerung}
  i:=0; {Es sind bis jetzt 0 Schritte ausgeführt.}
  for a:=1 to 8 do
  begin {begin of for1}
    if i<schritte
    then
    begin {begin of then1}
      BitBtn1.Top:=tshape(findcomponent('Shape'+IntToStr(8*a-7))).Top;
      BitBtn2.Top:=l;
      BitBtn3.Top:=l;
      BitBtn4.Top:=l;
      BitBtn5.Top:=l;
      BitBtn6.Top:=l;
      BitBtn7.Top:=l;
      BitBtn8.Top:=l;
      Refresh;
      Sleep(zeit);
      i:=i+1;
    end {end of then1}
    else
    Break;
    for b:=1 to 8 do
    begin {begin of for2}
      if i<schritte
      then
      begin {begin of then2}
        BitBtn2.Top:=tshape(findcomponent('Shape'+IntToStr(8*b-6))).Top;
        BitBtn3.Top:=l;
        BitBtn4.Top:=l;
        BitBtn5.Top:=l;
        BitBtn6.Top:=l;
        BitBtn7.Top:=l;
        BitBtn8.Top:=l;
        Refresh;
        Sleep(zeit);
        i:=i+1;
      end {end of then2}
      else
      Break;
      if ((b<>a)and((b-a)*(b-a)<>1))
      then
      begin {begin of then3}
        for c:=1 to 8 do
        begin {begin of for3}
          if i<schritte
          then
          begin {begin of then4}
            BitBtn3.Top:=tshape(findcomponent('Shape'+IntToStr(8*c-5))).Top;
            BitBtn4.Top:=l;
            BitBtn5.Top:=l;
            BitBtn6.Top:=l;
            BitBtn7.Top:=l;
            BitBtn8.Top:=l;
            Refresh;
            Sleep(zeit);
            i:=i+1;
          end {end of then4}
          else
          Break;
          if ((c<>a)and(c<>b)and((c-a)*(c-a)<>4)and((c-b)*(c-b)<>1))
          then
          begin {begin of then5}
            for d:=1 to 8 do
            begin {begin of for4}
              if i<schritte
              then
              begin {begin of then6}
                BitBtn4.Top:=tshape(findcomponent('Shape'+IntToStr(8*d-4))).Top;
                BitBtn5.Top:=l;
                BitBtn6.Top:=l;
                BitBtn7.Top:=l;
                BitBtn8.Top:=l;
                Refresh;
                Sleep(zeit);
                i:=i+1;
              end {end of then6}
              else
              Break;
              if ((d<>a)and(d<>b)and(d<>c)and((d-a)*(d-a)<>9)and((d-b)*(d-b)<>4)
              and((d-c)*(d-c)<>1))
              then
              begin {begin of then7}
                for e:=1 to 8 do
                begin {begin of for5}
                  if i<schritte
                  then
                  begin {begin of then8}
                    BitBtn5.Top:=
                    tshape(findcomponent('Shape'+IntToStr(8*e-3))).Top;
                    BitBtn6.Top:=l;
                    BitBtn7.Top:=l;
                    BitBtn8.Top:=l;
                    Refresh;
                    Sleep(zeit);
                    i:=i+1;
                  end {end of then8}
                  else
                  break;
                  if ((e<>a)and(e<>b)and(e<>c)and(e<>d)and((e-a)*(e-a)<>16)
                  and((e-b)*(e-b)<>9)and((e-c)*(e-c)<>4)and((e-d)*(e-d)<>1))
                  then
                  begin {begin of then9}
                    for f:=1 to 8 do
                    begin {begin of for6}
                      if i<schritte
                      then
                      begin {begin of then10}
                        BitBtn6.Top:=
                        tshape(findcomponent('Shape'+IntToStr(8*f-2))).Top;
                        BitBtn7.Top:=l;
                        BitBtn8.Top:=l;
                        Refresh;
                        Sleep(zeit);
                        i:=i+1;
                      end {end of then10}
                      else
                      break;
                      if ((f<>a)and(f<>b)and(f<>c)and(f<>d)and(f<>e)and
                      ((f-a)*(f-a)<>25)and((f-b)*(f-b)<>16)and((f-c)*(f-c)<>9)
                      and((f-d)*(f-d)<>4)and((f-e)*(f-e)<>1))
                      then
                      begin {begin of then11}
                        for g:=1 to 8 do
                        begin {begin of for7}
                          if i<schritte
                          then
                          begin {begin of then12}
                            BitBtn7.Top:=
                            tshape(findcomponent('Shape'+IntToStr(8*g-1))).Top;
                            BitBtn8.Top:=l;
                            Refresh;
                            Sleep(zeit);
                            i:=i+1;
                          end {end of then12}
                          else
                          break;
                          if ((g<>a)and(g<>b)and(g<>c)and(g<>d)and(g<>e)and(g<>f)
                          and((g-a)*(g-a)<>36)and((g-b)*(g-b)<>25)and
                          ((g-c)*(g-c)<>16)and((g-d)*(g-d)<>9)and((g-e)*(g-e)<>4)
                          and((g-f)*(g-f)<>1))
                          then
                          begin {begin of then13}
                            for h:=1 to 8 do
                            begin {begin of for8}
                              if i<schritte
                              then
                              begin {begin of then14}
                                BitBtn8.Top:=
                                tshape(findcomponent('Shape'+IntToStr(8*h))).Top;
                                Refresh;
                                Sleep(zeit);
                                i:=i+1;
                              end {end of then14}
                              else
                              break;
                              if ((h<>a)and(h<>b)and(h<>c)and(h<>d)and(h<>e)and
                              (h<>f)and(h<>g)and((h-a)*(h-a)<>49)and
                              ((h-b)*(h-b)<>36)and((h-c)*(h-c)<>25)and
                              ((h-d)*(h-d)<>16)and((h-e)*(h-e)<>9)
                              and((h-f)*(h-f)<>4)and((h-g)*(h-g)<>1))
                              then
                              begin {begin of then15}
                                Listbox1.Items.Add('  a'+IntToStr(a)+'; b'
                                +IntToStr(b)+'; c'+IntToStr(c)+'; d'+IntToStr(d)
                                +'; e'+IntToStr(e)+'; f'+IntToStr(f)+'; g'+
                                IntToStr(g)+'; h'+IntToStr(h));
                                Label1.Caption:='Es gibt '+
                                IntToStr(Listbox1.Items.Count)+
                                ' Möglichkeiten!';{Es erfolgt die Auszählung der
                                 Listeneinträge, welche der Anzahl der bisher
                                 gefundenen Lösungen entspricht.}
                              end;{end of then15}
                            end;{end of for8}
                          end;{end of then13}
                        end;{end of for7}
                      end;{end of then11}
                    end;{end of for6}
                  end;{end of then9}
                end;{end of for5}
              end;{end of then7}
            end;{end of for4}
          end;{end of then5}
        end;{end of for3}
      end;{end of then3}
    end;{end of for2}
  end;{end of for1}
  {Das Ganze verläuft im wesentlichen wie BitBtn9Click, nur dass nach der Auswahl
  der y-Koordinate einer Dame diese Wahl durch das Verschieben der Dame
  graphisch dargestellt wird. Die nachfolgenden Damen werden zu ihrer
  Ausgangsstellung zurückgebracht. Durch 'Refresh' wird die Grafik aktualisiert
  und durch 'Sleep' wird eine Verzögerung eingebaut.Schließlich erhöht sich die
  Anzahl der Schritte um 1.}
end;

procedure TForm1.BitBtn11Click(Sender: TObject);
var
  feld: Array[1..8,1..8] of integer;{y-Koordinate:1.Index:Nummer der Abbildung
  des Originals,2.Index:Nummer der der Dame}  
  h,i,j:integer;{Hilfsvariablen}
  del:bool;{gibt an, ob ein Listeneintrag gelöscht wurde}
begin
  BitBtn9.Click;{alle Lösungen suchen}
  i:=0;
  repeat
  begin {begin of repeat1}
    for h:=1 to 8 do
    begin {begin of for1}
      feld[1,h]:=StrToInt(Copy(Listbox1.Items.Strings[i],4*h,1)); {Aufstellen
      des Originals}
    end; {end of for1}
    for h:=1 to 8 do
    begin {begin of for2}
      feld[2,h]:=9-feld[1,h];{y-Koordinaten nach Spiegelung an der Geraden
      zwischen Zeile 4 und 5}
      feld[3,(9-h)]:=feld[1,h];{y-Koordinaten nach Spiegelung an der Geraden
      zwischen Spalte d und e}
      feld[4,(9-feld[1,h])]:=9-h;{y-Koordinaten nach Spiegelung an der Diagonalen
      von a,1 nach h,8}
      feld[5,feld[1,h]]:=h;{y-Koordinaten nach Spiegelung an der Diagonalen
      von a,8 nach h,1}
    end; {end of for2}
    for h:=1 to 8 do
    begin {begin of for3}
      feld[6,h]:=9-feld[3,h];{Drehung um 90 Grad}
      feld[7,(9-feld[3,h])]:=9-h;{Drehung um 180 Grad}
      feld[8,feld[3,h]]:=h;{Drehung um 270 Grad}
    end; {end of for3}
    j:=i+1;
    repeat
    begin {begin of repeat2}
      h:=1;
      del:=false;
      while h<9 do
      begin {begin of while1}
         if ('  a'+IntToStr(feld[h,1])+'; b'+IntToStr(feld[h,2])+'; c'+IntToStr(feld[h,3])+
         '; d'+IntToStr(feld[h,4])+'; e'+IntToStr(feld[h,5])+'; f'+IntToStr(feld[h,6])+'; g'
         +IntToStr(feld[h,7])+'; h'+IntToStr(feld[h,8]))=Listbox1.Items[j]
         then
         begin {begin of then1}
            Listbox1.Items.Delete(j);
            del:=true;
            h:=9;
         end; {end of then1}
         h:=h+1;
      end; {end of while1}
      if del=false
      then
      begin {begin of then2}
        j:=j+1;
      end; {end of then2}
    end; {end of repeat2}
    until j=Listbox1.Items.Count;
    i:=i+1;
  end; {end of repeat1}
  until i=Listbox1.Items.Count;
  {Ein nachfolgenden Listeneintrag wird untersucht ob er mit einem Abbild
  übereinstimmt. Wenn ja wird dieser Eintrag gelöscht und der eintrag, der
  durch das Verrutschen jetzt den Index des gelöschten Eintrags hat, wird
  wieder untersucht. Wenn nein wird der nächste Eintrag untersucht.
  Dies wiederholt sich, bis alle Einträge untersucht wurden. Danach ist der
  2. Eintrag Original und erfährt die gleiche Routine.Das geht solange bis nur
  noch Originale übrig sind.}
  Label1.Caption:='Es gibt '+IntToStr(Listbox1.Items.Count)+' Möglichkeiten!';
  {Es erfolgt die Auszählung der Listeneinträge, welche der Anzahl der echten
   Lösungen entspricht.}
end;

procedure TForm1.BitBtn12Click(Sender: TObject);
begin
  Listbox1.Items.Clear;
  BitBtn1.Top:=l;
  BitBtn2.Top:=l;
  BitBtn3.Top:=l;
  BitBtn4.Top:=l;
  BitBtn5.Top:=l;
  BitBtn6.Top:=l;
  BitBtn7.Top:=l;
  BitBtn8.Top:=l;
  Label1.Caption:='';
  Edit1.Text:='1';
  Edit2.Text:='10';
  {Die Einstellungen werden auf den Standart gesetzt.}
end;

end.