Develop and Download Open Source Software

soi-man

Browse Subversion Repository

/[soi-man]/Unit1.pas

Contents of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log

Revision 3 - (show annotations) (download) (as text)
Tue Oct 6 00:25:26 2015 UTC (8 years, 6 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 10430 byte(s) 
マップを書き足しました

overloadが使えてなかった問題を修正

Timerイベントを読みやすく中身を分けて書きました、変わっていませんけど
1 unit Unit1;
2
3 interface
4
5 uses
6 System.SysUtils, System.Types, System.UITypes, System.Classes,
7 System.Variants,
8 FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects;
9
10 type
11 TDir = (Left, Right, Up, Down, Stop);
12
13 TChar = class(TObject)
14 public
15 Index: integer;
16 Dir: TDir;
17 X, Y: integer;
18 AX, AY: integer;
19 procedure Walk(var p, q: integer); virtual;
20 procedure Wall; virtual;
21 procedure Clear; virtual;
22 end;
23
24 TEnemy = class(TChar)
25 public
26 Count: integer;
27 Max: integer;
28 Visible: Boolean;
29 constructor Create;
30 procedure Walk(var p, q: integer); override;
31 procedure Wall; overload; override;
32 procedure Clear; override;
33 procedure RunAway(out p, q: integer);
34 end;
35
36 TWorry = class(TEnemy)
37 public
38 constructor Create;
39 end;
40
41 TGhost = class(TEnemy)
42 public
43 constructor Create;
44 procedure Wall(p, q: integer); overload;
45 end;
46
47 TMap = class(TObject)
48 const
49 Wid = 20;
50 Hei = 20;
51 Size = 32;
52 private
53 FStrings: array [0 .. Wid - 1, 0 .. Hei - 1] of integer;
54 function GetStrings(X, Y: integer): integer;
55 procedure SetStrings(X, Y: integer; const Value: integer);
56 public
57 procedure Clear;
58 property Strings[X, Y: integer]: integer read GetStrings
59 write SetStrings; default;
60 end;
61
62 TForm1 = class(TForm)
63 Image1: TImage;
64 Timer1: TTimer;
65 procedure FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
66 procedure FormCreate(Sender: TObject);
67 procedure FormDestroy(Sender: TObject);
68 procedure Timer1Timer(Sender: TObject);
69 procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
70 Shift: TShiftState);
71 private
72 FAction: Boolean;
73 procedure SetAction(const Value: Boolean);
74 { private ���� }
75 public
76 { public ���� }
77 Map: TMap;
78 Char: TChar;
79 List: TList;
80 Count: integer;
81 procedure Start;
82 procedure GameOver;
83 procedure GameClear;
84 property Action: Boolean read FAction write SetAction;
85 end;
86
87 var
88 Form1: TForm1;
89
90 implementation
91
92 {$R *.fmx}
93 { TMap }
94
95 procedure TMap.Clear;
96 type
97 TLocal = array [0 .. Wid - 1] of integer;
98 procedure setint(Index: integer; arr: array of integer);
99 var
100 k: integer;
101 begin
102 for k := 0 to Wid - 1 do
103 FStrings[k, index] := arr[k];
104 end;
105
106 begin
107 setint(0, [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
108 setint(1, [1, 9, 0, 3, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 4, 0, 0, 0, 0, 1]);
109 setint(2, [1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1]);
110 setint(3, [1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0, 1, 1, 0, 1]);
111 setint(4, [1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 1, 0, 0, 1]);
112 setint(5, [1, 0, 1, 1, 1, 0, 1, 1, 0, 1, 9, 1, 1, 0, 1, 0, 0, 0, 1, 1]);
113 setint(6, [1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 0, 1, 1]);
114 setint(7, [1, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1]);
115 setint(8, [1, 0, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1]);
116 setint(9, [1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1]);
117 setint(10, [1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1]);
118 setint(11, [1, 0, 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1]);
119 setint(12, [1, 0, 0, 0, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1]);
120 setint(13, [1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1]);
121 setint(14, [1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 1, 1]);
122 setint(15, [1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1]);
123 setint(16, [1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1]);
124 setint(17, [1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 1]);
125 setint(18, [1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1]);
126 setint(19, [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
127 end;
128
129 function TMap.GetStrings(X, Y: integer): integer;
130 begin
131 result := FStrings[X, Y];
132 end;
133
134 procedure TMap.SetStrings(X, Y: integer; const Value: integer);
135 begin
136 FStrings[X, Y] := Value;
137 end;
138
139 procedure TForm1.FormCreate(Sender: TObject);
140 var
141 i, j, k: integer;
142 s: TChar;
143 begin
144 Map := TMap.Create;
145 Map.Clear;
146 ClientWidth := Map.Size * Map.Wid;
147 ClientHeight := Map.Size * Map.Hei;
148 List := TList.Create;
149 Char := TChar.Create;
150 List.Add(Char);
151 List.Add(TWorry.Create);
152 List.Add(TGhost.Create);
153 for i := 0 to Map.Wid - 1 do
154 for j := 0 to Map.Hei - 1 do
155 begin
156 k := Map[i, j];
157 if k in [2 .. 4] then
158 begin
159 s := List[k - 2];
160 s.AX := i;
161 s.AY := j;
162 end;
163 end;
164 Start;
165 end;
166
167 procedure TForm1.FormDestroy(Sender: TObject);
168 var
169 i: integer;
170 s: TChar;
171 begin
172 Map.Free;
173 for i := 0 to List.Count - 1 do
174 begin
175 s := List[i];
176 s.Free;
177 end;
178 List.Free;
179 end;
180
181 procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
182 Shift: TShiftState);
183 begin
184 case Key of
185 vkLeft:
186 Char.Dir := TDir.Left;
187 vkRight:
188 Char.Dir := Right;
189 vkUp:
190 Char.Dir := Up;
191 vkDown:
192 Char.Dir := Down;
193 vkEscape:
194 Start;
195 end;
196 end;
197
198 procedure TForm1.FormPaint(Sender: TObject; Canvas: TCanvas;
199 const ARect: TRectF);
200 var
201 i: integer;
202 j: integer;
203 s: TChar;
204 procedure detail(X, Y: integer; z: Extended);
205 begin
206 Canvas.DrawBitmap(Image1.Bitmap, RectF(X * Map.Size, Y * Map.Size,
207 (X + 1) * Map.Size, (Y + 1) * Map.Size), RectF(i * Map.Size, j * Map.Size,
208 (i + 1) * Map.Size, (j + 1) * Map.Size), z);
209 end;
210 procedure enemy(X, Y: integer);
211 begin
212 Canvas.FillRect(RectF(X * Map.Size, Y * Map.Size, (X + 1) * Map.Size,
213 (Y + 1) * Map.Size), 0, 0, [], 1);
214 end;
215
216 begin
217 for i := 0 to Map.Wid - 1 do
218 for j := 0 to Map.Hei - 1 do
219 case Map[i, j] of
220 0:
221 detail(0, 0, 1);
222 1:
223 detail(2, 1, 0.5);
224 10:
225 detail(2, 1, 1);
226 end;
227 i := Char.X;
228 j := Char.Y;
229 case Char.Dir of
230 TDir.Left, Stop:
231 detail(0, 1, 1);
232 Right:
233 detail(1, 0, 1);
234 Up:
235 detail(1, 1, 1);
236 Down:
237 detail(2, 0, 1);
238 end;
239 for i := 1 to 2 do
240 begin
241 s := List[i];
242 if (s as TEnemy).Visible = true then
243 enemy(s.X, s.Y);
244 end;
245 end;
246
247 procedure TForm1.GameClear;
248 var
249 i: integer;
250 j: integer;
251 begin
252 for i := 0 to Map.Wid - 1 do
253 for j := 0 to Map.Hei - 1 do
254 if Map[i, j] = 0 then
255 Exit;
256 Start;
257 end;
258
259 procedure TForm1.GameOver;
260 var
261 i: integer;
262 s: TChar;
263 begin
264 for i := 1 to 2 do
265 begin
266 s := List[i];
267 if (Char.X = s.X) and (Char.Y = s.Y) then
268 if Action = true then
269 with s as TEnemy do
270 begin
271 Visible := false;
272 Count:=20;
273 end
274 else
275 begin
276 Start;
277 break;
278 end;
279 end;
280 end;
281
282 procedure TForm1.SetAction(const Value: Boolean);
283 begin
284 if Value = true then
285 begin
286 Count := 100;
287 Canvas.Fill.Color := TAlphaColors.Blue;
288 end
289 else
290 Canvas.Fill.Color := TAlphaColors.Purple;
291 FAction := Value;
292 end;
293
294 procedure TForm1.Start;
295 var
296 i: integer;
297 s: TChar;
298 begin
299 Action := false;
300 Map.Clear;
301 for i := 0 to List.Count - 1 do
302 begin
303 s := List[i];
304 s.Clear;
305 if s = Char then
306 Map[s.X, s.Y] := 10
307 else
308 Map[s.X, s.Y] := 0;
309 end;
310 end;
311
312 procedure TForm1.Timer1Timer(Sender: TObject);
313 var
314 i, p, q: integer;
315 s: TChar;
316 begin
317 Char.Walk(p, q);
318 if Map[p,q] in [0, 9, 10] then
319 begin
320 Char.X := p;
321 Char.Y := q;
322 if Map[p, q] = 9 then
323 Action := true;
324 Map[p, q] := 10;
325 GameOver;
326 end
327 else
328 Char.Wall;
329 for i := 0 to List.Count - 1 do
330 begin
331 s := List[i];
332 if s = Char then
333 continue;
334 if (s as TEnemy).Visible = true then
335 begin
336 if Action = false then
337 begin
338 p := Char.X;
339 q := Char.Y;
340 (s as TEnemy).RunAway(p, q);
341 end;
342 s.Walk(p, q);
343 if Map[p, q] <> 1 then
344 begin
345 s.X := p;
346 s.Y := q;
347 end
348 else
349 s.Wall;
350 end
351 else
352 with s as TEnemy do
353 if Count = 0 then
354 Clear
355 else
356 dec(Count);
357 end;
358 if Action = true then
359 begin
360 if Count = 0 then
361 Action := false;
362 dec(Count);
363 end;
364 GameOver;
365 PaintTo(Canvas);
366 GameClear;
367 end;
368
369 { TChar }
370
371 procedure TChar.Clear;
372 begin
373 X := AX;
374 Y := AY;
375 Dir := Stop;
376 end;
377
378 procedure TChar.Walk(var p, q: integer);
379 begin
380 p := X;
381 q := Y;
382 case Dir of
383 TDir.Left:
384 p := X - 1;
385 Right:
386 p := X + 1;
387 Up:
388 q := Y - 1;
389 Down:
390 q := Y + 1;
391 end;
392 end;
393
394 procedure TChar.Wall;
395 begin
396 case Dir of
397 TDir.Left:
398 Dir := Right;
399 Right:
400 Dir := TDir.Left;
401 Up:
402 Dir := Down;
403 Down:
404 Dir := Up;
405 end;
406 end;
407
408 { TEnemy }
409
410 procedure TEnemy.Clear;
411 begin
412 inherited;
413 Visible := true;
414 Wall;
415 end;
416
417 constructor TEnemy.Create;
418 begin
419 inherited;
420 Randomize;
421 Count := Random(5);
422 Visible := true;
423 end;
424
425 procedure TEnemy.RunAway(out p, q: integer);
426 begin
427 Randomize;
428 case Random(2) of
429 0:
430 if p < X then
431 p := X - 1
432 else if p > X then
433 p := X + 1;
434 1:
435 if q < Y then
436 q := Y - 1
437 else
438 q := Y + 1;
439 end;
440 end;
441
442 procedure TEnemy.Walk(var p, q: integer);
443 begin
444 inherited;
445 dec(Count);
446 if Count = 0 then
447 begin
448 Wall;
449 Count := Max;
450 end;
451 end;
452
453 procedure TEnemy.Wall;
454 begin
455 Count := Max;
456 Randomize;
457 case Random(4) of
458 0:
459 Dir := TDir.Left;
460 1:
461 Dir := Right;
462 2:
463 Dir := Up;
464 3:
465 Dir := Down;
466 end;
467 end;
468
469 { TWorry }
470
471 constructor TWorry.Create;
472 begin
473 Max := 5;
474 end;
475
476 { TGhost }
477
478 constructor TGhost.Create;
479 begin
480 Max := 3;
481 end;
482
483 procedure TGhost.Wall(p, q: integer);
484 begin
485 inherited Wall;
486 Randomize;
487 case Random(2) of
488 0:
489 if p > X then
490 Dir := Right
491 else if p < X then
492 Dir := TDir.Left;
493 1:
494 if q > Y then
495 Dir := Down
496 else if q < Y then
497 Dir := Up;
498 end;
499 end;
500
501 end.
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help