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 1 - (hide annotations) (download) (as text)
Fri Oct 9 14:55:49 2015 UTC (8 years, 5 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 7971 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     protected
43     FFlightData: TMapData;
44     procedure Search;
45     procedure HardSearch;
46     property AX: integer read FAX write FAX;
47     property AY: integer read FAY write FAY;
48     property Index: integer read FIndex write FIndex;
49     public
50     constructor Create;
51     procedure Clear;
52     property Speed: integer read FSpeed write FSpeed;
53     property Visible: Boolean read FVisible write FVisible;
54     end;
55    
56     TForm1 = class(TForm)
57     PaintBox1: TPaintBox;
58     Image1: TImage;
59     Image2: TImage;
60     Timer1: TTimer;
61     procedure PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
62     procedure FormCreate(Sender: TObject);
63     procedure FormDestroy(Sender: TObject);
64     procedure Timer1Timer(Sender: TObject);
65     procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
66     Shift: TShiftState);
67     procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
68     Shift: TShiftState);
69     private
70     { private ���� }
71     public
72     { public ���� }
73     Length: integer;
74     Enemy: integer;
75     List: TList;
76     end;
77    
78     var
79     Form1: TForm1;
80     Char1: TChar;
81    
82     implementation
83    
84     {$R *.fmx}
85     { TEnemy }
86    
87     procedure TEnemy.Clear;
88     begin
89     Index := 1;
90     HardSearch;
91     X := AX * Size;
92     Y := AY * Size;
93     Index := 2;
94     Search;
95     end;
96    
97     constructor TEnemy.Create;
98     const
99     AData: TMapData = (
100    
101     (0, 0, 0, 0, 0, 0, 0, 0, 27, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0),
102     (0, 0, 0, 0, 0, 0, 0, 26, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0),
103     (0, 0, 0, 0, 0, 0, 25, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0),
104     (0, 0, 0, 0, 0, 24, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0),
105     (0, 0, 0, 0, 23, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0),
106     (0, 0, 0, 22, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0),
107     (0, 0, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 0, 0, 0),
108     (0, 0, 0, 20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, 0, 0),
109     (0, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 0, 0, 0, 0, 0),
110     (0, 0, 0, 0, 0, 18, 0, 0, 0, 0, 0, 0, 0, 10, 0, 0, 0, 0, 0, 0),
111     (0, 0, 0, 0, 0, 0, 17, 0, 0, 0, 0, 0, 11, 0, 0, 0, 0, 0, 0, 0),
112     (0, 0, 0, 0, 0, 0, 0, 16, 0, 0, 0, 12, 0, 0, 0, 0, 0, 0, 0, 0),
113     (0, 0, 0, 0, 0, 0, 0, 0, 15, 14, 13, 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     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
118     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
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     var
122     i: integer;
123     j: integer;
124     begin
125     for i := 0 to Wid - 1 do
126     for j := 0 to Hei - 1 do
127     FFlightData[i, j] := AData[j, i];
128     Speed := 4;
129     Clear;
130     end;
131    
132     procedure TForm1.FormCreate(Sender: TObject);
133     begin
134     Char1 := TChar.Create;
135     List := TList.Create;
136     ClientWidth := Wid * Size;
137     ClientHeight := Hei * Size;
138     Enemy := 10;
139     end;
140    
141     procedure TForm1.FormDestroy(Sender: TObject);
142     var
143     s: TEnemy;
144     i: integer;
145     begin
146     for i := 0 to List.Count - 1 do
147     begin
148     s := List[i];
149     s.Free;
150     end;
151     List.Free;
152     end;
153    
154     procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
155     Shift: TShiftState);
156     begin
157     case KeyChar of
158     'a':
159     Char1.Dir := Char1.Dir + [TDir.Left];
160     'd':
161     Char1.Dir := Char1.Dir + [Right];
162     'w':
163     Char1.Dir := Char1.Dir + [Up];
164     's':
165     Char1.Dir := Char1.Dir + [Down];
166     end;
167     end;
168    
169     procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
170     Shift: TShiftState);
171     begin
172     case KeyChar of
173     'a':
174     Char1.Dir := Char1.Dir - [TDir.Left];
175     'd':
176     Char1.Dir := Char1.Dir - [Right];
177     'w':
178     Char1.Dir := Char1.Dir - [Up];
179     's':
180     Char1.Dir := Char1.Dir - [Down];
181     end;
182     end;
183    
184     procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
185     var
186     s: TEnemy;
187     i: integer;
188     begin
189     Canvas.DrawBitmap(Image1.Bitmap, RectF(0, 0, Image1.Bitmap.Width,
190     Image1.Bitmap.Height), RectF(0, -Image1.Bitmap.Height + Hei * Size + Length,
191     Image1.Bitmap.Width, Hei * Size + Length), 1);
192     for i := 0 to List.Count - 1 do
193     begin
194     s := List[i];
195     if s.Visible = true then
196     Canvas.DrawBitmap(Image2.Bitmap, RectF(Size, 0, 2 * Size, Size),
197     RectF(s.X, s.Y, s.X + Size, s.Y + Size), 1);
198     end;
199     Canvas.DrawBitmap(Image2.Bitmap, RectF(0, 0, Size, Size),
200     RectF(Char1.X, Char1.Y, Char1.X + Size, Char1.Y + Size), 1);
201     end;
202    
203     procedure TForm1.Timer1Timer(Sender: TObject);
204     var
205     i: integer;
206     s: TEnemy;
207     X: Boolean;
208     begin
209     X := false;
210     if Length < Image1.Bitmap.Height - Hei * Size then
211     begin
212     inc(Length, 1);
213     if Length >= Enemy then
214     if List.Count = 0 then
215     for i := 1 to 10 do
216     List.Add(TEnemy.Create)
217     else
218     begin
219     X := true;
220     for i := 0 to List.Count - 1 do
221     begin
222     s := List[i];
223     if s.Visible = true then
224     begin
225     X := false;
226     break;
227     end;
228     end;
229     end;
230     end;
231     for i := 0 to List.Count - 1 do
232     begin
233     s := List[i];
234     if s.Visible = true then
235     begin
236     if s.X > s.AX * Size then
237     s.X := s.X - s.Speed
238     else if s.X < s.AX * Size then
239     s.X := s.X + s.Speed;
240     if s.Y > s.AY * Size then
241     s.Y := s.Y - s.Speed
242     else if s.Y < s.AY * Size then
243     s.Y := s.Y + s.Speed;
244     if (s.X = s.AX * Size) and (s.Y = s.AY * Size) then
245     begin
246     s.Search;
247     X := true;
248     end;
249     end
250     else if X = true then
251     begin
252     s.Visible := true;
253     X := false;
254     end;
255     end;
256     if TDir.Left in Char1.Dir then
257     Char1.X := Char1.X - 1;
258     if Right in Char1.Dir then
259     Char1.X := Char1.X + 1;
260     if Up in Char1.Dir then
261     Char1.Y := Char1.Y - 1;
262     if Down in Char1.Dir then
263     Char1.Y := Char1.Y + 1;
264     PaintBox1.Repaint;
265     end;
266    
267     procedure TEnemy.HardSearch;
268     var
269     i, j: integer;
270     begin
271     for i := 0 to Wid - 1 do
272     for j := 0 to Hei - 1 do
273     if FFlightData[i, j] = Index then
274     begin
275     AX := i;
276     AY := j;
277     Exit;
278     end;
279     Visible := false;
280     Clear;
281     end;
282    
283     procedure TEnemy.Search;
284     begin
285     inc(FIndex);
286     if FFlightData[AX - 1, AY - 1] = Index then
287     begin
288     AX := AX - 1;
289     AY := AY - 1;
290     end
291     else if FFlightData[AX, AY - 1] = Index then
292     AY := AY - 1
293     else if FFlightData[AX - 1, AY] = Index then
294     AX := AX - 1
295     else if FFlightData[AX + 1, AY] = Index then
296     AX := AX + 1
297     else if FFlightData[AX - 1, AY + 1] = Index then
298     begin
299     AX := AX - 1;
300     AY := AY + 1;
301     end
302     else if FFlightData[AX, AY + 1] = Index then
303     AY := AY + 1
304     else if FFlightData[AX + 1, AY + 1] = Index then
305     begin
306     AX := AX + 1;
307     AY := AY + 1;
308     end
309     else
310     HardSearch;
311     end;
312    
313     { TChar }
314    
315     constructor TChar.Create;
316     begin
317     X := Wid * Size div 2;
318     Y := (Hei - 1) * Size;
319     end;
320    
321     end.
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help