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 2 - (show annotations) (download) (as text)
Mon Oct 5 22:59:32 2015 UTC (8 years, 6 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 10382 byte(s) 
敵を食べられるようになりました

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; 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, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1]);
117 setint(10, [1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1]);
118 setint(11, [1, 0, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1]);
119 setint(12, [1, 0, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
120 setint(13, [1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
121 setint(14, [1, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
122 setint(15, [1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
123 setint(16, [1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 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 (s as TEnemy).Visible := false
270 else
271 begin
272 Start;
273 break;
274 end;
275 end;
276 end;
277
278 procedure TForm1.SetAction(const Value: Boolean);
279 begin
280 if Value = true then
281 begin
282 Count := 100;
283 Canvas.Fill.Color := TAlphaColors.Blue;
284 end
285 else
286 Canvas.Fill.Color := TAlphaColors.Purple;
287 FAction := Value;
288 end;
289
290 procedure TForm1.Start;
291 var
292 i: integer;
293 s: TChar;
294 begin
295 Action := false;
296 Map.Clear;
297 for i := 0 to List.Count - 1 do
298 begin
299 s := List[i];
300 s.Clear;
301 if s = Char then
302 Map[s.X, s.Y] := 10
303 else
304 Map[s.X, s.Y] := 0;
305 end;
306 end;
307
308 procedure TForm1.Timer1Timer(Sender: TObject);
309 var
310 i, p, q: integer;
311 s: TChar;
312 begin
313 for i := 0 to List.Count-1 do
314 begin
315 s := List[i];
316 if (s = Char) or ((s as TEnemy).Visible = true) then
317 begin
318 if s = Char then
319 s.Walk(p, q)
320 else
321 begin
322 if Action = false then
323 begin
324 p := Char.X;
325 q := Char.Y;
326 (s as TEnemy).RunAway(p, q);
327 end;
328 s.Walk(p, q);
329 end;
330 if Map[p, q] in [0, 9, 10] then
331 begin
332 s.X := p;
333 s.Y := q;
334 if s = Char then
335 begin
336 if Map[p, q] = 9 then
337 Action := true;
338 Map[p, q] := 10;
339 GameOver;
340 end;
341 end
342 else
343 s.Wall;
344 end
345 else
346 with s as TEnemy do
347 if Count = 0 then
348 Clear
349 else
350 dec(Count);
351 end;
352 if Action = true then
353 begin
354 if Count = 0 then
355 Action := false;
356 dec(Count);
357 end;
358 GameOver;
359 PaintTo(Canvas);
360 GameClear;
361 end;
362
363 { TChar }
364
365 procedure TChar.Clear;
366 begin
367 X := AX;
368 Y := AY;
369 Dir := Stop;
370 end;
371
372 procedure TChar.Walk(var p, q: integer);
373 begin
374 p := X;
375 q := Y;
376 case Dir of
377 TDir.Left:
378 p := X - 1;
379 Right:
380 p := X + 1;
381 Up:
382 q := Y - 1;
383 Down:
384 q := Y + 1;
385 end;
386 end;
387
388 procedure TChar.Wall;
389 begin
390 case Dir of
391 TDir.Left:
392 Dir := Right;
393 Right:
394 Dir := TDir.Left;
395 Up:
396 Dir := Down;
397 Down:
398 Dir := Up;
399 end;
400 end;
401
402 { TEnemy }
403
404 procedure TEnemy.Clear;
405 begin
406 inherited;
407 Visible := true;
408 Wall;
409 end;
410
411 constructor TEnemy.Create;
412 begin
413 inherited;
414 Randomize;
415 Count := Random(5);
416 Visible := true;
417 end;
418
419 procedure TEnemy.RunAway(out p, q: integer);
420 begin
421 Randomize;
422 case Random(2) of
423 0:
424 if p < X then
425 p := X - 1
426 else if p > X then
427 p := X + 1;
428 1:
429 if q < Y then
430 q := Y - 1
431 else
432 q := Y + 1;
433 end;
434 end;
435
436 procedure TEnemy.Walk(var p, q: integer);
437 begin
438 inherited;
439 dec(Count);
440 if Count = 0 then
441 begin
442 Wall;
443 Count := Max;
444 end;
445 end;
446
447 procedure TEnemy.Wall;
448 begin
449 Count := Max;
450 Randomize;
451 case Random(4) of
452 0:
453 Dir := TDir.Left;
454 1:
455 Dir := Right;
456 2:
457 Dir := Up;
458 3:
459 Dir := Down;
460 end;
461 end;
462
463 { TWorry }
464
465 constructor TWorry.Create;
466 begin
467 Max := 5;
468 end;
469
470 { TGhost }
471
472 constructor TGhost.Create;
473 begin
474 Max := 3;
475 end;
476
477 procedure TGhost.Wall(p, q: integer);
478 begin
479 inherited Wall;
480 Randomize;
481 case Random(2) of
482 0:
483 if p > X then
484 Dir := Right
485 else if p < X then
486 Dir := TDir.Left;
487 1:
488 if q > Y then
489 Dir := Down
490 else if q < Y then
491 Dir := Up;
492 end;
493 end;
494
495 end.
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help