Unit Unit1;
Interface
Uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
Type
TCellType =
Set Of (cStart, cFinal, cSolution, cFree);
TForm1 =
Class(TForm)
Button1: TButton;
Image1: TImage;
CheckBox1: TCheckBox;
Procedure Button1Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
Private
Cells:
Array[0..49, 0..49]
Of Record S, O: Boolean; CellType: TCellType
End;
Procedure GenerateMaze(StartX, StartY: Integer);
Procedure DrawMaze(ShowSolution: Boolean);
End;
Var
Form1: TForm1;
Implementation
{$R *.DFM}
Procedure TForm1.Button1Click(Sender: TObject);
Begin
Randomize;
//RandSeed:=0;
Caption:=IntToStr(RandSeed);
// Labyrinth erstellen mit der Startposition x=25 y=25
GenerateMaze(25,25);
// Labyrinth anzeigen
DrawMaze(CheckBox1.Checked);
End;
procedure TForm1.DrawMaze(ShowSolution: Boolean);
Var x, y: Integer;
begin
Image1.Picture.Bitmap:=Nil;
Image1.Width:=501;
Image1.Height:=501;
With Image1.Canvas
Do Begin
Brush.Color:=clBlack;
FrameRect(ClipRect);
Pen.Width:=1;
Pen.Color:=clBlack;
For x:=0
to 49
Do
For y:=0
to 49
Do Begin
If Cells[x,y].O
Then Begin
MoveTo((x+1)*10, y*10);
LineTo((x+1)*10, (y+1)*10+1)
End;
If Cells[x,y].S
Then Begin
MoveTo(x*10, (y+1)*10);
LineTo((x+1)*10+1, (y+1)* 10)
End;
If cStart
In Cells[x,y].CellType
Then
Ellipse(x*10+2, y*10+2, x*10+8, y*10+8);
If cFinal
In Cells[x,y].CellType
Then
Ellipse(x*10+2, y*10+2, x*10+8, y*10+8);
If ShowSolution
And (cSolution
In Cells[x,y].CellType)
Then
Ellipse(x*10+4, y*10+4, x*10+6, y*10+6);
End;
End;
end;
Procedure TForm1.GenerateMaze(StartX, StartY: Integer);
CONST N=0; S=1; W=2; O=3;
Function ValidCell(x, y: Integer): Boolean;
Begin
Result:=(x>=0)
And (y>=0)
And (x<=49)
And (y<=49);
End;
Function ValidWay(x, y: Integer): Boolean;
Begin
If ValidCell(x,y)
Then Result:=cFree
In Cells[x,y].CellType
Else Result:=False;
End;
Function NewWay(x, y, r: Integer): Boolean;
Var WegNr:
Array[0..3]
Of Boolean; Solution: Boolean; Nr: Byte;
Begin
// die aktuelle Zelle als belegt markieren
Cells[x,y].CellType:=Cells[x,y].CellType-[cFree];
// die Wand entfernen, aus der Richtung der wir gekommen sind
Case r
Of
S:
If ValidCell(x,y-1)
Then Cells[x,y-1].S:=False;
N: Cells[x,y].S:=False;
O:
If ValidCell(x-1,y)
Then Cells[x-1,y].O:=False;
W: Cells[x,y].O:=False;
End;
// Zufällige Reihenfolge der Richtungen berechnen
For Nr:=0
To 3
Do WegNr[Nr]:=False;
Solution:=False;
Repeat
Nr:=Random(4);
Case Nr
Of
N:
If ValidWay(x,y-1)
Then Solution:=NewWay(x,y-1,N);
S:
If ValidWay(x,y+1)
Then Solution:=NewWay(x,y+1,S);
W:
If ValidWay(x-1,y)
Then Solution:=NewWay(x-1,y,W);
O:
If ValidWay(x+1,y)
Then Solution:=NewWay(x+1,y,O);
End;
WegNr[Nr]:=True;
If Solution
Then With Cells[x,y]
Do CellType:=CellType+[cSolution];
Until WegNr[0]
And WegNr[1]
And WegNr[2]
And WegNr[3];
Result:=(cSolution
In Cells[x,y].CellType)
Or (cStart
In Cells[x,y].CellType);
End;
Var x, y: Integer;
Begin
For y:=0
To 49
Do
For x:=0
To 49
Do Begin
Cells[x,y].S:=True;
Cells[x,y].O:=True;
Cells[x,y].CellType:=[cFree];
End;
With Cells[StartX,StartY]
Do CellType:=CellType+[cStart];
// ein zufälliges Ziel
x:=Random(50); y:=Random(50);
// das Ziel an den Rand verschieben
Case Random(4)
of
N: y:=0;
S: y:=49;
W: x:=0;
O: x:=49;
End;
With Cells[x,y]
Do CellType:=CellType+[cFinal];
// Anfangszelle setzten
NewWay(x,y,-1);
End;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
DrawMaze(CheckBox1.Checked);
end;
End.