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 1 - (show 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 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