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 5 - (show annotations) (download) (as text)
Wed Oct 7 13:11:07 2015 UTC (8 years, 6 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 10421 byte(s) 
TEnemyにキャストしてはいけないところを訂正

奇妙になりましたがRunaway関数をTEnemy.Wallに入れて実行されるように修正
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; 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; override;
31 procedure Clear; override;
32 procedure Wall; override;
33 end;
34
35 TWorry = class(TEnemy)
36 public
37 constructor Create;
38 procedure Wall; override;
39 end;
40
41 TGhost = class(TEnemy)
42 public
43 constructor Create;
44 procedure Wall; override;
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 List: TList;
78 Count: integer;
79 procedure Start;
80 procedure GameOver;
81 procedure GameClear;
82 property Action: Boolean read FAction write SetAction;
83 end;
84
85 var
86 Form1: TForm1;
87 Map1: TMap;
88 Char1: TChar;
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 Map1 := TMap.Create;
145 Map1.Clear;
146 ClientWidth := Map1.Size * Map1.Wid;
147 ClientHeight := Map1.Size * Map1.Hei;
148 List := TList.Create;
149 Char1 := TChar.Create;
150 List.Add(TWorry.Create);
151 List.Add(TGhost.Create);
152 for i := 0 to Map1.Wid - 1 do
153 for j := 0 to Map1.Hei - 1 do
154 begin
155 k := Map1[i, j];
156 if k in [3, 4] then
157 begin
158 s := List[k - 3];
159 s.AX := i;
160 s.AY := j;
161 end;
162 if k = 2 then
163 begin
164 Char1.AX := i;
165 Char1.AY := j;
166 end;
167 end;
168 Start;
169 end;
170
171 procedure TForm1.FormDestroy(Sender: TObject);
172 var
173 i: integer;
174 s: TChar;
175 begin
176 Char1.Free;
177 Map1.Free;
178 for i := 0 to List.Count - 1 do
179 begin
180 s := List[i];
181 s.Free;
182 end;
183 List.Free;
184 end;
185
186 procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
187 Shift: TShiftState);
188 begin
189 case Key of
190 vkLeft:
191 Char1.Dir := TDir.Left;
192 vkRight:
193 Char1.Dir := Right;
194 vkUp:
195 Char1.Dir := Up;
196 vkDown:
197 Char1.Dir := Down;
198 vkEscape:
199 Start;
200 end;
201 end;
202
203 procedure TForm1.FormPaint(Sender: TObject; Canvas: TCanvas;
204 const ARect: TRectF);
205 var
206 i: integer;
207 j: integer;
208 s: TEnemy;
209 procedure detail(X, Y: integer; z: Extended);
210 begin
211 Canvas.DrawBitMap(Image1.BitMap, RectF(X * Map1.Size, Y * Map1.Size,
212 (X + 1) * Map1.Size, (Y + 1) * Map1.Size),
213 RectF(i * Map1.Size, j * Map1.Size, (i + 1) * Map1.Size,
214 (j + 1) * Map1.Size), z);
215 end;
216 procedure enemy(X, Y: integer);
217 begin
218 Canvas.FillRect(RectF(X * Map1.Size, Y * Map1.Size, (X + 1) * Map1.Size,
219 (Y + 1) * Map1.Size), 0, 0, [], 1);
220 end;
221
222 begin
223 for i := 0 to Map1.Wid - 1 do
224 for j := 0 to Map1.Hei - 1 do
225 case Map1[i, j] of
226 0:
227 detail(0, 0, 1);
228 1:
229 detail(2, 1, 0.5);
230 10:
231 detail(2, 1, 1);
232 end;
233 i := Char1.X;
234 j := Char1.Y;
235 case Char1.Dir of
236 TDir.Left, Stop:
237 detail(0, 1, 1);
238 Right:
239 detail(1, 0, 1);
240 Up:
241 detail(1, 1, 1);
242 Down:
243 detail(2, 0, 1);
244 end;
245 for i := 0 to List.Count - 1 do
246 begin
247 s := List[i];
248 if s.Visible = true then
249 enemy(s.X, s.Y);
250 end;
251 end;
252
253 procedure TForm1.GameClear;
254 var
255 i: integer;
256 j: integer;
257 begin
258 for i := 0 to Map1.Wid - 1 do
259 for j := 0 to Map1.Hei - 1 do
260 if Map1[i, j] = 0 then
261 Exit;
262 Start;
263 end;
264
265 procedure TForm1.GameOver;
266 var
267 i: integer;
268 s: TEnemy;
269 begin
270 for i := 0 to List.Count - 1 do
271 begin
272 s := List[i];
273 if (Char1.X = s.X) and (Char1.Y = s.Y) then
274 if Action = true then
275 begin
276 s.Visible := false;
277 s.Count := 20;
278 end
279 else
280 begin
281 Start;
282 break;
283 end;
284 end;
285 end;
286
287 procedure TForm1.SetAction(const Value: Boolean);
288 begin
289 if Value = true then
290 begin
291 Count := 100;
292 Canvas.Fill.Color := TAlphaColors.Blue;
293 end
294 else
295 Canvas.Fill.Color := TAlphaColors.Purple;
296 FAction := Value;
297 end;
298
299 procedure TForm1.Start;
300 var
301 i: integer;
302 s: TEnemy;
303 begin
304 Action := false;
305 Map1.Clear;
306 for i := 0 to List.Count - 1 do
307 begin
308 s := List[i];
309 s.Clear;
310 Map1[s.X, s.Y] := 0;
311 end;
312 Char1.Clear;
313 Map1[Char1.X, Char1.Y] := 10;
314 end;
315
316 procedure TForm1.Timer1Timer(Sender: TObject);
317 var
318 i, p, q: integer;
319 s: TEnemy;
320 begin
321 Char1.Walk;
322 p := Char1.X;
323 q := Char1.Y;
324 if Map1[p, q] = 9 then
325 Action := true;
326 Map1[p, q] := 10;
327 GameOver;
328 for i := 0 to List.Count - 1 do
329 begin
330 s := List[i];
331 if s.Visible = true then
332 s.Walk
333 else if s.Count = 0 then
334 s.Clear
335 else
336 dec(s.Count);
337 end;
338 if Action = true then
339 begin
340 if Count = 0 then
341 Action := false;
342 dec(Count);
343 end;
344 GameOver;
345 PaintTo(Canvas);
346 GameClear;
347 end;
348
349 { TChar }
350
351 procedure TChar.Clear;
352 begin
353 X := AX;
354 Y := AY;
355 Dir := Stop;
356 end;
357
358 procedure TChar.Walk;
359 var
360 p, q: integer;
361 begin
362 p := X;
363 q := Y;
364 case Dir of
365 TDir.Left:
366 p := X - 1;
367 Right:
368 p := X + 1;
369 Up:
370 q := Y - 1;
371 Down:
372 q := Y + 1;
373 end;
374 if Map1[p, q] <> 1 then
375 begin
376 X := p;
377 Y := q;
378 end
379 else
380 Wall;
381 end;
382
383 procedure TChar.Wall;
384 begin
385 case Dir of
386 TDir.Left:
387 Dir := Right;
388 Right:
389 Dir := TDir.Left;
390 Up:
391 Dir := Down;
392 Down:
393 Dir := Up;
394 end;
395 end;
396
397 { TEnemy }
398
399 procedure TEnemy.Clear;
400 begin
401 inherited;
402 Visible := true;
403 Wall;
404 end;
405
406 constructor TEnemy.Create;
407 begin
408 inherited;
409 Randomize;
410 Count := Random(5);
411 Visible := true;
412 end;
413
414 procedure TEnemy.Walk;
415 begin
416 inherited;
417 dec(Count);
418 if Count = 0 then
419 Wall;
420 end;
421
422 procedure TEnemy.Wall;
423 var
424 p, q: integer;
425 begin
426 p := Char1.X;
427 q := Char1.Y;
428 Randomize;
429 case Random(2) of
430 0:
431 if (p <= X) and (Map1[X + 1, Y] <> 1) then
432 Dir := Right
433 else
434 Dir := TDir.Left;
435 1:
436 if (q <= Y) and (Map1[X, Y + 1] <> 1) then
437 Dir := Down
438 else
439 Dir := Up;
440 end;
441 Count := Max;
442 end;
443
444 { TWorry }
445
446 constructor TWorry.Create;
447 begin
448 Max := 5;
449 end;
450
451 procedure TWorry.Wall;
452 begin
453 if Form1.Action = true then
454 begin
455 inherited;
456 Exit;
457 end;
458 Randomize;
459 case Random(4) of
460 0:
461 Dir := TDir.Left;
462 1:
463 Dir := Right;
464 2:
465 Dir := Up;
466 3:
467 Dir := Down;
468 end;
469 Count := Max;
470 end;
471
472 { TGhost }
473
474 constructor TGhost.Create;
475 begin
476 Max := 3;
477 end;
478
479 procedure TGhost.Wall;
480 var
481 p, q: integer;
482 begin
483 if Form1.Action = true then
484 begin
485 inherited;
486 Exit;
487 end;
488 p := Char1.X;
489 q := Char1.Y;
490 if p > X then
491 begin
492 if Map1[p + 1, q] <> 1 then
493 Dir := Right
494 else if q > Y then
495 Dir := Down
496 else if q < Y then
497 Dir := Up;
498 end
499 else if p < X then
500 if Map1[p - 1, q] <> 1 then
501 Dir := TDir.Left
502 else if q > Y then
503 Dir := Down
504 else if q < Y then
505 Dir := Up;
506 Count := Max;
507 end;
508
509 end.
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help