Develop and Download Open Source Software

space-action

Browse Subversion Repository

/[space-action]/Unit1.pas

Contents of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log

Revision 3 - (show annotations) (download) (as text)
Sat Oct 10 04:28:33 2015 UTC (8 years, 4 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 13543 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 const
11 Wid = 20;
12 Hei = 20;
13 Size = 32;
14 Max = 10;
15
16 type
17 TMapData = array [0 .. Wid - 1, 0 .. Hei - 1] of integer;
18
19 TDir = (Left, Right, Up, Down);
20
21 TDirs = set of TDir;
22
23 TBeem = class(TObject)
24 private
25 FX: integer;
26 FY: integer;
27 FSpeed: integer;
28 public
29 constructor Create;
30 property X: integer read FX write FX;
31 property Y: integer read FY write FY;
32 property Speed: integer read FSpeed write FSpeed;
33 end;
34
35 TChar = class(TBeem)
36 private
37 FDir: TDirs;
38 procedure Clear;
39 public
40 constructor Create;
41 property Dir: TDirs read FDir write FDir;
42 end;
43
44 TEnemy = class(TChar)
45 private
46 FIndex: integer;
47 FAX: integer;
48 FAY: integer;
49 FSpeed: integer;
50 FVisible: Boolean;
51 FPattern: integer;
52 protected
53 FFlightData: TMapData;
54 procedure Search;
55 function HardSearch: Boolean;
56 procedure Buffer;
57 property AX: integer read FAX write FAX;
58 property AY: integer read FAY write FAY;
59 property Index: integer read FIndex write FIndex;
60 property Pattern: integer read FPattern write FPattern;
61
62 const
63 Kind = 3;
64 Span = 10;
65 public
66 constructor Create;
67 procedure Clear;
68 property Speed: integer read FSpeed write FSpeed;
69 property Visible: Boolean read FVisible write FVisible;
70 end;
71
72 TAtack = record
73 Interval: integer;
74 Count: integer;
75 end;
76
77 TForm1 = class(TForm)
78 PaintBox1: TPaintBox;
79 Image1: TImage;
80 Image2: TImage;
81 Timer1: TTimer;
82 procedure PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
83 procedure FormCreate(Sender: TObject);
84 procedure FormDestroy(Sender: TObject);
85 procedure Timer1Timer(Sender: TObject);
86 procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
87 Shift: TShiftState);
88 procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
89 Shift: TShiftState);
90 private
91 { private ���� }
92 public
93 { public ���� }
94 Length: integer;
95 Enemy: integer;
96 List: TList;
97 Beem: Boolean;
98 Atack: TList;
99 Count: integer;
100 function CheckCross: Boolean;
101 procedure GameOver;
102 end;
103
104 var
105 Form1: TForm1;
106 Char1: TChar;
107 Param: TAtack = (Interval: 0; Count: 5);
108
109 implementation
110
111 {$R *.fmx}
112 { TEnemy }
113
114 procedure TEnemy.Buffer;
115 const
116 AData: array [0 .. Kind - 1] of TMapData = ((
117
118 (0, 0, 0, 0, 0, 0, 0, 0, 27, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0),
119 (0, 0, 0, 0, 0, 0, 0, 26, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0),
120 (0, 0, 0, 0, 0, 0, 25, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0),
121 (0, 0, 0, 0, 0, 24, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0),
122 (0, 0, 0, 0, 23, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0),
123 (0, 0, 0, 22, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0),
124 (0, 0, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 0, 0, 0),
125 (0, 0, 0, 20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, 0, 0),
126 (0, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 0, 0, 0, 0, 0),
127 (0, 0, 0, 0, 0, 18, 0, 0, 0, 0, 0, 0, 0, 10, 0, 0, 0, 0, 0, 0),
128 (0, 0, 0, 0, 0, 0, 17, 0, 0, 0, 0, 0, 11, 0, 0, 0, 0, 0, 0, 0),
129 (0, 0, 0, 0, 0, 0, 0, 16, 0, 0, 0, 12, 0, 0, 0, 0, 0, 0, 0, 0),
130 (0, 0, 0, 0, 0, 0, 0, 0, 15, 14, 13, 0, 0, 0, 0, 0, 0, 0, 0, 0),
131 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
132 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
133 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
134 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
135 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
136 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
137 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), (
138
139 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
140 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
141 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
142 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
143 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
144 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
145 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
146 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
147 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
148 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
149 (1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 18),
150 (0, 0, 3, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 16, 0, 0),
151 (0, 0, 0, 0, 5, 6, 0, 0, 0, 0, 0, 0, 0, 13, 14, 0, 0, 0, 0, 0),
152 (0, 0, 0, 0, 0, 0, 7, 8, 0, 0, 11, 12, 0, 0, 0, 0, 0, 0, 0, 0),
153 (0, 0, 0, 0, 0, 0, 0, 0, 9, 10, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
154 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
155 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
156 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
157 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
158 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), (
159
160 (0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0),
161 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
162 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
163 (0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 2, 0, 0, 0, 0, 3, 0, 0, 0, 0),
164 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
165 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
166 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
167 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
168 (0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
169 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
170 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
171 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
172 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
173 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 4, 0, 0, 0, 0),
174 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
175 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
176 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
177 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
178 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
179 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0))
180
181 );
182 var
183 i: integer;
184 j: integer;
185 begin
186 for i := 0 to Wid - 1 do
187 for j := 0 to Hei - 1 do
188 FFlightData[i, j] := AData[Pattern][j, i];
189 end;
190
191 procedure TEnemy.Clear;
192 begin
193 Visible := false;
194 inc(FPattern);
195 if Kind = Pattern then
196 Pattern := 0;
197 Buffer;
198 Index := 0;
199 if HardSearch = true then
200 begin
201 X := AX * Size;
202 Y := AY * Size;
203 Search;
204 end
205 else
206 Clear;
207 end;
208
209 constructor TEnemy.Create;
210 begin
211 Speed := 4;
212 Pattern := -1;
213 Clear;
214 end;
215
216 function TForm1.CheckCross: Boolean;
217 var
218 s: TEnemy;
219 t: TBeem;
220 i, j: integer;
221 begin
222 for i := List.Count - 1 downto 0 do
223 begin
224 s := List[i];
225 if (Char1.X < s.X + Size) and (Char1.X + Size > s.X) and
226 (Char1.Y < s.Y + Size) and (Char1.Y + Size > s.Y) then
227 begin
228 result := true;
229 List.Delete(i);
230 s.Free;
231 Char1.Clear;
232 end;
233 end;
234 for i := Atack.Count - 1 downto 0 do
235 begin
236 t := Atack[i];
237 for j := List.Count - 1 downto 0 do
238 begin
239 s := List[j];
240 if (t.X < s.X + Size) and (t.X + Size > s.X) and (t.Y < s.Y + Size) and
241 (t.Y + Size > s.Y) then
242 begin
243 Atack.Delete(i);
244 t.Free;
245 List.Delete(j);
246 s.Free;
247 break;
248 end;
249 end;
250 end;
251 end;
252
253 procedure TForm1.FormCreate(Sender: TObject);
254 begin
255 Char1 := TChar.Create;
256 List := TList.Create;
257 Atack := TList.Create;
258 ClientWidth := Wid * Size;
259 ClientHeight := Hei * Size;
260 Enemy := 10;
261 Count := 5;
262 end;
263
264 procedure TForm1.FormDestroy(Sender: TObject);
265 var
266 s: TEnemy;
267 t: TChar;
268 i: integer;
269 begin
270 for i := 0 to List.Count - 1 do
271 begin
272 s := List[i];
273 s.Free;
274 end;
275 for i := 0 to Atack.Count - 1 do
276 begin
277 t := Atack[i];
278 end;
279 List.Free;
280 Atack.Free;
281 end;
282
283 procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
284 Shift: TShiftState);
285 begin
286 case KeyChar of
287 'q':
288 Beem := true;
289 'a':
290 Char1.Dir := Char1.Dir + [TDir.Left];
291 'd':
292 Char1.Dir := Char1.Dir + [Right];
293 'w':
294 Char1.Dir := Char1.Dir + [Up];
295 's':
296 Char1.Dir := Char1.Dir + [Down];
297 end;
298 end;
299
300 procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
301 Shift: TShiftState);
302 begin
303 case KeyChar of
304 'q':
305 Beem := false;
306 'a':
307 Char1.Dir := Char1.Dir - [TDir.Left];
308 'd':
309 Char1.Dir := Char1.Dir - [Right];
310 'w':
311 Char1.Dir := Char1.Dir - [Up];
312 's':
313 Char1.Dir := Char1.Dir - [Down];
314 end;
315 end;
316
317 procedure TForm1.GameOver;
318 begin
319 dec(Count);
320 if Count = 0 then
321 Timer1.Enabled := false;
322 end;
323
324 procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
325 var
326 s: TEnemy;
327 t: TBeem;
328 i: integer;
329 begin
330 Canvas.DrawBitmap(Image1.Bitmap, RectF(0, 0, Image1.Bitmap.Width,
331 Image1.Bitmap.Height), RectF(0, -Image1.Bitmap.Height + Hei * Size + Length,
332 Image1.Bitmap.Width, Hei * Size + Length), 1);
333 for i := 0 to List.Count - 1 do
334 begin
335 s := List[i];
336 if s.Visible = true then
337 Canvas.DrawBitmap(Image2.Bitmap, RectF(Size, 0, 2 * Size, Size),
338 RectF(s.X, s.Y, s.X + Size, s.Y + Size), 1);
339 end;
340 for i := 0 to Atack.Count - 1 do
341 begin
342 t := Atack[i];
343 Canvas.DrawBitmap(Image2.Bitmap, RectF(2 * Size, 0, 3 * Size, Size),
344 RectF(t.X, t.Y, t.X + Size, t.Y + Size), 1);
345 end;
346 Canvas.DrawBitmap(Image2.Bitmap, RectF(0, 0, Size, Size),
347 RectF(Char1.X, Char1.Y, Char1.X + Size, Char1.Y + Size), 1);
348 end;
349
350 procedure TForm1.Timer1Timer(Sender: TObject);
351 var
352 i: integer;
353 s: TEnemy;
354 t: TBeem;
355 X: Boolean;
356 begin
357 X := false;
358 if Length <= Image1.Bitmap.Height - Hei * Size then
359 begin
360 inc(Length);
361 if Length >= Enemy then
362 begin
363 if List.Count = 0 then
364 for i := 1 to 10 do
365 List.Add(TEnemy.Create);
366 X := true;
367 for i := 0 to List.Count - 1 do
368 begin
369 s := List[i];
370 if s.Visible = true then
371 begin
372 X := false;
373 break;
374 end;
375 end;
376 end;
377 end
378 else
379 Length := 0;
380 for i := 0 to List.Count - 1 do
381 begin
382 s := List[i];
383 if s.Visible = true then
384 begin
385 if s.X > s.AX * Size then
386 s.X := s.X - s.Speed
387 else if s.X < s.AX * Size then
388 s.X := s.X + s.Speed;
389 if s.Y > s.AY * Size then
390 s.Y := s.Y - s.Speed
391 else if s.Y < s.AY * Size then
392 s.Y := s.Y + s.Speed;
393 if (s.X = s.AX * Size) and (s.Y = s.AY * Size) then
394 begin
395 s.Search;
396 X := true;
397 end;
398 end
399 else if X = true then
400 begin
401 s.Visible := true;
402 X := false;
403 end;
404 end;
405 if TDir.Left in Char1.Dir then
406 Char1.X := Char1.X - 1;
407 if Right in Char1.Dir then
408 Char1.X := Char1.X + 1;
409 if Up in Char1.Dir then
410 Char1.Y := Char1.Y - 1;
411 if Down in Char1.Dir then
412 Char1.Y := Char1.Y + 1;
413 for i := Atack.Count - 1 downto 0 do
414 begin
415 t := Atack[i];
416 t.Y := t.Y - t.Speed;
417 if (t.Y + Size) < 0 then
418 begin
419 Atack.Delete(i);
420 t.Free;
421 end;
422 end;
423 if Beem = true then
424 if (Param.Interval = 0) and (Atack.Count < Param.Count) then
425 begin
426 Atack.Add(TBeem.Create);
427 Param.Interval := 10;
428 end;
429 if Param.Interval > 0 then
430 dec(Param.Interval);
431 PaintBox1.Repaint;
432 if CheckCross = true then
433 GameOver;
434 end;
435
436 function TEnemy.HardSearch: Boolean;
437 var
438 i, j: integer;
439 begin
440 inc(FIndex);
441 result := false;
442 for i := 0 to Wid - 1 do
443 for j := 0 to Hei - 1 do
444 if FFlightData[i, j] = Index then
445 begin
446 AX := i;
447 AY := j;
448 result := true;
449 Exit;
450 end;
451 end;
452
453 procedure TEnemy.Search;
454 begin
455 inc(FIndex);
456 if FFlightData[AX - 1, AY - 1] = Index then
457 begin
458 AX := AX - 1;
459 AY := AY - 1;
460 end
461 else if FFlightData[AX, AY - 1] = Index then
462 AY := AY - 1
463 else if FFlightData[AX - 1, AY] = Index then
464 AX := AX - 1
465 else if FFlightData[AX + 1, AY] = Index then
466 AX := AX + 1
467 else if FFlightData[AX - 1, AY + 1] = Index then
468 begin
469 AX := AX - 1;
470 AY := AY + 1;
471 end
472 else if FFlightData[AX, AY + 1] = Index then
473 AY := AY + 1
474 else if FFlightData[AX + 1, AY + 1] = Index then
475 begin
476 AX := AX + 1;
477 AY := AY + 1;
478 end
479 else
480 begin
481 dec(FIndex);
482 if HardSearch = false then
483 Clear;
484 end;
485 end;
486
487 { TChar }
488
489 procedure TChar.Clear;
490 begin
491 X := Wid * Size div 2;
492 Y := (Hei - 1) * Size;
493 end;
494
495 constructor TChar.Create;
496 begin
497 Clear;
498 end;
499
500 { TBeem }
501
502 constructor TBeem.Create;
503 begin
504 FX := Char1.X;
505 FY := Char1.Y - Size;
506 FSpeed := 8;
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