Labyrinth darstellen

[Phantom1]

Hi GetCool

ich habe mal aus langeweile ein zufallslabyrinth programmiert, vieleicht hilfst dir weiter, die lösung kann dabei auch angezeigt werden.

Du brauchst nur ein Image1, ein Button1 und eine Checkbox1 auf dem formular

Delphi-Quellcode:

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.