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 1 - (hide annotations) (download) (as text)
Mon Oct 5 12:52:47 2015 UTC (8 years, 6 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 8736 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     procedure Walk(out p, q: integer); virtual;
19     procedure Wall; virtual;
20     end;
21    
22     TEnemy = class(TChar)
23     public
24     Count: integer;
25     Max: integer;
26     constructor Create;
27     procedure Walk(out p, q: integer); override;
28     procedure Wall; override;
29     end;
30    
31     TWorry = class(TEnemy)
32     public
33     constructor Create;
34     procedure Wall; override;
35     end;
36    
37     TGhost = class(TEnemy)
38     public
39     Man: TChar;
40     constructor Create(c: TChar);
41     procedure Wall; override;
42     end;
43    
44     TMap = class(TObject)
45     const
46     Wid = 20;
47     Hei = 20;
48     Size = 32;
49     private
50     FStrings: array [0 .. Wid - 1, 0 .. Hei - 1] of integer;
51     function GetStrings(X, Y: integer): integer;
52     procedure SetStrings(X, Y: integer; const Value: integer);
53     public
54     constructor Create;
55     procedure Clear;
56     property Strings[X, Y: integer]: integer read GetStrings
57     write SetStrings; default;
58     end;
59    
60     TForm1 = class(TForm)
61     Image1: TImage;
62     Timer1: TTimer;
63     procedure FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
64     procedure FormCreate(Sender: TObject);
65     procedure FormDestroy(Sender: TObject);
66     procedure Timer1Timer(Sender: TObject);
67     procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
68     Shift: TShiftState);
69     private
70     { private ���� }
71     public
72     { public ���� }
73     Map: TMap;
74     Char: TChar;
75     List: TList;
76     procedure Start;
77     procedure GameOver;
78     procedure GameClear;
79     end;
80    
81     var
82     Form1: TForm1;
83    
84     implementation
85    
86     {$R *.fmx}
87     { TMap }
88    
89     procedure TMap.Clear;
90     type
91     TLocal = array [0 .. Wid - 1] of integer;
92     procedure setint(Index: integer; arr: array of integer);
93     var
94     k: integer;
95     begin
96     for k := 0 to Wid - 1 do
97     FStrings[k, index] := arr[k];
98     end;
99    
100     begin
101     setint(0, [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
102     setint(1, [1, 0, 0, 3, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 4, 0, 0, 0, 0, 1]);
103     setint(2, [1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1]);
104     setint(3, [1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0, 1, 1, 0, 1]);
105     setint(4, [1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 1, 0, 0, 1]);
106     setint(5, [1, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 0, 1, 1]);
107     setint(6, [1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 0, 1, 1]);
108     setint(7, [1, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1]);
109     setint(8, [1, 0, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1]);
110     setint(9, [1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1]);
111     setint(10, [1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1]);
112     setint(11, [1, 0, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1]);
113     setint(12, [1, 0, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
114     setint(13, [1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
115     setint(14, [1, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
116     setint(15, [1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
117     setint(16, [1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
118     setint(17, [1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1]);
119     setint(18, [1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1]);
120     setint(19, [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
121     end;
122    
123     constructor TMap.Create;
124     begin
125     Clear;
126     end;
127    
128     function TMap.GetStrings(X, Y: integer): integer;
129     begin
130     result := FStrings[X, Y];
131     end;
132    
133     procedure TMap.SetStrings(X, Y: integer; const Value: integer);
134     begin
135     FStrings[X, Y] := Value;
136     end;
137    
138     procedure TForm1.FormCreate(Sender: TObject);
139     begin
140     Canvas.Fill.Color := TAlphaColors.Blue;
141     Map := TMap.Create;
142     ClientWidth := Map.Size * Map.Wid;
143     ClientHeight := Map.Size * Map.Hei;
144     List := TList.Create;
145     Char := TChar.Create;
146     List.Add(Char);
147     List.Add(TWorry.Create);
148     List.Add(TGhost.Create(Char));
149     Start;
150     end;
151    
152     procedure TForm1.FormDestroy(Sender: TObject);
153     var
154     i: integer;
155     s: TChar;
156     begin
157     Map.Free;
158     for i := 0 to List.Count - 1 do
159     begin
160     s := List[i];
161     s.Free;
162     end;
163     List.Free;
164     end;
165    
166     procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
167     Shift: TShiftState);
168     begin
169     case Key of
170     vkLeft:
171     Char.Dir := TDir.Left;
172     vkRight:
173     Char.Dir := Right;
174     vkUp:
175     Char.Dir := Up;
176     vkDown:
177     Char.Dir := Down;
178     vkEscape:
179     Start;
180     end;
181     end;
182    
183     procedure TForm1.FormPaint(Sender: TObject; Canvas: TCanvas;
184     const ARect: TRectF);
185     var
186     i: integer;
187     j: integer;
188     s: TChar;
189     procedure detail(X, Y: integer; z: Extended);
190     begin
191     Canvas.DrawBitmap(Image1.Bitmap, RectF(X * Map.Size, Y * Map.Size,
192     (X + 1) * Map.Size, (Y + 1) * Map.Size), RectF(i * Map.Size, j * Map.Size,
193     (i + 1) * Map.Size, (j + 1) * Map.Size), z);
194     end;
195     procedure enemy(X, Y: integer);
196     begin
197     Canvas.FillRect(RectF(X * Map.Size, Y * Map.Size, (X + 1) * Map.Size,
198     (Y + 1) * Map.Size), 0, 0, [], 1);
199     end;
200    
201     begin
202     for i := 0 to Map.Wid - 1 do
203     for j := 0 to Map.Hei - 1 do
204     case Map[i, j] of
205     0:
206     detail(0, 0, 1);
207     1:
208     detail(2, 1, 0.5);
209     10:
210     detail(2, 1, 1);
211     end;
212     i := Char.X;
213     j := Char.Y;
214     case Char.Dir of
215     TDir.Left, Stop:
216     detail(0, 1, 1);
217     Right:
218     detail(1, 0, 1);
219     Up:
220     detail(1, 1, 1);
221     Down:
222     detail(2, 0, 1);
223     end;
224     for i := 1 to 2 do
225     begin
226     s := List[i];
227     enemy(s.X, s.Y);
228     end;
229     end;
230    
231     procedure TForm1.GameClear;
232     var
233     i: integer;
234     j: integer;
235     begin
236     for i := 0 to Map.Wid - 1 do
237     for j := 0 to Map.Hei - 1 do
238     if Map[i, j] = 0 then
239     Exit;
240     Start;
241     end;
242    
243     procedure TForm1.GameOver;
244     var
245     i: integer;
246     s: TChar;
247     begin
248     for i := 1 to 2 do
249     begin
250     s := List[i];
251     if (Char.X = s.X) and (Char.Y = s.Y) then
252     begin
253     Start;
254     break;
255     end;
256     end;
257     end;
258    
259     procedure TForm1.Start;
260     var
261     i: integer;
262     j: integer;
263     k: integer;
264     s: TChar;
265     begin
266     Map.Clear;
267     for i := 0 to Map.Wid - 1 do
268     for j := 0 to Map.Hei - 1 do
269     begin
270     k := Map[i, j];
271     if k in [2 .. 4] then
272     begin
273     s := List[k - 2];
274     s.X := i;
275     s.Y := j;
276     if k = 2 then
277     Map[i, j] := 10
278     else
279     Map[i, j] := 0;
280     end;
281     end;
282     Char.Dir := Stop;
283     end;
284    
285     procedure TForm1.Timer1Timer(Sender: TObject);
286     var
287     i, p, q: integer;
288     s: TChar;
289     begin
290     for i := 0 to 2 do
291     begin
292     s := List[i];
293     s.Walk(p, q);
294     if Map[p, q] in [0, 10] then
295     begin
296     s.X := p;
297     s.Y := q;
298     if s = Char then
299     begin
300     Map[p, q] := 10;
301     GameOver;
302     end;
303     end
304     else
305     s.Wall;
306     end;
307     GameOver;
308     PaintTo(Canvas);
309     GameClear;
310     end;
311    
312     { TChar }
313    
314     procedure TChar.Walk(out p, q: integer);
315     begin
316     p := X;
317     q := Y;
318     case Dir of
319     TDir.Left:
320     p := X - 1;
321     Right:
322     p := X + 1;
323     Up:
324     q := Y - 1;
325     Down:
326     q := Y + 1;
327     end;
328     end;
329    
330     procedure TChar.Wall;
331     begin
332     case Dir of
333     TDir.Left:
334     Dir := Right;
335     Right:
336     Dir := TDir.Left;
337     Up:
338     Dir := Down;
339     Down:
340     Dir := Up;
341     end;
342     end;
343    
344     { TEnemy }
345    
346     constructor TEnemy.Create;
347     begin
348     inherited;
349     Randomize;
350     Count := Random(5);
351     end;
352    
353     procedure TEnemy.Walk(out p, q: integer);
354     begin
355     inherited;
356     dec(Count);
357     if Count = 0 then
358     begin
359     Wall;
360     Count := Max;
361     end;
362     end;
363    
364     procedure TEnemy.Wall;
365     begin
366     // Count := Max;
367     end;
368    
369     { TWorry }
370    
371     constructor TWorry.Create;
372     begin
373     Max := 5;
374     end;
375    
376     procedure TWorry.Wall;
377     begin
378     inherited;
379     Randomize;
380     case Random(4) of
381     0:
382     Dir := TDir.Left;
383     1:
384     Dir := Right;
385     2:
386     Dir := Up;
387     3:
388     Dir := Down;
389     end;
390     end;
391    
392     { TGhost }
393    
394     constructor TGhost.Create(c: TChar);
395     begin
396     Man := c;
397     Max := 3;
398     end;
399    
400     procedure TGhost.Wall;
401     begin
402     inherited;
403     Randomize;
404     case Random(2) of
405     0:
406     if Man.X > X then
407     Dir := Right
408     else if Man.X < X then
409     Dir := TDir.Left;
410     1:
411     if Man.Y > Y then
412     Dir := Down
413     else if Man.Y < Y then
414     Dir := Up;
415     end;
416     end;
417    
418     end.
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help