Schachproblem

[nailor]

So hier mal mein BEitrag zu dem Schach/Programmier-Problem von wegen acht Damen so auf ein Schachbrett packen, das keine einen andere schlagen kann. Ich hab von dem Problem gehört, und von der Möglichkeit es zu proggen, indem man immer die nächstmöglich Lösung nimmt, und sobald es nicht mehr geht, seine Züge soweit zurücknimmt, bis wieder eine Möglichkeit besteht. Hab noch keinen Code gesehen, alles selber gedacht/gemacht.

Und das heißt hier ja:

Zitat:

Freeware-Programme (mit oder ohne Sourcecode) zum Testen und Diskutieren

und mich würde mal interessieren, wo ihr verbesserungwürdige Punkte seht. Allerdings nur was den Algo und die Darstellung angeht. So Sachen, dass man im Moment einen InputQuery hat und auf das Bild klicken muss, ist deshalb, dass man sich den Code schneller Cut&Pasten kann, weil man nur ein 160*160 (oder größer) Image braucht.

So, dann viel Spass bei diskutieren:

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure Image1Click(Sender: TObject);
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

procedure TForm1.Image1Click(Sender: TObject);
var
  Schachbrett: array[0..7] of array[0..7] of boolean;
  ReiheAktuell: byte;
  SpalteMindest: byte;
  SpalteAktuell: byte;
  i,j: byte;
  b: boolean;
  t: TBitMap;
  times_s: string;
  times_i: byte;
begin
times_s := '1';
if not InputQuery('Lösungs-ID', 'Zeige Lösung Nummer:', times_s) then
  exit;
if (strtoint(times_s)) in [1..92] then
  times_i := strtoint(times_s)
else
  begin
    ShowMessage('Zu hoch ->  1 --- 92');
    exit;
  end;

for i := 0 to 7 do
  for j := 0 to 7 do
    Schachbrett[i,j] := false;
ReiheAktuell := 0;
SpalteMindest := 0;

{###}repeat      {die einzelnen Lösungen}
    dec(times_i);
repeat           {eine einzelne Lösung}
  for SpalteAktuell := SpalteMindest to 7 do
    begin               {Feld-Test}
      b := false;
      for i := 0 to 7 do
        begin
          b := (b or Schachbrett[ReiheAktuell, i] or Schachbrett[i, SpalteAktuell]); {senkrecht, waagrecht}
            if ((SpalteAktuell + abs(ReiheAktuell - i)) in [0..7]) then
          b := (b or Schachbrett[i, SpalteAktuell + abs(ReiheAktuell - i)]);         {diagonal oben}
            if ((SpalteAktuell - abs(ReiheAktuell - i)) in [0..7]) then
          b := (b or Schachbrett[i, SpalteAktuell - abs(ReiheAktuell - i)]);         {diagonal unten}
        end;            {Feld-Test}
      if not b then
        begin           {Feld frei}
          Schachbrett[ReiheAktuell, SpalteAktuell] := true;
          SpalteMindest := 0;
          inc(ReiheAktuell);
          Break;
        end
      else              {Feld nicht frei}
      if SpalteAktuell = 7 then
        begin {zurücknehmen}
          repeat
            dec(ReiheAktuell);
            for j := 0 to 7 do
              if Schachbrett[ReiheAktuell, j] then
                begin
                  Schachbrett[ReiheAktuell, j] := false;
                  SpalteMindest := j + 1;
                  Break;
                end;
          until
            SpalteMindest < 8;
        end;  {zurücknehmen}
    end;
until
  ReiheAktuell = 8;
{###}until
    times_i = 0;

t := TBitMap.Create;
t.Width := 160;
t.Height := 160;
t.Canvas.Brush.Color := clBlack;
t.Canvas.Pen.Color := clGray;

for i := 0 to 7 do
  for j := 0 to 7 do
    if Schachbrett[i, j] then
      begin
        t.Canvas.Brush.Color := clRed;
        t.Canvas.Rectangle(20*i, 20*j, 20*i+20, 20*j+20);
        t.Canvas.Brush.Color := clBlack;
      end
    else
      t.Canvas.Rectangle(20*i, 20*j, 20*i+20, 20*j+20);

Image1.Picture.Bitmap := t;
t.Free;
end;

end.