action/Unit1.pas

   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   TBeem = class(TObject)
  24   private
  25     FX: integer;
  26     FY: integer;
  27     FSpeed: integer;
  28   public
  29     constructor Create;
  30     property X: integer read FX write FX;
  31     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;
  42   end;
  43
  44   TEnemy = class(TChar)
  45   private
  46     FIndex: integer;
  47     FAX: integer;
  48     FAY: integer;
  49     FSpeed: integer;
  50     FVisible: Boolean;
  51     FPattern: integer;
  52   protected
  53     FFlightData: TMapData;
  54     procedure Search;
  55     function HardSearch: Boolean;
  56     procedure Buffer;
  57     property AX: integer read FAX write FAX;
  58     property AY: integer read FAY write FAY;
  59     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
  66     constructor Create;
  67     procedure Clear;
  68     property Speed: integer read FSpeed write FSpeed;
  69     property Visible: Boolean read FVisible write FVisible;
  70   end;
  71
  72   TAtack = record
  73     Interval: integer;
  74     Count: integer;
  75   end;
  76
  77   TForm1 = class(TForm)
  78     PaintBox1: TPaintBox;
  79     Image1: TImage;
  80     Image2: TImage;
  81     Timer1: TTimer;
  82     procedure PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
  83     procedure FormCreate(Sender: TObject);
  84     procedure FormDestroy(Sender: TObject);
  85     procedure Timer1Timer(Sender: TObject);
  86     procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
  87       Shift: TShiftState);
  88     procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
  89       Shift: TShiftState);
  90   private
  91     { private \90é\8c¾ }
  92   public
  93     { public \90é\8c¾ }
  94     Length: integer;
  95     Enemy: integer;
  96     List: TList;
  97     Beem: Boolean;
  98     Atack: TList;
  99     Count: integer;
 100     function CheckCross: Boolean;
 101     procedure GameOver;
 102   end;
 103
 104 var
 105   Form1: TForm1;
 106   Char1: TChar;
 107   Param: TAtack = (Interval: 0; Count: 5);
 108
 109 implementation
 110
 111 {$R *.fmx}
 112 { TEnemy }
 113
 114 procedure TEnemy.Buffer;
 115 const
 116   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),
 119     (0, 0, 0, 0, 0, 0, 0, 26, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0),
 120     (0, 0, 0, 0, 0, 0, 25, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0),
 121     (0, 0, 0, 0, 0, 24, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0),
 122     (0, 0, 0, 0, 23, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0),
 123     (0, 0, 0, 22, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0),
 124     (0, 0, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 0, 0, 0),
 125     (0, 0, 0, 20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, 0, 0),
 126     (0, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 0, 0, 0, 0, 0),
 127     (0, 0, 0, 0, 0, 18, 0, 0, 0, 0, 0, 0, 0, 10, 0, 0, 0, 0, 0, 0),
 128     (0, 0, 0, 0, 0, 0, 17, 0, 0, 0, 0, 0, 11, 0, 0, 0, 0, 0, 0, 0),
 129     (0, 0, 0, 0, 0, 0, 0, 16, 0, 0, 0, 12, 0, 0, 0, 0, 0, 0, 0, 0),
 130     (0, 0, 0, 0, 0, 0, 0, 0, 15, 14, 13, 0, 0, 0, 0, 0, 0, 0, 0, 0),
 131     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
 132     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
 133     (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 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
 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
 183   i: integer;
 184   j: integer;
 185 begin
 186   for i := 0 to Wid - 1 do
 187     for j := 0 to Hei - 1 do
 188       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;
 212   Pattern := -1;
 213   Clear;
 214 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);
 254 begin
 255   Char1 := TChar.Create;
 256   List := TList.Create;
 257   Atack := TList.Create;
 258   ClientWidth := Wid * Size;
 259   ClientHeight := Hei * Size;
 260   Enemy := 10;
 261   Count := 5;
 262 end;
 263
 264 procedure TForm1.FormDestroy(Sender: TObject);
 265 var
 266   s: TEnemy;
 267   t: TChar;
 268   i: integer;
 269 begin
 270   for i := 0 to List.Count - 1 do
 271   begin
 272     s := List[i];
 273     s.Free;
 274   end;
 275   for i := 0 to Atack.Count - 1 do
 276   begin
 277     t := Atack[i];
 278   end;
 279   List.Free;
 280   Atack.Free;
 281 end;
 282
 283 procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
 284   Shift: TShiftState);
 285 begin
 286   case KeyChar of
 287     'q':
 288       Beem := true;
 289     'a':
 290       Char1.Dir := Char1.Dir + [TDir.Left];
 291     'd':
 292       Char1.Dir := Char1.Dir + [Right];
 293     'w':
 294       Char1.Dir := Char1.Dir + [Up];
 295     's':
 296       Char1.Dir := Char1.Dir + [Down];
 297   end;
 298 end;
 299
 300 procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
 301   Shift: TShiftState);
 302 begin
 303   case KeyChar of
 304     'q':
 305       Beem := false;
 306     'a':
 307       Char1.Dir := Char1.Dir - [TDir.Left];
 308     'd':
 309       Char1.Dir := Char1.Dir - [Right];
 310     'w':
 311       Char1.Dir := Char1.Dir - [Up];
 312     's':
 313       Char1.Dir := Char1.Dir - [Down];
 314   end;
 315 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);
 325 var
 326   s: TEnemy;
 327   t: TBeem;
 328   i: integer;
 329 begin
 330   Canvas.DrawBitmap(Image1.Bitmap, RectF(0, 0, Image1.Bitmap.Width,
 331     Image1.Bitmap.Height), RectF(0, -Image1.Bitmap.Height + Hei * Size + Length,
 332     Image1.Bitmap.Width, Hei * Size + Length), 1);
 333   for i := 0 to List.Count - 1 do
 334   begin
 335     s := List[i];
 336     if s.Visible = true then
 337       Canvas.DrawBitmap(Image2.Bitmap, RectF(Size, 0, 2 * Size, Size),
 338         RectF(s.X, s.Y, s.X + Size, s.Y + Size), 1);
 339   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),
 347     RectF(Char1.X, Char1.Y, Char1.X + Size, Char1.Y + Size), 1);
 348 end;
 349
 350 procedure TForm1.Timer1Timer(Sender: TObject);
 351 var
 352   i: integer;
 353   s: TEnemy;
 354   t: TBeem;
 355   X: Boolean;
 356 begin
 357   X := false;
 358   if Length <= Image1.Bitmap.Height - Hei * Size then
 359   begin
 360     inc(Length);
 361     if Length >= Enemy then
 362     begin
 363       if List.Count = 0 then
 364         for i := 1 to 10 do
 365           List.Add(TEnemy.Create);
 366       X := true;
 367       for i := 0 to List.Count - 1 do
 368       begin
 369         s := List[i];
 370         if s.Visible = true then
 371         begin
 372           X := false;
 373           break;
 374         end;
 375       end;
 376     end;
 377   end
 378   else
 379     Length := 0;
 380   for i := 0 to List.Count - 1 do
 381   begin
 382     s := List[i];
 383     if s.Visible = true then
 384     begin
 385       if s.X > s.AX * Size then
 386         s.X := s.X - s.Speed
 387       else if s.X < s.AX * Size then
 388         s.X := s.X + s.Speed;
 389       if s.Y > s.AY * Size then
 390         s.Y := s.Y - s.Speed
 391       else if s.Y < s.AY * Size then
 392         s.Y := s.Y + s.Speed;
 393       if (s.X = s.AX * Size) and (s.Y = s.AY * Size) then
 394       begin
 395         s.Search;
 396         X := true;
 397       end;
 398     end
 399     else if X = true then
 400     begin
 401       s.Visible := true;
 402       X := false;
 403     end;
 404   end;
 405   if TDir.Left in Char1.Dir then
 406     Char1.X := Char1.X - 1;
 407   if Right in Char1.Dir then
 408     Char1.X := Char1.X + 1;
 409   if Up in Char1.Dir then
 410     Char1.Y := Char1.Y - 1;
 411   if Down in Char1.Dir then
 412     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;
 432   if CheckCross = true then
 433     GameOver;
 434 end;
 435
 436 function TEnemy.HardSearch: Boolean;
 437 var
 438   i, j: integer;
 439 begin
 440   inc(FIndex);
 441   result := false;
 442   for i := 0 to Wid - 1 do
 443     for j := 0 to Hei - 1 do
 444       if FFlightData[i, j] = Index then
 445       begin
 446         AX := i;
 447         AY := j;
 448         result := true;
 449         Exit;
 450       end;
 451 end;
 452
 453 procedure TEnemy.Search;
 454 begin
 455   inc(FIndex);
 456   if FFlightData[AX - 1, AY - 1] = Index then
 457   begin
 458     AX := AX - 1;
 459     AY := AY - 1;
 460   end
 461   else if FFlightData[AX, AY - 1] = Index then
 462     AY := AY - 1
 463   else if FFlightData[AX - 1, AY] = Index then
 464     AX := AX - 1
 465   else if FFlightData[AX + 1, AY] = Index then
 466     AX := AX + 1
 467   else if FFlightData[AX - 1, AY + 1] = Index then
 468   begin
 469     AX := AX - 1;
 470     AY := AY + 1;
 471   end
 472   else if FFlightData[AX, AY + 1] = Index then
 473     AY := AY + 1
 474   else if FFlightData[AX + 1, AY + 1] = Index then
 475   begin
 476     AX := AX + 1;
 477     AY := AY + 1;
 478   end
 479   else
 480   begin
 481     dec(FIndex);
 482     if HardSearch = false then
 483       Clear;
 484   end;
 485 end;
 486
 487 { TChar }
 488
 489 procedure TChar.Clear;
 490 begin
 491   X := Wid * Size div 2;
 492   Y := (Hei - 1) * Size;
 493 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.