Develop and Download Open Source Software

space-action

Browse Subversion Repository

/[space-action]/Unit1.pas

Annotation of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log

Revision 3 - (hide 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 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     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 yamat0jp 3 TBeem = class(TObject)
24 yamat0jp 1 private
25     FX: integer;
26     FY: integer;
27 yamat0jp 3 FSpeed: integer;
28 yamat0jp 1 public
29     constructor Create;
30     property X: integer read FX write FX;
31     property Y: integer read FY write FY;
32 yamat0jp 3 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 yamat0jp 1 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 yamat0jp 2 FPattern: integer;
52 yamat0jp 1 protected
53     FFlightData: TMapData;
54     procedure Search;
55 yamat0jp 2 function HardSearch: Boolean;
56     procedure Buffer;
57 yamat0jp 1 property AX: integer read FAX write FAX;
58     property AY: integer read FAY write FAY;
59     property Index: integer read FIndex write FIndex;
60 yamat0jp 2 property Pattern: integer read FPattern write FPattern;
61    
62     const
63     Kind = 3;
64     Span = 10;
65 yamat0jp 1 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 yamat0jp 3 TAtack = record
73     Interval: integer;
74     Count: integer;
75     end;
76    
77 yamat0jp 1 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 yamat0jp 3 Beem: Boolean;
98     Atack: TList;
99     Count: integer;
100     function CheckCross: Boolean;
101     procedure GameOver;
102 yamat0jp 1 end;
103    
104     var
105     Form1: TForm1;
106     Char1: TChar;
107 yamat0jp 3 Param: TAtack = (Interval: 0; Count: 5);
108 yamat0jp 1
109     implementation
110    
111     {$R *.fmx}
112     { TEnemy }
113    
114 yamat0jp 2 procedure TEnemy.Buffer;
115 yamat0jp 1 const
116 yamat0jp 2 AData: array [0 .. Kind - 1] of TMapData = ((
117 yamat0jp 1
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 yamat0jp 2 (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 yamat0jp 1 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 yamat0jp 2 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 yamat0jp 1 Speed := 4;
212 yamat0jp 2 Pattern := -1;
213 yamat0jp 1 Clear;
214     end;
215    
216 yamat0jp 3 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 yamat0jp 1 procedure TForm1.FormCreate(Sender: TObject);
254     begin
255     Char1 := TChar.Create;
256     List := TList.Create;
257 yamat0jp 3 Atack := TList.Create;
258 yamat0jp 1 ClientWidth := Wid * Size;
259     ClientHeight := Hei * Size;
260     Enemy := 10;
261 yamat0jp 3 Count := 5;
262 yamat0jp 1 end;
263    
264     procedure TForm1.FormDestroy(Sender: TObject);
265     var
266     s: TEnemy;
267 yamat0jp 3 t: TChar;
268 yamat0jp 1 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 yamat0jp 3 for i := 0 to Atack.Count - 1 do
276     begin
277     t := Atack[i];
278     end;
279 yamat0jp 1 List.Free;
280 yamat0jp 3 Atack.Free;
281 yamat0jp 1 end;
282    
283     procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
284     Shift: TShiftState);
285     begin
286     case KeyChar of
287 yamat0jp 3 'q':
288     Beem := true;
289 yamat0jp 1 '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 yamat0jp 3 'q':
305     Beem := false;
306 yamat0jp 1 '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 yamat0jp 3 procedure TForm1.GameOver;
318     begin
319     dec(Count);
320     if Count = 0 then
321     Timer1.Enabled := false;
322     end;
323    
324 yamat0jp 1 procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
325     var
326     s: TEnemy;
327 yamat0jp 3 t: TBeem;
328 yamat0jp 1 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 yamat0jp 3 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 yamat0jp 1 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 yamat0jp 3 t: TBeem;
355 yamat0jp 1 X: Boolean;
356     begin
357     X := false;
358 yamat0jp 3 if Length <= Image1.Bitmap.Height - Hei * Size then
359 yamat0jp 1 begin
360 yamat0jp 2 inc(Length);
361 yamat0jp 1 if Length >= Enemy then
362 yamat0jp 2 begin
363 yamat0jp 1 if List.Count = 0 then
364     for i := 1 to 10 do
365 yamat0jp 2 List.Add(TEnemy.Create);
366     X := true;
367     for i := 0 to List.Count - 1 do
368 yamat0jp 1 begin
369 yamat0jp 2 s := List[i];
370     if s.Visible = true then
371 yamat0jp 1 begin
372 yamat0jp 2 X := false;
373     break;
374 yamat0jp 1 end;
375     end;
376 yamat0jp 2 end;
377 yamat0jp 3 end
378     else
379     Length := 0;
380 yamat0jp 1 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 yamat0jp 3 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 yamat0jp 1 PaintBox1.Repaint;
432 yamat0jp 3 if CheckCross = true then
433     GameOver;
434 yamat0jp 1 end;
435    
436 yamat0jp 2 function TEnemy.HardSearch: Boolean;
437 yamat0jp 1 var
438     i, j: integer;
439     begin
440 yamat0jp 2 inc(FIndex);
441 yamat0jp 3 result := false;
442 yamat0jp 1 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 yamat0jp 2 result := true;
449 yamat0jp 1 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 yamat0jp 3 else
480     begin
481     dec(FIndex);
482     if HardSearch = false then
483     Clear;
484     end;
485 yamat0jp 1 end;
486    
487     { TChar }
488    
489 yamat0jp 3 procedure TChar.Clear;
490 yamat0jp 1 begin
491     X := Wid * Size div 2;
492     Y := (Hei - 1) * Size;
493     end;
494    
495 yamat0jp 3 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 yamat0jp 1 end.
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help