Develop and Download Open Source Software

space-action

Browse Subversion Repository

/[space-action]/Unit1.pas

Diff of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1 by yamat0jp, Fri Oct 9 14:55:49 2015 UTC revision 3 by yamat0jp, Sat Oct 10 04:28:33 2015 UTC
# Line 20  type Line 20  type
20    
21    TDirs = set of TDir;    TDirs = set of TDir;
22    
23    TChar = class(TObject)    TBeem = class(TObject)
24    private    private
25      FX: integer;      FX: integer;
26      FY: integer;      FY: integer;
27      FDir: TDirs;      FSpeed: integer;
28    public    public
29      constructor Create;      constructor Create;
30      property X: integer read FX write FX;      property X: integer read FX write FX;
31      property Y: integer read FY write FY;      property Y: integer read FY write FY;
32        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      property Dir: TDirs read FDir write FDir;      property Dir: TDirs read FDir write FDir;
42    end;    end;
43    
# Line 39  type Line 48  type
48      FAY: integer;      FAY: integer;
49      FSpeed: integer;      FSpeed: integer;
50      FVisible: Boolean;      FVisible: Boolean;
51        FPattern: integer;
52    protected    protected
53      FFlightData: TMapData;      FFlightData: TMapData;
54      procedure Search;      procedure Search;
55      procedure HardSearch;      function HardSearch: Boolean;
56        procedure Buffer;
57      property AX: integer read FAX write FAX;      property AX: integer read FAX write FAX;
58      property AY: integer read FAY write FAY;      property AY: integer read FAY write FAY;
59      property Index: integer read FIndex write FIndex;      property Index: integer read FIndex write FIndex;
60        property Pattern: integer read FPattern write FPattern;
61    
62      const
63        Kind = 3;
64        Span = 10;
65    public    public
66      constructor Create;      constructor Create;
67      procedure Clear;      procedure Clear;
# Line 53  type Line 69  type
69      property Visible: Boolean read FVisible write FVisible;      property Visible: Boolean read FVisible write FVisible;
70    end;    end;
71    
72      TAtack = record
73        Interval: integer;
74        Count: integer;
75      end;
76    
77    TForm1 = class(TForm)    TForm1 = class(TForm)
78      PaintBox1: TPaintBox;      PaintBox1: TPaintBox;
79      Image1: TImage;      Image1: TImage;
# Line 73  type Line 94  type
94      Length: integer;      Length: integer;
95      Enemy: integer;      Enemy: integer;
96      List: TList;      List: TList;
97        Beem: Boolean;
98        Atack: TList;
99        Count: integer;
100        function CheckCross: Boolean;
101        procedure GameOver;
102    end;    end;
103    
104  var  var
105    Form1: TForm1;    Form1: TForm1;
106    Char1: TChar;    Char1: TChar;
107      Param: TAtack = (Interval: 0; Count: 5);
108    
109  implementation  implementation
110    
111  {$R *.fmx}  {$R *.fmx}
112  { TEnemy }  { TEnemy }
113    
114  procedure TEnemy.Clear;  procedure TEnemy.Buffer;
 begin  
   Index := 1;  
   HardSearch;  
   X := AX * Size;  
   Y := AY * Size;  
   Index := 2;  
   Search;  
 end;  
   
 constructor TEnemy.Create;  
115  const  const
116    AData: TMapData = (    AData: array [0 .. Kind - 1] of TMapData = ((
117    
118      (0, 0, 0, 0, 0, 0, 0, 0, 27, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0),      (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),      (0, 0, 0, 0, 0, 0, 0, 26, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0),
# Line 117  const Line 134  const
134      (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),      (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),      (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),      (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));      (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  var  var
183    i: integer;    i: integer;
184    j: integer;    j: integer;
185  begin  begin
186    for i := 0 to Wid - 1 do    for i := 0 to Wid - 1 do
187      for j := 0 to Hei - 1 do      for j := 0 to Hei - 1 do
188        FFlightData[i, j] := AData[j, i];        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    Speed := 4;    Speed := 4;
212      Pattern := -1;
213    Clear;    Clear;
214  end;  end;
215    
216    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  procedure TForm1.FormCreate(Sender: TObject);  procedure TForm1.FormCreate(Sender: TObject);
254  begin  begin
255    Char1 := TChar.Create;    Char1 := TChar.Create;
256    List := TList.Create;    List := TList.Create;
257      Atack := TList.Create;
258    ClientWidth := Wid * Size;    ClientWidth := Wid * Size;
259    ClientHeight := Hei * Size;    ClientHeight := Hei * Size;
260    Enemy := 10;    Enemy := 10;
261      Count := 5;
262  end;  end;
263    
264  procedure TForm1.FormDestroy(Sender: TObject);  procedure TForm1.FormDestroy(Sender: TObject);
265  var  var
266    s: TEnemy;    s: TEnemy;
267      t: TChar;
268    i: integer;    i: integer;
269  begin  begin
270    for i := 0 to List.Count - 1 do    for i := 0 to List.Count - 1 do
# Line 148  begin Line 272  begin
272      s := List[i];      s := List[i];
273      s.Free;      s.Free;
274    end;    end;
275      for i := 0 to Atack.Count - 1 do
276      begin
277        t := Atack[i];
278      end;
279    List.Free;    List.Free;
280      Atack.Free;
281  end;  end;
282    
283  procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;  procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
284    Shift: TShiftState);    Shift: TShiftState);
285  begin  begin
286    case KeyChar of    case KeyChar of
287        'q':
288          Beem := true;
289      'a':      'a':
290        Char1.Dir := Char1.Dir + [TDir.Left];        Char1.Dir := Char1.Dir + [TDir.Left];
291      'd':      'd':
# Line 170  procedure TForm1.FormKeyUp(Sender: TObje Line 301  procedure TForm1.FormKeyUp(Sender: TObje
301    Shift: TShiftState);    Shift: TShiftState);
302  begin  begin
303    case KeyChar of    case KeyChar of
304        'q':
305          Beem := false;
306      'a':      'a':
307        Char1.Dir := Char1.Dir - [TDir.Left];        Char1.Dir := Char1.Dir - [TDir.Left];
308      'd':      'd':
# Line 181  begin Line 314  begin
314    end;    end;
315  end;  end;
316    
317    procedure TForm1.GameOver;
318    begin
319      dec(Count);
320      if Count = 0 then
321        Timer1.Enabled := false;
322    end;
323    
324  procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);  procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
325  var  var
326    s: TEnemy;    s: TEnemy;
327      t: TBeem;
328    i: integer;    i: integer;
329  begin  begin
330    Canvas.DrawBitmap(Image1.Bitmap, RectF(0, 0, Image1.Bitmap.Width,    Canvas.DrawBitmap(Image1.Bitmap, RectF(0, 0, Image1.Bitmap.Width,
# Line 196  begin Line 337  begin
337        Canvas.DrawBitmap(Image2.Bitmap, RectF(Size, 0, 2 * Size, Size),        Canvas.DrawBitmap(Image2.Bitmap, RectF(Size, 0, 2 * Size, Size),
338          RectF(s.X, s.Y, s.X + Size, s.Y + Size), 1);          RectF(s.X, s.Y, s.X + Size, s.Y + Size), 1);
339    end;    end;
340      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    Canvas.DrawBitmap(Image2.Bitmap, RectF(0, 0, Size, Size),    Canvas.DrawBitmap(Image2.Bitmap, RectF(0, 0, Size, Size),
347      RectF(Char1.X, Char1.Y, Char1.X + Size, Char1.Y + Size), 1);      RectF(Char1.X, Char1.Y, Char1.X + Size, Char1.Y + Size), 1);
348  end;  end;
# Line 204  procedure TForm1.Timer1Timer(Sender: TOb Line 351  procedure TForm1.Timer1Timer(Sender: TOb
351  var  var
352    i: integer;    i: integer;
353    s: TEnemy;    s: TEnemy;
354      t: TBeem;
355    X: Boolean;    X: Boolean;
356  begin  begin
357    X := false;    X := false;
358    if Length < Image1.Bitmap.Height - Hei * Size then    if Length <= Image1.Bitmap.Height - Hei * Size then
359    begin    begin
360      inc(Length, 1);      inc(Length);
361      if Length >= Enemy then      if Length >= Enemy then
362        begin
363        if List.Count = 0 then        if List.Count = 0 then
364          for i := 1 to 10 do          for i := 1 to 10 do
365            List.Add(TEnemy.Create)            List.Add(TEnemy.Create);
366        else        X := true;
367          for i := 0 to List.Count - 1 do
368        begin        begin
369          X := true;          s := List[i];
370          for i := 0 to List.Count - 1 do          if s.Visible = true then
371          begin          begin
372            s := List[i];            X := false;
373            if s.Visible = true then            break;
           begin  
             X := false;  
             break;  
           end;  
374          end;          end;
375        end;        end;
376    end;      end;
377      end
378      else
379        Length := 0;
380    for i := 0 to List.Count - 1 do    for i := 0 to List.Count - 1 do
381    begin    begin
382      s := List[i];      s := List[i];
# Line 261  begin Line 410  begin
410      Char1.Y := Char1.Y - 1;      Char1.Y := Char1.Y - 1;
411    if Down in Char1.Dir then    if Down in Char1.Dir then
412      Char1.Y := Char1.Y + 1;      Char1.Y := Char1.Y + 1;
413      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    PaintBox1.Repaint;    PaintBox1.Repaint;
432      if CheckCross = true then
433        GameOver;
434  end;  end;
435    
436  procedure TEnemy.HardSearch;  function TEnemy.HardSearch: Boolean;
437  var  var
438    i, j: integer;    i, j: integer;
439  begin  begin
440      inc(FIndex);
441      result := false;
442    for i := 0 to Wid - 1 do    for i := 0 to Wid - 1 do
443      for j := 0 to Hei - 1 do      for j := 0 to Hei - 1 do
444        if FFlightData[i, j] = Index then        if FFlightData[i, j] = Index then
445        begin        begin
446          AX := i;          AX := i;
447          AY := j;          AY := j;
448            result := true;
449          Exit;          Exit;
450        end;        end;
   Visible := false;  
   Clear;  
451  end;  end;
452    
453  procedure TEnemy.Search;  procedure TEnemy.Search;
# Line 307  begin Line 477  begin
477      AY := AY + 1;      AY := AY + 1;
478    end    end
479    else    else
480      HardSearch;    begin
481        dec(FIndex);
482        if HardSearch = false then
483          Clear;
484      end;
485  end;  end;
486    
487  { TChar }  { TChar }
488    
489  constructor TChar.Create;  procedure TChar.Clear;
490  begin  begin
491    X := Wid * Size div 2;    X := Wid * Size div 2;
492    Y := (Hei - 1) * Size;    Y := (Hei - 1) * Size;
493  end;  end;
494    
495    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  end.  end.
Legend:
Removed from v.1  
changed lines
  Added in v.3
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help