Develop and Download Open Source Software

soi-man

Browse Subversion Repository

/[soi-man]/Unit1.pas

Annotation of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log

Revision 4 - (hide annotations) (download) (as text)
Wed Oct 7 08:54:52 2015 UTC (8 years, 6 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 10475 byte(s) 
グローバル変数でオブジェクトを定義しておきました
1 yamat0jp 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 yamat0jp 2 AX, AY: integer;
19 yamat0jp 4 function Walk: Boolean; virtual;
20 yamat0jp 1 procedure Wall; virtual;
21 yamat0jp 2 procedure Clear; virtual;
22 yamat0jp 1 end;
23    
24     TEnemy = class(TChar)
25     public
26     Count: integer;
27     Max: integer;
28 yamat0jp 2 Visible: Boolean;
29 yamat0jp 1 constructor Create;
30 yamat0jp 4 function Walk: Boolean; override;
31     procedure Wall; override;
32 yamat0jp 2 procedure Clear; override;
33 yamat0jp 4 procedure RunAway;
34 yamat0jp 1 end;
35    
36     TWorry = class(TEnemy)
37     public
38     constructor Create;
39     end;
40    
41     TGhost = class(TEnemy)
42     public
43 yamat0jp 2 constructor Create;
44 yamat0jp 4 procedure Wall; override;
45 yamat0jp 1 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 yamat0jp 2 FAction: Boolean;
73     procedure SetAction(const Value: Boolean);
74 yamat0jp 1 { private ���� }
75     public
76     { public ���� }
77     List: TList;
78 yamat0jp 2 Count: integer;
79 yamat0jp 1 procedure Start;
80     procedure GameOver;
81     procedure GameClear;
82 yamat0jp 2 property Action: Boolean read FAction write SetAction;
83 yamat0jp 1 end;
84    
85     var
86     Form1: TForm1;
87 yamat0jp 4 Map1: TMap;
88     Char1: TChar;
89 yamat0jp 1
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 yamat0jp 2 setint(1, [1, 9, 0, 3, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 4, 0, 0, 0, 0, 1]);
109 yamat0jp 1 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 yamat0jp 2 setint(5, [1, 0, 1, 1, 1, 0, 1, 1, 0, 1, 9, 1, 1, 0, 1, 0, 0, 0, 1, 1]);
113 yamat0jp 1 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 yamat0jp 3 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 yamat0jp 2 setint(17, [1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 1]);
125 yamat0jp 1 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 yamat0jp 2 var
141     i, j, k: integer;
142     s: TChar;
143 yamat0jp 1 begin
144 yamat0jp 4 Map1 := TMap.Create;
145     Map1.Clear;
146     ClientWidth := Map1.Size * Map1.Wid;
147     ClientHeight := Map1.Size * Map1.Hei;
148 yamat0jp 1 List := TList.Create;
149 yamat0jp 4 Char1 := TChar.Create;
150     List.Add(Char1);
151 yamat0jp 1 List.Add(TWorry.Create);
152 yamat0jp 2 List.Add(TGhost.Create);
153 yamat0jp 4 for i := 0 to Map1.Wid - 1 do
154     for j := 0 to Map1.Hei - 1 do
155 yamat0jp 2 begin
156 yamat0jp 4 k := Map1[i, j];
157 yamat0jp 2 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 yamat0jp 1 Start;
165     end;
166    
167     procedure TForm1.FormDestroy(Sender: TObject);
168     var
169     i: integer;
170     s: TChar;
171     begin
172 yamat0jp 4 Map1.Free;
173 yamat0jp 1 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 yamat0jp 4 Char1.Dir := TDir.Left;
187 yamat0jp 1 vkRight:
188 yamat0jp 4 Char1.Dir := Right;
189 yamat0jp 1 vkUp:
190 yamat0jp 4 Char1.Dir := Up;
191 yamat0jp 1 vkDown:
192 yamat0jp 4 Char1.Dir := Down;
193 yamat0jp 1 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 yamat0jp 4 Canvas.DrawBitMap(Image1.BitMap, RectF(X * Map1.Size, Y * Map1.Size,
207     (X + 1) * Map1.Size, (Y + 1) * Map1.Size),
208     RectF(i * Map1.Size, j * Map1.Size, (i + 1) * Map1.Size,
209     (j + 1) * Map1.Size), z);
210 yamat0jp 1 end;
211     procedure enemy(X, Y: integer);
212     begin
213 yamat0jp 4 Canvas.FillRect(RectF(X * Map1.Size, Y * Map1.Size, (X + 1) * Map1.Size,
214     (Y + 1) * Map1.Size), 0, 0, [], 1);
215 yamat0jp 1 end;
216    
217     begin
218 yamat0jp 4 for i := 0 to Map1.Wid - 1 do
219     for j := 0 to Map1.Hei - 1 do
220     case Map1[i, j] of
221 yamat0jp 1 0:
222     detail(0, 0, 1);
223     1:
224     detail(2, 1, 0.5);
225     10:
226     detail(2, 1, 1);
227     end;
228 yamat0jp 4 i := Char1.X;
229     j := Char1.Y;
230     case Char1.Dir of
231 yamat0jp 1 TDir.Left, Stop:
232     detail(0, 1, 1);
233     Right:
234     detail(1, 0, 1);
235     Up:
236     detail(1, 1, 1);
237     Down:
238     detail(2, 0, 1);
239     end;
240     for i := 1 to 2 do
241     begin
242     s := List[i];
243 yamat0jp 2 if (s as TEnemy).Visible = true then
244     enemy(s.X, s.Y);
245 yamat0jp 1 end;
246     end;
247    
248     procedure TForm1.GameClear;
249     var
250     i: integer;
251     j: integer;
252     begin
253 yamat0jp 4 for i := 0 to Map1.Wid - 1 do
254     for j := 0 to Map1.Hei - 1 do
255     if Map1[i, j] = 0 then
256 yamat0jp 1 Exit;
257     Start;
258     end;
259    
260     procedure TForm1.GameOver;
261     var
262     i: integer;
263     s: TChar;
264     begin
265     for i := 1 to 2 do
266     begin
267     s := List[i];
268 yamat0jp 4 if (Char1.X = s.X) and (Char1.Y = s.Y) then
269 yamat0jp 2 if Action = true then
270 yamat0jp 3 with s as TEnemy do
271     begin
272     Visible := false;
273 yamat0jp 4 Count := 20;
274 yamat0jp 3 end
275 yamat0jp 2 else
276     begin
277     Start;
278     break;
279     end;
280 yamat0jp 1 end;
281     end;
282    
283 yamat0jp 2 procedure TForm1.SetAction(const Value: Boolean);
284     begin
285     if Value = true then
286     begin
287     Count := 100;
288     Canvas.Fill.Color := TAlphaColors.Blue;
289     end
290     else
291     Canvas.Fill.Color := TAlphaColors.Purple;
292     FAction := Value;
293     end;
294    
295 yamat0jp 1 procedure TForm1.Start;
296     var
297     i: integer;
298     s: TChar;
299     begin
300 yamat0jp 2 Action := false;
301 yamat0jp 4 Map1.Clear;
302 yamat0jp 2 for i := 0 to List.Count - 1 do
303     begin
304     s := List[i];
305     s.Clear;
306 yamat0jp 4 if s = Char1 then
307     Map1[s.X, s.Y] := 10
308 yamat0jp 2 else
309 yamat0jp 4 Map1[s.X, s.Y] := 0;
310 yamat0jp 2 end;
311 yamat0jp 1 end;
312    
313     procedure TForm1.Timer1Timer(Sender: TObject);
314     var
315     i, p, q: integer;
316     s: TChar;
317     begin
318 yamat0jp 4 if Char1.Walk = true then
319 yamat0jp 1 begin
320 yamat0jp 4 p := Char1.X;
321     q := Char1.Y;
322     if Map1[p, q] = 9 then
323 yamat0jp 3 Action := true;
324 yamat0jp 4 Map1[p, q] := 10;
325 yamat0jp 3 GameOver;
326     end
327     else
328 yamat0jp 4 Char1.Wall;
329 yamat0jp 3 for i := 0 to List.Count - 1 do
330     begin
331 yamat0jp 1 s := List[i];
332 yamat0jp 4 if s = Char1 then
333 yamat0jp 3 continue;
334     if (s as TEnemy).Visible = true then
335 yamat0jp 1 begin
336 yamat0jp 3 if Action = false then
337 yamat0jp 4 (s as TEnemy).RunAway;
338     if s.Walk = false then
339 yamat0jp 2 s.Wall;
340 yamat0jp 1 end
341     else
342 yamat0jp 2 with s as TEnemy do
343     if Count = 0 then
344     Clear
345     else
346     dec(Count);
347 yamat0jp 1 end;
348 yamat0jp 2 if Action = true then
349     begin
350     if Count = 0 then
351     Action := false;
352     dec(Count);
353     end;
354 yamat0jp 1 GameOver;
355     PaintTo(Canvas);
356     GameClear;
357     end;
358    
359     { TChar }
360    
361 yamat0jp 2 procedure TChar.Clear;
362 yamat0jp 1 begin
363 yamat0jp 2 X := AX;
364     Y := AY;
365     Dir := Stop;
366     end;
367    
368 yamat0jp 4 function TChar.Walk: Boolean;
369     var
370     p, q: integer;
371 yamat0jp 2 begin
372 yamat0jp 1 p := X;
373     q := Y;
374     case Dir of
375     TDir.Left:
376     p := X - 1;
377     Right:
378     p := X + 1;
379     Up:
380     q := Y - 1;
381     Down:
382     q := Y + 1;
383     end;
384 yamat0jp 4 if Map1[p, q] <> 1 then
385     begin
386     X := p;
387     Y := q;
388     result := true;
389     end
390     else
391     result := false;
392 yamat0jp 1 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 yamat0jp 2 procedure TEnemy.Clear;
411     begin
412     inherited;
413     Visible := true;
414     Wall;
415     end;
416    
417 yamat0jp 1 constructor TEnemy.Create;
418     begin
419     inherited;
420     Randomize;
421     Count := Random(5);
422 yamat0jp 2 Visible := true;
423 yamat0jp 1 end;
424    
425 yamat0jp 4 procedure TEnemy.RunAway;
426     var
427     p, q: integer;
428 yamat0jp 1 begin
429 yamat0jp 4 p:=X;
430     q:=Y;
431 yamat0jp 2 Randomize;
432     case Random(2) of
433     0:
434     if p < X then
435     p := X - 1
436     else if p > X then
437     p := X + 1;
438     1:
439     if q < Y then
440     q := Y - 1
441     else
442     q := Y + 1;
443     end;
444 yamat0jp 4 if Map1[p, q] <> 1 then
445     begin
446     X := p;
447     Y := q;
448     end;
449 yamat0jp 2 end;
450    
451 yamat0jp 4 function TEnemy.Walk: Boolean;
452 yamat0jp 2 begin
453 yamat0jp 1 inherited;
454     dec(Count);
455     if Count = 0 then
456     begin
457     Wall;
458     Count := Max;
459     end;
460     end;
461    
462     procedure TEnemy.Wall;
463     begin
464 yamat0jp 2 Count := Max;
465 yamat0jp 1 Randomize;
466     case Random(4) of
467     0:
468     Dir := TDir.Left;
469     1:
470     Dir := Right;
471     2:
472     Dir := Up;
473     3:
474     Dir := Down;
475     end;
476     end;
477    
478 yamat0jp 2 { TWorry }
479    
480     constructor TWorry.Create;
481     begin
482     Max := 5;
483     end;
484    
485 yamat0jp 1 { TGhost }
486    
487 yamat0jp 2 constructor TGhost.Create;
488 yamat0jp 1 begin
489     Max := 3;
490     end;
491    
492 yamat0jp 4 procedure TGhost.Wall;
493     var
494     p, q: integer;
495 yamat0jp 1 begin
496 yamat0jp 4 inherited;
497     p := Char1.X;
498     q := Char1.Y;
499 yamat0jp 1 Randomize;
500     case Random(2) of
501     0:
502 yamat0jp 2 if p > X then
503 yamat0jp 1 Dir := Right
504 yamat0jp 2 else if p < X then
505 yamat0jp 1 Dir := TDir.Left;
506     1:
507 yamat0jp 2 if q > Y then
508 yamat0jp 1 Dir := Down
509 yamat0jp 2 else if q < Y then
510 yamat0jp 1 Dir := Up;
511     end;
512     end;
513    
514     end.
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help