(*

标题:随机生成迷宫

说明:没有提供路线图

设计:Zswang

日期:2003-01-21

支持:wjhu111@21cn.com

*)

unit Unit1;

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 Dialogs, StdCtrls;

type

 TForm1 = class(TForm)

   Button1: TButton;

   procedure FormCreate(Sender: TObject);

   procedure Button1Click(Sender: TObject);

 private

   { Private declarations }

   FPointList: array of array of TAnchors;

   FRowCount: Integer;

   FColCount: Integer;

   FPoint: TPoint;

   procedure DrawPoint(mPoint: TPoint);

   procedure DrawMap;

   procedure InitMap;

   function RandomAnchor(mPoint: TPoint; var nAnchor: TAnchorKind): Boolean;

   procedure GenerateMaze;

 public

   { Public declarations }

 end;

var

 Form1: TForm1;

implementation

{$R *.dfm}

const

 cMoveOffset: array[TAnchorKind] of TPoint = (

(X: -1; Y: 00), //akLeft,

(X: 00; Y: -1), //akTop,

(X: +1; Y: 00), //akRight,

(X: 00; Y: +1) //akBottom

);

const

 cWidthOffset = 5;

function AllyAnchor(mAnchorKind: TAnchorKind): TAnchorKind;

begin

  case mAnchorKind of

    akLeft: Result := akRight;

    akTop: Result := akBottom;

    akRight: Result := akLeft;

  else {akBottom:} Result := akTop;

  end;

end;

procedure TForm1.DrawPoint(mPoint: TPoint);

var

 vAnchorKind: TAnchorKind;

begin

 Canvas.Pen.Color := clWindow;

 if not PtInRect(Rect(0, 0, FColCount, FRowCount), mPoint) then Exit;

 for vAnchorKind := Low(vAnchorKind) to High(vAnchorKind) do

   if vAnchorKind in FPointList[mPoint.X, mPoint.Y] then begin

     Canvas.Pen.Width := cWidthOffset;

     Canvas.MoveTo(mPoint.X * cWidthOffset * 2 + 2 * cWidthOffset, mPoint.Y * cWidthOffset * 2 + 2 * cWidthOffset);

     Canvas.LineTo(

       mPoint.X * cWidthOffset * 2 + cMoveOffset[vAnchorKind].X * cWidthOffset + 2 * cWidthOffset,

       mPoint.Y * cWidthOffset * 2 + cMoveOffset[vAnchorKind].Y * cWidthOffset + 2 * cWidthOffset);

   end;

end;

procedure TForm1.DrawMap;

var

 vCol, vRow: Integer;

begin

 for vCol := 0 to FColCount - 1 do

   for vRow := 0 to FRowCount - 1 do

     DrawPoint(Point(vCol, vRow));

end;

function TForm1.RandomAnchor(mPoint: TPoint;

 var nAnchor: TAnchorKind): Boolean;

var

 A: array[0..3] of TAnchorKind;

 vCount: Integer;

 vAnchorKind: TAnchorKind;

 vPoint: TPoint;

begin

 Result := False;

 if not PtInRect(Rect(0, 0, FColCount, FRowCount), mPoint) then Exit;

 vCount := 0;

 for vAnchorKind := Low(vAnchorKind) to High(vAnchorKind) do begin

   vPoint := Point(mPoint.X + cMoveOffset[vAnchorKind].X,

     mPoint.Y + cMoveOffset[vAnchorKind].Y);

   if (not (vAnchorKind in FPointList[mPoint.X, mPoint.Y])) and

     PtInRect(Rect(0, 0, FColCount, FRowCount), vPoint) and

     (FPointList[vPoint.X, vPoint.Y] = []) then begin

     A[vCount] := vAnchorKind;

     Inc(vCount);

   end;

 end;

 if vCount <= 0 then Exit;

 nAnchor := A[Random(vCount)];

 Result := True;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

 FColCount := 40;

 FRowCount := 40;

 SetLength(FPointList, FColCount, FRowCount);

 FPoint.X := 10;

 FPoint.Y := 10;

 Randomize;

 Color := clBlack;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 Repaint;

 GenerateMaze;

end;

procedure TForm1.GenerateMaze;

 procedure pGenerateMaze(mPoint: TPoint);

 var

   vAnchorKind: TAnchorKind;

   vPoint: TPoint;

 begin

   if not RandomAnchor(mPoint, vAnchorKind) then Exit;

   Include(FPointList[mPoint.X, mPoint.Y], vAnchorKind);

   vPoint.X := mPoint.X +  cMoveOffset[vAnchorKind].X;

   vPoint.Y := mPoint.Y +  cMoveOffset[vAnchorKind].Y;

   if PtInRect(Rect(0, 0, FColCount, FRowCount), vPoint) then

     Include(FPointList[vPoint.X, vPoint.Y], AllyAnchor(vAnchorKind));

   pGenerateMaze(vPoint);

   pGenerateMaze(mPoint);

 end;

begin

 InitMap;

 pGenerateMaze(Point(Random(FColCount), Random(FRowCount)));

 Include(FPointList[0, 0], akTop);

 Include(FPointList[FColCount - 1, FRowCount - 1], akBottom);

 DrawMap;

end;

procedure TForm1.InitMap;

var

 vCol, vRow: Integer;

begin

 for vCol := 0 to FColCount - 1 do

   for vRow := 0 to FRowCount - 1 do

     FPointList[vCol, vRow] := [];

end;

end.