Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (hide annotations) (download) (as text)
Sat Oct 10 00:23:06 2015 UTC (8 years, 5 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 11087 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     TChar = class(TObject)
24     private
25     FX: integer;
26     FY: integer;
27     FDir: TDirs;
28     public
29     constructor Create;
30     property X: integer read FX write FX;
31     property Y: integer read FY write FY;
32     property Dir: TDirs read FDir write FDir;
33     end;
34    
35     TEnemy = class(TChar)
36     private
37     FIndex: integer;
38     FAX: integer;
39     FAY: integer;
40     FSpeed: integer;
41     FVisible: Boolean;
42 yamat0jp 2 FPattern: integer;
43 yamat0jp 1 protected
44     FFlightData: TMapData;
45     procedure Search;
46 yamat0jp 2 function HardSearch: Boolean;
47     procedure Buffer;
48 yamat0jp 1 property AX: integer read FAX write FAX;
49     property AY: integer read FAY write FAY;
50     property Index: integer read FIndex write FIndex;
51 yamat0jp 2 property Pattern: integer read FPattern write FPattern;
52    
53     const
54     Kind = 3;
55     Span = 10;
56 yamat0jp 1 public
57     constructor Create;
58     procedure Clear;
59     property Speed: integer read FSpeed write FSpeed;
60     property Visible: Boolean read FVisible write FVisible;
61     end;
62    
63     TForm1 = class(TForm)
64     PaintBox1: TPaintBox;
65     Image1: TImage;
66     Image2: TImage;
67     Timer1: TTimer;
68     procedure PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
69     procedure FormCreate(Sender: TObject);
70     procedure FormDestroy(Sender: TObject);
71     procedure Timer1Timer(Sender: TObject);
72     procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
73     Shift: TShiftState);
74     procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
75     Shift: TShiftState);
76     private
77     { private ���� }
78     public
79     { public ���� }
80     Length: integer;
81     Enemy: integer;
82     List: TList;
83     end;
84    
85     var
86     Form1: TForm1;
87     Char1: TChar;
88    
89     implementation
90    
91     {$R *.fmx}
92     { TEnemy }
93    
94 yamat0jp 2 procedure TEnemy.Buffer;
95 yamat0jp 1 const
96 yamat0jp 2 AData: array [0 .. Kind - 1] of TMapData = ((
97 yamat0jp 1
98     (0, 0, 0, 0, 0, 0, 0, 0, 27, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0),
99     (0, 0, 0, 0, 0, 0, 0, 26, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0),
100     (0, 0, 0, 0, 0, 0, 25, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0),
101     (0, 0, 0, 0, 0, 24, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0),
102     (0, 0, 0, 0, 23, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0),
103     (0, 0, 0, 22, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0),
104     (0, 0, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 0, 0, 0),
105     (0, 0, 0, 20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, 0, 0),
106     (0, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 0, 0, 0, 0, 0),
107     (0, 0, 0, 0, 0, 18, 0, 0, 0, 0, 0, 0, 0, 10, 0, 0, 0, 0, 0, 0),
108     (0, 0, 0, 0, 0, 0, 17, 0, 0, 0, 0, 0, 11, 0, 0, 0, 0, 0, 0, 0),
109     (0, 0, 0, 0, 0, 0, 0, 16, 0, 0, 0, 12, 0, 0, 0, 0, 0, 0, 0, 0),
110     (0, 0, 0, 0, 0, 0, 0, 0, 15, 14, 13, 0, 0, 0, 0, 0, 0, 0, 0, 0),
111     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
112     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
113     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
114     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
115     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
116     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
117 yamat0jp 2 (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), (
118    
119     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
120     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
121     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
122     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
123     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
124     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
125     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
126     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
127     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
128     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
129     (1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 18),
130     (0, 0, 3, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 16, 0, 0),
131     (0, 0, 0, 0, 5, 6, 0, 0, 0, 0, 0, 0, 0, 13, 14, 0, 0, 0, 0, 0),
132     (0, 0, 0, 0, 0, 0, 7, 8, 0, 0, 11, 12, 0, 0, 0, 0, 0, 0, 0, 0),
133     (0, 0, 0, 0, 0, 0, 0, 0, 9, 10, 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     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), (
139    
140     (0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 1, 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, 7, 2, 0, 0, 0, 0, 3, 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, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
149     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
150     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
151     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
152     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
153     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 4, 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     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0))
160    
161     );
162 yamat0jp 1 var
163     i: integer;
164     j: integer;
165     begin
166     for i := 0 to Wid - 1 do
167     for j := 0 to Hei - 1 do
168 yamat0jp 2 FFlightData[i, j] := AData[Pattern][j, i];
169     end;
170    
171     procedure TEnemy.Clear;
172     begin
173     Visible := false;
174     inc(FPattern);
175     if Kind = Pattern then
176     Pattern := 0;
177     Buffer;
178     Index := 0;
179     if HardSearch = true then
180     begin
181     X := AX * Size;
182     Y := AY * Size;
183     Search;
184     end
185     else
186     Clear;
187     end;
188    
189     constructor TEnemy.Create;
190     begin
191 yamat0jp 1 Speed := 4;
192 yamat0jp 2 Pattern := -1;
193 yamat0jp 1 Clear;
194     end;
195    
196     procedure TForm1.FormCreate(Sender: TObject);
197     begin
198     Char1 := TChar.Create;
199     List := TList.Create;
200     ClientWidth := Wid * Size;
201     ClientHeight := Hei * Size;
202     Enemy := 10;
203     end;
204    
205     procedure TForm1.FormDestroy(Sender: TObject);
206     var
207     s: TEnemy;
208     i: integer;
209     begin
210     for i := 0 to List.Count - 1 do
211     begin
212     s := List[i];
213     s.Free;
214     end;
215     List.Free;
216     end;
217    
218     procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
219     Shift: TShiftState);
220     begin
221     case KeyChar of
222     'a':
223     Char1.Dir := Char1.Dir + [TDir.Left];
224     'd':
225     Char1.Dir := Char1.Dir + [Right];
226     'w':
227     Char1.Dir := Char1.Dir + [Up];
228     's':
229     Char1.Dir := Char1.Dir + [Down];
230     end;
231     end;
232    
233     procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
234     Shift: TShiftState);
235     begin
236     case KeyChar of
237     'a':
238     Char1.Dir := Char1.Dir - [TDir.Left];
239     'd':
240     Char1.Dir := Char1.Dir - [Right];
241     'w':
242     Char1.Dir := Char1.Dir - [Up];
243     's':
244     Char1.Dir := Char1.Dir - [Down];
245     end;
246     end;
247    
248     procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
249     var
250     s: TEnemy;
251     i: integer;
252     begin
253     Canvas.DrawBitmap(Image1.Bitmap, RectF(0, 0, Image1.Bitmap.Width,
254     Image1.Bitmap.Height), RectF(0, -Image1.Bitmap.Height + Hei * Size + Length,
255     Image1.Bitmap.Width, Hei * Size + Length), 1);
256     for i := 0 to List.Count - 1 do
257     begin
258     s := List[i];
259     if s.Visible = true then
260     Canvas.DrawBitmap(Image2.Bitmap, RectF(Size, 0, 2 * Size, Size),
261     RectF(s.X, s.Y, s.X + Size, s.Y + Size), 1);
262     end;
263     Canvas.DrawBitmap(Image2.Bitmap, RectF(0, 0, Size, Size),
264     RectF(Char1.X, Char1.Y, Char1.X + Size, Char1.Y + Size), 1);
265     end;
266    
267     procedure TForm1.Timer1Timer(Sender: TObject);
268     var
269     i: integer;
270     s: TEnemy;
271     X: Boolean;
272     begin
273     X := false;
274     if Length < Image1.Bitmap.Height - Hei * Size then
275     begin
276 yamat0jp 2 inc(Length);
277 yamat0jp 1 if Length >= Enemy then
278 yamat0jp 2 begin
279 yamat0jp 1 if List.Count = 0 then
280     for i := 1 to 10 do
281 yamat0jp 2 List.Add(TEnemy.Create);
282     X := true;
283     for i := 0 to List.Count - 1 do
284 yamat0jp 1 begin
285 yamat0jp 2 s := List[i];
286     if s.Visible = true then
287 yamat0jp 1 begin
288 yamat0jp 2 X := false;
289     break;
290 yamat0jp 1 end;
291     end;
292 yamat0jp 2 end;
293 yamat0jp 1 end;
294     for i := 0 to List.Count - 1 do
295     begin
296     s := List[i];
297     if s.Visible = true then
298     begin
299     if s.X > s.AX * Size then
300     s.X := s.X - s.Speed
301     else if s.X < s.AX * Size then
302     s.X := s.X + s.Speed;
303     if s.Y > s.AY * Size then
304     s.Y := s.Y - s.Speed
305     else if s.Y < s.AY * Size then
306     s.Y := s.Y + s.Speed;
307     if (s.X = s.AX * Size) and (s.Y = s.AY * Size) then
308     begin
309     s.Search;
310     X := true;
311     end;
312     end
313     else if X = true then
314     begin
315     s.Visible := true;
316     X := false;
317     end;
318     end;
319     if TDir.Left in Char1.Dir then
320     Char1.X := Char1.X - 1;
321     if Right in Char1.Dir then
322     Char1.X := Char1.X + 1;
323     if Up in Char1.Dir then
324     Char1.Y := Char1.Y - 1;
325     if Down in Char1.Dir then
326     Char1.Y := Char1.Y + 1;
327     PaintBox1.Repaint;
328     end;
329    
330 yamat0jp 2 function TEnemy.HardSearch: Boolean;
331 yamat0jp 1 var
332     i, j: integer;
333     begin
334 yamat0jp 2 inc(FIndex);
335     result:=false;
336 yamat0jp 1 for i := 0 to Wid - 1 do
337     for j := 0 to Hei - 1 do
338     if FFlightData[i, j] = Index then
339     begin
340     AX := i;
341     AY := j;
342 yamat0jp 2 result := true;
343 yamat0jp 1 Exit;
344     end;
345     end;
346    
347     procedure TEnemy.Search;
348     begin
349     inc(FIndex);
350     if FFlightData[AX - 1, AY - 1] = Index then
351     begin
352     AX := AX - 1;
353     AY := AY - 1;
354     end
355     else if FFlightData[AX, AY - 1] = Index then
356     AY := AY - 1
357     else if FFlightData[AX - 1, AY] = Index then
358     AX := AX - 1
359     else if FFlightData[AX + 1, AY] = Index then
360     AX := AX + 1
361     else if FFlightData[AX - 1, AY + 1] = Index then
362     begin
363     AX := AX - 1;
364     AY := AY + 1;
365     end
366     else if FFlightData[AX, AY + 1] = Index then
367     AY := AY + 1
368     else if FFlightData[AX + 1, AY + 1] = Index then
369     begin
370     AX := AX + 1;
371     AY := AY + 1;
372     end
373 yamat0jp 2 else if HardSearch = false then
374     Clear;
375 yamat0jp 1 end;
376    
377     { TChar }
378    
379     constructor TChar.Create;
380     begin
381     X := Wid * Size div 2;
382     Y := (Hei - 1) * Size;
383     end;
384    
385     end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26