用Delphi编写的一个程序自动生成迷宫游戏
这是用Delphi编写的一个程序自动生成迷宫游戏，程序能自动寻找路径,先来看看实现效果:
通过这个例子我们可以看到用Delphi来编写Windows的ui程序是非常方便快捷的。
在这里是用TDrawGrid来实现画出迷宫的，首先拖入一个DrawGrid到窗口上。
拖入两个按扭，一个生成迷宫，一个寻找路径;一个TScrollBar用控制难易度，一个TLabel用于显示难易度值
常量及变量定义
const
GO = -1;//可以通过的标识
STOP = -2;
BEG_CELL = 0;
END_CELL = -3;
var
dif: Integer = 50;
masPole: array [0 .. 11, 0 .. 11] of Integer;//迷宫大小
BeginCell, EndCell: TPoint;//开始指针 结束指针这里的实现并不算很复杂，在窗口全局定义：
procedure CreateLab;//创建迷宫
function FindPath: boolean;//寻找路径
procedure ShowPath;//显示路径创建迷宫
procedure TForm1.CreateLab;
var
i, j: Integer;
begin
for j := 0 to 11 do
for i := 0 to 11 do
BEGIN
masPole[i, j] := STOP;
if Random(101) >= dif then
// if Random(12) >= dif then
masPole[i, j] := GO
else
masPole[i, j] := STOP;
END;
dgPole.Invalidate;
end;寻找路径
// 在两点之间寻找路径
function TForm1.FindPath: boolean;
var
// 坐标列表：
// 这里是定死了大小，扩展性不是太好，如果增加面积如果动态扩展
// 12*12=144 去掉一个起点143
// 坐标列表：
CoordList: array [1 .. 143] of TPoint;
// 列表中的索引：
ptrWrite, ptrRead: Integer;
p, q: Integer;
i, j: Integer;
// 检查坐标
function TestCoord(X, Y: Integer): boolean;
begin
Result := true;
if (X < 0) or (X > 11) or (Y < 0) or (Y > 11) or
((masPole[X, Y] <> GO) and (masPole[X, Y] <> END_CELL)) then
Result := false;
end;
begin
// 如果BeginCell=EndCell，则初始单元格与最终单元格相同， 你不需要找路！
// 将初始单元格的坐标添加到列表中：
CoordList[1] := BeginCell;
// устанавливаем указатель для считывания координат на начало списка:
// 我们设置一个指针来读取列表开头的坐标：
ptrRead := 1;
// 设置一个指针以将新坐标写入以下In-dex：
ptrWrite := 2;
// masPole数组中的初始单元格是BEG_CELL=0
// 我们从列表的开头移动到列表的末尾，直到列表结束：
while ptrRead < ptrWrite do
begin
// 当前单元格的坐标：
p := CoordList[ptrRead].X;
q := CoordList[ptrRead].Y;
// 检查相邻的单元格：
for i := p - 1 to p + 1 do
for j := q - 1 to q + 1 do
// 如果他们找到了隔壁可通过的笼子，
if ((i = p) or (j = q)) and TestCoord(i, j) then
begin
// 然后我们在其中写入一个比当前单元格中多1的数字：
masPole[i, j] := masPole[p, q] + 1;
// 如果到了最后一个单元格
if (i = EndCell.X) and (j = EndCell.Y) then
begin
// 然后找到了,返回true
Result := true;
exit;
end
else
begin
// 我们将相邻单元格的坐标写入列表末尾：
CoordList[ptrWrite] := Point(i, j);
// 移动指针：
inc(ptrWrite);
dgPole.Invalidate;
// showmessage(inttostr(masPole[i,j]) + ' x='+inttostr(i)+ ' y='+inttostr(j));
end;
end;
// 转到列表中的下一个单元格：
inc(ptrRead);
end;
// 找不到路径：返回false
Result := false;
end;显示路径
// 显示路径
procedure TForm1.ShowPath;
var
n, LenPath: Integer;
i, j, p, q: Integer;
path: array [0 .. 144] of TPoint;
Rect: TRect;
s: string;
// 检查坐标：
function TestCoord(X, Y: Integer): boolean;
begin
Result := true;
if (X < 0) or (X > 11) or (Y < 0) or (Y > 11) or (masPole[X, Y] <> n - 1)
then
Result := false;
end;
begin
// 路径长度等于结束单元格中的数字：
LenPath := masPole[EndCell.X, EndCell.Y];
n := LenPath;
// 路径结束单元格：
path[n] := EndCell;
// 我们从它移动到初始单元格：
repeat
// 查找具有数字n-1的相邻单元格：
p := path[n].X;
q := path[n].Y;
// 检查相邻的单元格：
for i := p - 1 to p + 1 do
for j := q - 1 to q + 1 do
// 找到了合适的单元格：
if ((i = p) or (j = q)) and TestCoord(i, j) then
begin
// 记录它的坐标：
path[n - 1] := Point(i, j);
break;
// 1116
end;
// 我们正在寻找具有上一个数字的单元格：
dec(n);
until n < 0;
// 在网格中显示路径：
for i := 1 to LenPath - 1 do
begin
ListBox1.Items.Add(inttostr(i) + ' ' + inttostr(path[i].X) + ' ' + inttostr(path[i].Y));
Rect := dgPole.CellRect(path[i].X, path[i].Y);
// 用红色突出显示：
dgPole.Canvas.Brush.Color := clRed;
dgPole.Canvas.FillRect(Rect);
with Rect, dgPole.Canvas do
begin
s := inttostr(i);
textrect(Rect, left + (right - left - textwidth(s)) div 2, top + (bottom - top - textheight(s)) div 2, s);
end;
end;
end;画迷宫
在这里需要实现DrawGrid的两个方法onDrawCell及onMouseDown
//画迷宫
procedure TForm1.dgPoleDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
s: string;
begin
// 用您的颜色绘制方框：
case masPole[ACol, ARow] of
GO:
dgPole.Canvas.Brush.Color := clWhite;
STOP:
dgPole.Canvas.Brush.Color := clBlack;
BEG_CELL:
dgPole.Canvas.Brush.Color := clYellow;
END_CELL:
dgPole.Canvas.Brush.Color := clBlue;
// 行程号：
else
begin
with Rect, dgPole.Canvas do
begin
Brush.Style := bsClear;
s := inttostr(masPole[ACol, ARow]);
textrect(Rect, left + (right - left - textwidth(s)) div 2,
top + (bottom - top - textheight(s)) div 2, s);
end;
end;
end;
dgPole.Canvas.FillRect(Rect);
end;
procedure TForm1.dgPoleMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
ACol, ARow: Integer;
begin
// 鼠标坐标：
dgPole.MouseToCell(X, Y, ACol, ARow);
// 如果按下鼠标左键，则标记初始单元格：
if ssLeft in Shift then
begin
// 可通行细胞：
if ssCtrl in Shift then
masPole[ACol, ARow] := GO
else if ssAlt in Shift then
masPole[ACol, ARow] := STOP
// 无法通过的细胞：
else
begin
BeginCell := Point(ACol, ARow);
masPole[ACol, ARow] := BEG_CELL
end
end
// 标记端点：
else
begin
EndCell := Point(ACol, ARow);
masPole[ACol, ARow] := END_CELL;
end;
dgPole.Invalidate
end;生成迷宫
// 生成迷宫
procedure TForm1.BtnCreateLabClick(Sender: TObject);
begin
//
Randomize;
CreateLab;
end;寻找路径
// 自动寻找迷宫路径
procedure TForm1.BtnFindPathClick(Sender: TObject);
begin
Self.ListBox1.Items.Add('begin=' + inttostr(BeginCell.X) + ' ' +
inttostr(BeginCell.Y));
Self.ListBox1.Items.Add('end=' + inttostr(EndCell.X) + ' ' +
inttostr(EndCell.Y));
if FindPath then
ShowPath
else
showmessage('无法找到路径')
end;迷宫难易度控制
procedure TForm1.sbDifChange(Sender: TObject);
begin
dif := sbDif.Position;
lblDif.Caption := inttostr(dif);
CreateLab;
end;窗口实始化
// 生成迷宫
procedure TForm1.BtnCreateLabClick(Sender: TObject);
begin
//
Randomize;
CreateLab;
end;
完整的源代码
如下：
unit UnitMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Grids,
Vcl.ComCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
BtnCreateLab: TButton;
lblDif: TLabel;
sbDif: TScrollBar;
BtnFindPath: TButton;
dgPole: TDrawGrid;
Label1: TLabel;
Label2: TLabel;
ListBox1: TListBox;
procedure BtnCreateLabClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure dgPoleMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure sbDifChange(Sender: TObject);
procedure BtnFindPathClick(Sender: TObject);
procedure dgPoleDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
procedure CreateLab;
function FindPath: boolean;
procedure ShowPath;
end;
const
GO = -1;
STOP = -2;
BEG_CELL = 0;
END_CELL = -3;
var
Form1: TForm1;
dif: Integer = 50;
masPole: array [0 .. 11, 0 .. 11] of Integer;
BeginCell, EndCell: TPoint;
implementation
{$R *.dfm}
// 显示路径
procedure TForm1.ShowPath;
var
n, LenPath: Integer;
i, j, p, q: Integer;
path: array [0 .. 144] of TPoint;
Rect: TRect;
s: string;
// 检查坐标：
function TestCoord(X, Y: Integer): boolean;
begin
Result := true;
if (X < 0) or (X > 11) or (Y < 0) or (Y > 11) or (masPole[X, Y] <> n - 1)
then
Result := false;
end;
begin
// 路径长度等于结束单元格中的数字：
LenPath := masPole[EndCell.X, EndCell.Y];
n := LenPath;
// 路径结束单元格：
path[n] := EndCell;
// 我们从它移动到初始单元格：
repeat
// 查找具有数字n-1的相邻单元格：
p := path[n].X;
q := path[n].Y;
// 检查相邻的单元格：
for i := p - 1 to p + 1 do
for j := q - 1 to q + 1 do
// 找到了合适的单元格：
if ((i = p) or (j = q)) and TestCoord(i, j) then
begin
// 记录它的坐标：
path[n - 1] := Point(i, j);
break;
// 1116
end;
// 我们正在寻找具有上一个数字的单元格：
dec(n);
until n < 0;
// 在网格中显示路径：
for i := 1 to LenPath - 1 do
begin
ListBox1.Items.Add(inttostr(i) + ' ' + inttostr(path[i].X) + ' ' + inttostr(path[i].Y));
Rect := dgPole.CellRect(path[i].X, path[i].Y);
// 用红色突出显示：
dgPole.Canvas.Brush.Color := clRed;
dgPole.Canvas.FillRect(Rect);
with Rect, dgPole.Canvas do
begin
s := inttostr(i);
textrect(Rect, left + (right - left - textwidth(s)) div 2, top + (bottom - top - textheight(s)) div 2, s);
end;
end;
end;
// 在两点之间寻找路径
function TForm1.FindPath: boolean;
var
// 坐标列表：
// 这里是定死了大小，扩展性不是太好，如果增加面积如果动态扩展
// 12*12=144 去掉一个起点143
// 坐标列表：
CoordList: array [1 .. 143] of TPoint;
// 列表中的索引：
ptrWrite, ptrRead: Integer;
p, q: Integer;
i, j: Integer;
// 检查坐标
function TestCoord(X, Y: Integer): boolean;
begin
Result := true;
if (X < 0) or (X > 11) or (Y < 0) or (Y > 11) or
((masPole[X, Y] <> GO) and (masPole[X, Y] <> END_CELL)) then
Result := false;
end;
begin
// 如果BeginCell=EndCell，则初始单元格与最终单元格相同， 你不需要找路！
// 将初始单元格的坐标添加到列表中：
CoordList[1] := BeginCell;
// устанавливаем указатель для считывания координат на начало списка:
// 我们设置一个指针来读取列表开头的坐标：
ptrRead := 1;
// 设置一个指针以将新坐标写入以下In-dex：
ptrWrite := 2;
// masPole数组中的初始单元格是BEG_CELL=0
// 我们从列表的开头移动到列表的末尾，直到列表结束：
while ptrRead < ptrWrite do
begin
// 当前单元格的坐标：
p := CoordList[ptrRead].X;
q := CoordList[ptrRead].Y;
// 检查相邻的单元格：
for i := p - 1 to p + 1 do
for j := q - 1 to q + 1 do
// 如果他们找到了隔壁可通过的笼子，
if ((i = p) or (j = q)) and TestCoord(i, j) then
begin
// 然后我们在其中写入一个比当前单元格中多1的数字：
masPole[i, j] := masPole[p, q] + 1;
// 如果到了最后一个单元格
if (i = EndCell.X) and (j = EndCell.Y) then
begin
// 然后找到了,返回true
Result := true;
exit;
end
else
begin
// 我们将相邻单元格的坐标写入列表末尾：
CoordList[ptrWrite] := Point(i, j);
// 移动指针：
inc(ptrWrite);
dgPole.Invalidate;
// showmessage(inttostr(masPole[i,j]) + ' x='+inttostr(i)+ ' y='+inttostr(j));
end;
end;
// 转到列表中的下一个单元格：
inc(ptrRead);
end;
// 找不到路径：返回false
Result := false;
end;
// 自动寻找迷宫路径
procedure TForm1.BtnFindPathClick(Sender: TObject);
begin
Self.ListBox1.Items.Add('begin=' + inttostr(BeginCell.X) + ' ' +
inttostr(BeginCell.Y));
Self.ListBox1.Items.Add('end=' + inttostr(EndCell.X) + ' ' +
inttostr(EndCell.Y));
if FindPath then
ShowPath
else
showmessage('无法找到路径')
end;
procedure TForm1.CreateLab;
var
i, j: Integer;
begin
for j := 0 to 11 do
for i := 0 to 11 do
BEGIN
masPole[i, j] := STOP;
if Random(101) >= dif then
// if Random(12) >= dif then
masPole[i, j] := GO
else
masPole[i, j] := STOP;
END;
dgPole.Invalidate;
end;
//画迷宫
procedure TForm1.dgPoleDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
s: string;
begin
// 用您的颜色绘制方框：
case masPole[ACol, ARow] of
GO:
dgPole.Canvas.Brush.Color := clWhite;
STOP:
dgPole.Canvas.Brush.Color := clBlack;
BEG_CELL:
dgPole.Canvas.Brush.Color := clYellow;
END_CELL:
dgPole.Canvas.Brush.Color := clBlue;
// 行程号：
else
begin
with Rect, dgPole.Canvas do
begin
Brush.Style := bsClear;
s := inttostr(masPole[ACol, ARow]);
textrect(Rect, left + (right - left - textwidth(s)) div 2,
top + (bottom - top - textheight(s)) div 2, s);
end;
end;
end;
dgPole.Canvas.FillRect(Rect);
end;
procedure TForm1.dgPoleMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
ACol, ARow: Integer;
begin
// 鼠标坐标：
dgPole.MouseToCell(X, Y, ACol, ARow);
// 如果按下鼠标左键，则标记初始单元格：
if ssLeft in Shift then
begin
// 可通行细胞：
if ssCtrl in Shift then
masPole[ACol, ARow] := GO
else if ssAlt in Shift then
masPole[ACol, ARow] := STOP
// 无法通过的细胞：
else
begin
BeginCell := Point(ACol, ARow);
masPole[ACol, ARow] := BEG_CELL
end
end
// 标记端点：
else
begin
EndCell := Point(ACol, ARow);
masPole[ACol, ARow] := END_CELL;
end;
dgPole.Invalidate
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
dif := 35;
sbDif.Position := dif;
lblDif.Caption := inttostr(dif);
Randomize;
CreateLab;
end;
procedure TForm1.sbDifChange(Sender: TObject);
begin
dif := sbDif.Position;
lblDif.Caption := inttostr(dif);
CreateLab;
end;
// 生成迷宫
procedure TForm1.BtnCreateLabClick(Sender: TObject);
begin
//
Randomize;
CreateLab;
end;
end.窗口文件
object Form1: TForm1
Left = 0
Top = 0
Caption = #36855#23467#33258#21160#23547#36335
ClientHeight = 653
ClientWidth = 576
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 548
Width = 576
Height = 105
Align = alBottom
TabOrder = 0
ExplicitTop = 554
ExplicitWidth = 748
object lblDif: TLabel
Left = 458
Top = 15
Width = 42
Height = 23
Caption = 'lblDif'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -19
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
object Label1: TLabel
Left = 16
Top = 55
Width = 58
Height = 13
Caption = '1.'#29983#25104#36855#23467
end
object Label2: TLabel
Left = 16
Top = 74
Width = 205
Height = 13
Caption = '2.'#29992#40736#26631#24038#38190#35774#32622' '#36215#28857#12289#21491#38190#35774#32622#32456#28857
end
object BtnCreateLab: TButton
Left = 2
Top = 6
Width = 81
Height = 41
Caption = #29983#25104#36855#23467
TabOrder = 0
OnClick = BtnCreateLabClick
end
object sbDif: TScrollBar
Left = 201
Top = 13
Width = 226
Height = 26
PageSize = 0
Position = 70
TabOrder = 1
OnChange = sbDifChange
end
object BtnFindPath: TButton
Left = 89
Top = 6
Width = 90
Height = 41
Caption = #23547#25214#36335#24452
TabOrder = 2
OnClick = BtnFindPathClick
end
end
object dgPole: TDrawGrid
Left = 0
Top = 0
Width = 576
Height = 548
Align = alClient
BevelKind = bkSoft
BevelOuter = bvRaised
BevelWidth = 3
BorderStyle = bsNone
Color = clCream
ColCount = 12
DefaultColWidth = 43
DefaultRowHeight = 43
DefaultDrawing = False
DoubleBuffered = False
FixedCols = 0
RowCount = 12
FixedRows = 0
Options = [goVertLine, goHorzLine, goRangeSelect]
ParentDoubleBuffered = False
ScrollBars = ssNone
TabOrder = 1
OnDrawCell = dgPoleDrawCell
OnMouseDown = dgPoleMouseDown
ExplicitWidth = 560
end
object ListBox1: TListBox
Left = 504
Top = 8
Width = 41
Height = 281
ItemHeight = 13
TabOrder = 2
Visible = False
end
end