1 unit R36;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, ExtCtrls, StdCtrls;
8
9 type
10 TRoom = record //房间记录类型
11 Used : Byte;
12 Xpos : Byte; //区块位置
13 Ypos : Byte;
14 Xsiz : Byte; //区块大小
15 Ysiz : Byte;
16 UX : Byte; //上侧出入口位置
17 UY : Byte;
18 DX : Byte; //下侧
19 DY : Byte;
20 LX : Byte; //左侧
21 LY : Byte;
22 RX : Byte; //右侧
23 RY : Byte;
24 end;
25
26
27 TRei36 = class(TForm)
28 Button1: TButton;
29 Timer1: TTimer;
30 Button2: TButton;
31 procedure FormCreate(Sender: TObject);
32 procedure Button1Click(Sender: TObject);
33 procedure FormClose(Sender: TObject; var Action: TCloseAction);
34 procedure Timer1Timer(Sender: TObject);
35 procedure Button2Click(Sender: TObject);
36 private
37 { Private declarations }
38 procedure MkRoom;
39 procedure MkMaze;
40 procedure Tline(a,b:Byte);
41 procedure Lway;
42 procedure Mway;
43 procedure Rway;
44 procedure DiMaze;
45 procedure LineRed;
46 public
47 { Public declarations }
48 end;
49 const
50 Mwidth = 50 * 10 + 20; //迷宫宽度
51 Mheight = 30 * 10 + 20; //迷宫高度
52 var
53 Rei36: TRei36;
54 MakeBmap,LineBmap : TBitmap;
55 RectD : TRect;
56 St,m,max : Byte;
57 StLine : Byte;
58
59 Mdata : array[0..49,0..29] of Byte; //迷宫数组50*30点
60 Box : array[0..14] of TRoom; //房间数组 15房间 ,记录数组类型
61
62 implementation
63
64 {$R *.dfm}
65
66 procedure TRei36.FormCreate(Sender: TObject);
67 begin
68 Rei36.Canvas.CopyMode := cmSrcCopy;
69 MakeBmap := TBitmap.Create;
70 MakeBmap.Width := Mwidth;
71 MakeBmap.Height := Mheight;
72
73 LineBmap := TBitmap.Create;
74 LineBmap.Width := Mwidth;
75 LineBmap.Height := Mheight;
76
77 St := 1; //初始迷宫制作指令
78 StLine := 0;
79 Randomize;
80
81 end;
82
83 procedure TRei36.MkRoom; //制作房间参数
84 var
85 n : byte;
86 begin
87 for n := 0 to 14 do
88 Box[n].Used := 0; //房间清零
89 max := 5 + Random(5); //最大5+5个房间？
90 m := 0;
91 repeat
92 n := Random(15);
93 if (Odd(n) = False) and (Box[n].Used = 0) then //保证偶数块有房间3个
94 begin
95 Box[n].Used := 1;
96 m := m + 1;
97 end;
98 until m = 4;
99
100 repeat //随机房间数量到MAX
101 n := Random(15);
102 if (n <> 7) and (Box[n].Used = 0) then
103 begin
104 Box[n].Used := 1;
105 m := m + 1;
106 end;
107 until m > max;
108
109 for n := 0 to 14 do
110 with Box[n] do
111 begin
112 if Used = 1 then
113 begin //设置房间大小，最小4+0+0=4，最大4+2+3=9
114 Xsiz := 4 + ((n + 1) mod 2) * 2 + Random(4); //这里为什么要引入n?
115 Ysiz := 4 + ((n + 1) mod 2) * 2 + Random(4); //实际是为了控制奇区4-7，偶区6-9
116 end
117 else begin //非房间大小
118 Xsiz := 4;
119 Ysiz := 4;
120 end;
121 //设置房间位置，注意非房间也有位置的。放中间
122 Xpos := (n mod 5) * 10 + (10 - Xsiz) div 2; //5列，取余得到X块
123 Ypos := (n div 5) * 10 + (10 - Ysiz) div 2; //取商得到Y块
124
125 if Used = 1 then
126 begin
127 UX := Xpos + 1 + Random(Xsiz - 2); //上出口
128 UY := Ypos;
129 DX := Xpos + 1 + Random(Xsiz - 2); //下出口
130 DY := Ypos + Ysiz - 1;
131 LX := Xpos; //左出口
132 LY := Ypos + 1 + Random(Ysiz - 2);
133 RX := Xpos + Xsiz - 1; //右出口
134 RY := Ypos + 1 + Random(Ysiz - 2);
135 end
136 else begin
137 UX := Xpos;
138 UY := Ypos;
139 DX := UX;
140 DY := UY;
141 LX := UX;
142 LY := UY;
143 RX := UX;
144 RY := UY;
145 end;
146 end;
147
148 for n := 0 to 3 do //左右间隙小于3则修改成直连 ？
149 if Box[n + 1].LX - Box[n].RX <= 3 then
150 begin
151 Box[n].RY := 4 + Random(2);
152 Box[n + 1].LY := Box[n].RY;
153 end;
154 for n:= 5 to 8 do
155 if Box[n + 1].LX - Box[n].RX <= 3 then
156 begin
157 Box[n].RY := 14 + Random(2);
158 Box[n + 1].LY := Box[n].RY;
159 end;
160
161 for n := 10 to 13 do
162 if Box[n + 1].LX - Box[n].RX <= 3 then
163 begin
164 Box[n].RY := 24 + Random(2);
165 Box[n + 1].LY := Box[n].RY;
166 end;
167
168 for n := 0 to 4 do //上下间隙间隙小于3则修改成直连
169 begin
170 if Box[n + 5].UY - Box[n].DY <= 3 then
171 begin
172 Box[n].DX := 4 + Random(2) + n * 10;
173 Box[n + 5].UX := Box[n].DX;
174 end;
175 if Box[n + 10].UY - Box[n + 5].DY <= 3 then
176 begin
177 Box[n + 5].DX := 4 + Random(2) + n * 10;
178 Box[n + 10].UX := Box[n].DX;
179 end;
180 end;
181
182 end;
183
184
185 procedure TRei36.MkMaze;
186 var
187 x,y,n : Byte;
188 begin
189 for x := 0 to 49 do
190 for y := 0 to 29 do
191 Mdata[x,y] := 1; //全设置为墙
192 for n := 0 to 14 do
193 if Box[n].Used = 1 then
194 for x := Box[n].LX to Box[n].RX do
195 for y := Box[n].UY to Box[n].DY do
196 Mdata[x,y] := 2; //设置为房间
197 Lway;
198 Mway;
199 Rway;
200
201 end;
202
203
204 procedure TRei36.Tline(a,b:Byte); //制作通道
205 var
206 nn,mx,my : Byte;
207 begin
208 if (b-a) = 1 then //房间相邻
209 begin //横向连接
210 mx := Box[b].LX - (Box[b].LX - Box[a].Xpos - Box[a].Xsiz + 2) div 2; //取得一个中间点
211 for nn := Box[a].RX to mx do
212 Mdata[nn,Box[a].RY] := Mdata[nn,Box[a].RY] and 2; //通道穿过房间还是10B,穿过墙则是00B
213 for nn := mx to Box[b].LX do
214 Mdata[nn,Box[b].LY] := Mdata[nn,Box[b].LY] and 2;
215
216 if Box[a].RY > Box[b].LY then //从中间点开始连接
217 for nn := Box[b].LY to Box[a].RY do
218 Mdata[mx,nn] := Mdata[mx,nn] and 2
219 else if Box[a].RY < Box[b].LY then //这里为什么要重复判断？
220 for nn := Box[a].RY to Box[b].LY do
221 Mdata[mx,nn] := Mdata[mx,nn] and 2;
222 end
223 else begin //不相邻则纵向连接？
224 my := Box[b].UY - (Box[b].UY - Box[a].Ypos- Box[a].Ysiz + 2) div 2;
225 for nn := Box[a].DY to my do
226 Mdata[Box[a].DX,nn] := Mdata[Box[a].DX,nn] and 2;
227 for nn := my to Box[b].UY do
228 Mdata[Box[b].UX,nn] := Mdata[Box[b].UX,nn] and 2;
229 if Box[a].DX > Box[b].UX then
230 for nn := Box[b].UX to Box[a].DX do
231 Mdata[nn,my] := Mdata[nn,my] and 2
232 else if Box[a].DX < Box[b].UX then
233 for nn := Box[a].DX to Box[b].UX do
234 Mdata[nn,my] := Mdata[nn,my] and 2;
235 end;
236
237 end;
238
239
240 procedure TRei36.Lway; //0 1 5 6 10 11 左侧房间连接规则
241 begin
242 if Random(2) = 0 then
243 begin
244 Tline(0,1);
245 Tline(0,5);
246 Tline(1,6);
247 if (Box[5].Used and Box[6].Used = 0) or (Random(2) = 0) then
248 Tline(5,6);
249 if Box[10].Used = 1 then
250 begin
251 Tline(5,10);
252 if Random(2) = 0 then
253 Tline(10,11)
254 else
255 Tline(6,11);
256
257 end
258 else if Random(2) =0 then
259 begin
260 Tline(5,10);
261 Tline(10,11);
262 end
263 else
264 Tline(6,11);
265
266 end
267 else begin
268 Tline(10,11);
269 Tline(5,10);
270 Tline(6,11);
271 if (Box[5].Used and Box[6].Used = 0) or (Random(2) = 0) then
272 Tline(5,6);
273 if Box[0].Used = 1 then
274 begin
275 Tline(0,5);
276 if Random(2) = 0 then
277 Tline(0,1)
278 else
279 Tline(1,6);
280 end
281 else if Random(2) = 0 then
282 begin
283 Tline(0,5);
284 Tline(0,1);
285
286 end
287 else
288 Tline(1,6);
289 end;
290 end;
291
292
293 procedure TRei36.Mway; //1 2 3 11 12 13 的中侧房间连接规则
294 begin
295 case Random(4) of
296 0: begin
297 Tline(1,2);
298 Tline(2,3);
299 Tline(11,12);
300 if Random(2) = 0 then
301 Tline(12,13);
302 end;
303 1: begin
304 Tline(1,2);
305 Tline(2,3);
306 Tline(12,13);
307 if Random(2) = 0 then
308 Tline(11,12);
309 end;
310 2: begin
311 Tline(11,12);
312 Tline(12,13);
313 Tline(1,2);
314 if Random(2) = 0 then
315 Tline(2,3);
316 end;
317 3: begin
318 Tline(11,12);
319 Tline(12,13);
320 Tline(2,3);
321 if Random(2) = 0 then
322 Tline(1,2);
323 end;
324 end;
325 end;
326
327
328 procedure TRei36.Rway; // 3 4 8 9 13 14 右侧房间连接规则
329 begin
330 if Random(2) = 0 then // 随机
331 begin
332 Tline(3,4); //将3，4 3，8 4，9 房间连接起来
333 Tline(3,8);
334 Tline(4,9);
335 if (Box[8].Used and Box[9].Used = 0) or (Random(2) = 0) then
336 Tline(8,9); //当8与9的其中之一不是房间时，以随机数将8，9连接起来
337 if Box[14].Used = 1 then //若14是房间
338 begin
339 Tline(9,14); //连接9，14
340 if Random(2) = 0 then //再将13,14 或 8，13连接
341 Tline(13,14)
342 else
343 Tline(8,13);
344 end
345 else if Random(2) = 0 then //14不是房间
346 begin // 连接9，14 13 14 或 8,13
347 Tline(9,14);
348 Tline(13,14);
349 end
350 else
351 Tline(8,13);
352 end
353 else begin //随机另一规则
354 Tline(13,14);
355 Tline(8,13);
356 Tline(9,14);
357 if (Box[8].Used and Box[9].Used = 0) or (Random(2) = 0) then
358 Tline(8,9);
359 if Box[4].Used = 1 then
360 begin
361 Tline(4,9);
362 if Random(2) = 0 then
363 Tline(3,4)
364 else
365 Tline(3,8);
366 end
367 else if Random(2) = 0 then
368 begin
369 Tline(3,4);
370 Tline(4,9);
371 end
372 else
373 Tline(3,8);
374 end;
375
376 end;
377 procedure TRei36.DiMaze; //在制作画板上以10*10 的块显示Mdata数组
378 var
379 x,y : Byte;
380 begin
381 for x := 0 to 49 do
382 for y := 0 to 29 do
383 begin
384 case Mdata[x,y] of
385 0: MakeBmap.Canvas.Brush.Color := clBlack;
386 1: MakeBmap.Canvas.Brush.Color := clOlive;
387 2: MakeBmap.Canvas.Brush.Color := clNavy;
388 end;
389 RectD := Rect(x * 10 + 10,y * 10 + 10,x * 10 + 20,y * 10 + 20);
390 // RectD := Rect(x + 10,y + 10,x + 10 + 1,y + 10 + 1); //缩小比例
391 MakeBmap.Canvas.FillRect(RectD);
392 end;
393 end;
394
395 procedure TRei36.Button1Click(Sender: TObject);
396 begin
397 St := 2;
398 end;
399
400 procedure TRei36.FormClose(Sender: TObject; var Action: TCloseAction);
401 begin
402 MakeBmap.Free;
403 LineBmap.Free;
404 end;
405
406 procedure TRei36.Timer1Timer(Sender: TObject);
407 begin
408 case St of
409 1: begin //绘制外框
410 RectD := Rect(0,0,Mwidth,Mheight);
411 MakeBmap.Canvas.Brush.Color := clOlive;
412 MakeBmap.Canvas.FillRect(RectD);
413 RectD := Rect(10,10,Mwidth - 20,Mheight - 20);
414 MakeBmap.Canvas.Brush.Color := clBlack;
415 MakeBmap.Canvas.FillRect(RectD);
416 Rei36.Canvas.Draw(0,0,MakeBmap);
417 St := 2;
418 end;
419 2: begin //制作新的迷宫显示出来，按钮控制
420 MkRoom; //制作房间参数
421 MkMaze;
422 DiMaze;
423 LineBmap.canvas.Draw(0,0,MakeBmap);
424 LineRed;
425
426 St := 3;
427 end;
428 3:begin
429 if StLine = 0 then
430 Rei36.Canvas.Draw(0,0,MakeBmap)
431 else
432 Rei36.Canvas.Draw(0,0,LineBmap);
433
434 end;
435
436
437 end;
438 end;
439
440 procedure TRei36.LineRed;
441 var
442 x,y : Byte;
443 begin
444 LineBmap.Canvas.Pen.Width := 1;
445 LineBmap.Canvas.Pen.Color := clRed;
446 for y := 0 to 3 do
447 begin
448 LineBmap.Canvas.MoveTo(10,y * 100 + 10);
449 LineBmap.Canvas.LineTo(Mwidth -10,y * 100 + 10);
450
451 end;
452 for x := 0 to 5 do
453 begin
454 LineBmap.Canvas.MoveTo(x * 100 + 10,10);
455 LineBmap.Canvas.LineTo(x * 100 + 10,Mheight - 10);
456 end;
457
458
459 end;
460 procedure TRei36.Button2Click(Sender: TObject);
461 begin
462 StLine := StLine xor 1;
463 end;
464
465 end.
增加了一个画板，用来存放画了线的图片
通过按钮 ，增加一个状态，来显示 有线格和无线格的图片
标签：Box,10,begin,end,Delphi,Random,36,40,Tline From： https://www.cnblogs.com/D7mir/p/16864264.html