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 2 - (show 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 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 FPattern: integer;
43 protected
44 FFlightData: TMapData;
45 procedure Search;
46 function HardSearch: Boolean;
47 procedure Buffer;
48 property AX: integer read FAX write FAX;
49 property AY: integer read FAY write FAY;
50 property Index: integer read FIndex write FIndex;
51 property Pattern: integer read FPattern write FPattern;
52
53 const
54 Kind = 3;
55 Span = 10;
56 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 procedure TEnemy.Buffer;
95 const
96 AData: array [0 .. Kind - 1] of TMapData = ((
97
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 (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 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 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 Speed := 4;
192 Pattern := -1;
193 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 inc(Length);
277 if Length >= Enemy then
278 begin
279 if List.Count = 0 then
280 for i := 1 to 10 do
281 List.Add(TEnemy.Create);
282 X := true;
283 for i := 0 to List.Count - 1 do
284 begin
285 s := List[i];
286 if s.Visible = true then
287 begin
288 X := false;
289 break;
290 end;
291 end;
292 end;
293 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 function TEnemy.HardSearch: Boolean;
331 var
332 i, j: integer;
333 begin
334 inc(FIndex);
335 result:=false;
336 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 result := true;
343 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 else if HardSearch = false then
374 Clear;
375 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  
About OSDN
Find Software
Develop Software
Help