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 1 - (show annotations) (download) (as text)
Mon Oct 5 12:52:47 2015 UTC (8 years, 5 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 8736 byte(s) 
未完成ですが遊ぶことはできます
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