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.