Delphi(FMX)でシューティングゲーム作成チュートリアル

初めに

DelphiのFMXフレームワークを使用してシューティングゲームを作成するチュートリアルです。

プロジェクトの作成とフォームの設計

Delphi IDEを起動して[ファイル]⇒[新規作成]⇒[マルチデバイス アプリケーション - Delphi]をクリックします。

「空のアプリケーション」を選択して[OK]ボタンをクリックします。

「パレット」から「TImage」をドラッグ＆ドロップします。

[ファイル]⇒[新規作成]⇒[マルチデバイス フォーム - Delphi]をクリックしてフォームを追加します。

「HDフォーム」を選択して [OK]ボタンをクリックします。

追加したフォーム（Form2）に「TImage」を７個ドラッグ＆ドロップしします。「TImageList」を１個ドラッグ＆ドロップします。
Image1の「MultiResBitmap」プロパティに「player.png」画像を設定します。
Image2の「MultiResBitmap」プロパティに「enemy1.png」画像を設定します。
Image3の「MultiResBitmap」プロパティに「enemy2.png」画像を設定します。
Image4の「MultiResBitmap」プロパティに「boss1.png」画像を設定します。
Image5の「MultiResBitmap」プロパティに「bullet1.png」画像を設定します。
Image6の「MultiResBitmap」プロパティに「bullet2.png」画像を設定します。
Image7の「MultiResBitmap」プロパティに「playerbullet.png」画像を設定します。

player.png

enemy1.png

enemy2.png

boss1.png

bullet1.png

bullet2.png

playerbullet.png

ImageList1をダブルクリックします。
幅、高さを３２０に設定します。[追加]ボタンを押します。

explode.pngを選択して[開く]ボタンを押します。

explode.png

[OK]ボタンを押します。

[はい]ボタンを押します。

[いいえ]ボタンを押します。

[OK]ボタンを押します。

プロジェクトの設定

[プロジェクト]⇒[オプション]をクリックします。
左ペインのツリーにある[アプリケーション]⇒[フォーム]を選択します。
「Form2」を選択して[＞]ボタンを押して、使用可能フォームに移動させます。

左ペインのツリーにある[アプリケーション]⇒[マニフェスト]を選択します。
「DPIの認識」を［なし］に設定して［保存］ボタンを押します。

Form2（Unit2）のソースコードの記述

「F12」キーを押して以下ソースコードを記述します。

unit Unit2;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects, System.ImageList, FMX.ImgList;

type
  TForm2 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Image7: TImage;
    Image5: TImage;
    Image6: TImage;
    ImageList1: TImageList;
  private
    { private 宣言 }
  public
    { public 宣言 }
  end;


  TStageSenario=record
    Action:String;
    ObjName:String;
    WaitFrame:Integer;
    x,y:Single;
  end;
  TStageState=(ssTitle,ssPlay);
  TSpliteState=(spDestroy,spExplode,spExist);
  TSpliteKind=(skPlayer,skPlayerBullet,skEnemy,skEnemyBullet);
  TSpliteSenario=record
    Action:String;
    Frame:Integer;
    Dx,Dy:Single;
  end;


  TBase=class(TObject)
  strict private
    procedure AddChild(Obj:TBase);
  strict protected
    fParent:TBase;
    fChild:TList;
    fCanvas:TCanvas;
    fFieldBmp:TBitmap;
  public
    Constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);virtual;
    Destructor Destroy();override;
  end;

  TPlayer=class;

  TStage=class(TBase)
  strict private
    procedure DoMove();
    procedure DoCollision();
    procedure DoDraw();
    procedure DoSenario();
    procedure DrawTitle();
    procedure Clear();
  strict protected
    fSenarioList:TStringList;
    fSenario:TStageSenario;
    fFrame:Integer;
    fSenarioNum:Integer;
    fPrintString:String;
    fStageState:TStageState;
    fPlayer:TPlayer;
    fPlayerDeadFrame:Integer;
  public
    constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);override;
    Destructor Destroy();override;
    procedure DoFrame();
  end;

  TSpliteBase=class(TBase)
  strict private
    function GetPosition():TPointF;
    procedure SetPosition(pt:TPointF);
  strict protected
    fW,fH:Single;
    fBmp:TBitmap;
    fCollisionRect:TRectF;
    fKind:TSpliteKind;
    fAliveArea:TRectF;
    fHP:Single;
    fHitting:Integer;//=0:NoHit, >0:Hitting
    fState:TSpliteState;
    fExplodeFrame:Single;
    fExplodeList:TImageList;
    fPosition:TPointF;
  public
    property Position:TPointF read GetPosition write SetPosition;
    property W:Single read fW;
    property H:Single read fH;
    property HP:Single read fHP write fHP;
    property Kind:TSpliteKind read fKind;
    property State:TSpliteState read fState write FState;
    property CollisionRect:TRectF read fCollisionRect;
    procedure Move();virtual;abstract;
    procedure Draw();virtual;
    procedure IsCollision(target:TSpliteBase);virtual;
    Destructor Destroy();override;
    constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);override;
  end;

  TPlayer=class(TSpliteBase)
  strict private
    fShotWaitCount:Integer;
    fCanShot:Boolean;
  public
    property CanShot:Boolean read fCanShot write fCanShot;
    procedure Move();override;
    constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);override;
  end;

  TSplite=class(TSpliteBase)
  strict protected
    fSenarioList:TStringList;
    fSenario:TSpliteSenario;
    fSenarioNum:Integer;
    fFrame:Integer;
  public
    procedure Move();override;
    property SenarioList:TStringList read fSenarioList;
    Destructor Destroy();override;
    constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);override;
  end;

  TEnemy1=class(TSplite)
  public
    constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);override;
  end;

  TEnemy2=class(TSplite)
  public
    constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);override;
  end;

  TBoss1=class(TSplite)
  public
    constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);override;
  end;

  TBullet1=class(TSplite)
  public
    constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);override;
  end;

  TBullet2=class(TSplite)
  public
    constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);override;
  end;

  TPlayerBullet=class(TSplite)
  public
    constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);override;
  end;

var
  Form2: TForm2;

implementation

{$R *.fmx}

uses System.Math, Winapi.MMSystem, Winapi.Windows;


{ TBase }
procedure TBase.AddChild(Obj: TBase);
begin
  fChild.Add(Obj);
end;

constructor TBase.Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);
begin
  fParent:=Parent;
  fChild:=TList.Create;
  fFieldBmp:=FieldBmp;
  fCanvas:=fFieldBmp.Canvas;
  if Assigned(fParent) then fParent.AddChild(self);
end;

destructor TBase.Destroy;
var i:Integer;
begin
  //子オブジェクトの破棄
  for i:=fChild.Count-1 downto 0 do
    TSpliteBase(fChild[i]).Free;
  fChild.Free;
  inherited;
end;


{ TStage }
procedure TStage.Clear;
var i:Integer;
begin
  for i := fChild.Count-1 downto 0 do
    TSpliteBase(fChild[i]).Free;
  fChild.Clear;
end;

constructor TStage.Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);
begin
  inherited;
  fPrintString:='';
  fFrame:=-1;
  fSenarioNum:=0;
  fPlayer:=nil;
  fStageState:=TStageState.ssTitle;
  fSenarioList:=TStringList.Create;
  fSenarioList.Add('add  ,TOwnShip,  0,400, 700');
  fSenarioList.Add('print,Stage1  ,200,  0,   0');
  fSenarioList.Add('print,        ,  0,  0,   0');
  fSenarioList.Add('add  ,TEnemy1 ,  0,170, -64');
  fSenarioList.Add('add  ,TEnemy1 ,  0,370, -64');
  fSenarioList.Add('add  ,TEnemy1 ,  0,570, -64');
  fSenarioList.Add('wait ,        ,200,  0,   0');
  fSenarioList.Add('add  ,TEnemy1 ,  0,170, -64');
  fSenarioList.Add('add  ,TEnemy1 ,  0,370, -64');
  fSenarioList.Add('add  ,TEnemy1 ,  0,570, -64');
  fSenarioList.Add('wait ,        ,200,  0,   0');
  fSenarioList.Add('add  ,TEnemy1 ,  0,170, -64');
  fSenarioList.Add('add  ,TEnemy1 ,  0,370, -64');
  fSenarioList.Add('add  ,TEnemy1 ,  0,570, -64');
  fSenarioList.Add('wait ,        ,200,  0,   0');
  fSenarioList.Add('wait ,        ,800,  0,   0');

  fSenarioList.Add('add  ,TEnemy2 ,  0,170, -64');
  fSenarioList.Add('wait ,        ,200,  0,   0');
  fSenarioList.Add('add  ,TEnemy2 ,  0,170, -64');
  fSenarioList.Add('wait ,        ,200,  0,   0');
  fSenarioList.Add('add  ,TEnemy2 ,  0,170, -64');
  fSenarioList.Add('wait ,        ,200,  0,   0');
  fSenarioList.Add('add  ,TEnemy2 ,  0,370, -64');
  fSenarioList.Add('wait ,        ,200,  0,   0');
  fSenarioList.Add('add  ,TEnemy2 ,  0,370, -64');
  fSenarioList.Add('wait ,        ,200,  0,   0');
  fSenarioList.Add('add  ,TEnemy2 ,  0,370, -64');
  fSenarioList.Add('wait ,        ,200,  0,   0');
  fSenarioList.Add('add  ,TEnemy2 ,  0,570, -64');
  fSenarioList.Add('wait ,        ,200,  0,   0');
  fSenarioList.Add('add  ,TEnemy2 ,  0,570, -64');
  fSenarioList.Add('wait ,        ,200,  0,   0');
  fSenarioList.Add('add  ,TEnemy2 ,  0,570, -64');
  fSenarioList.Add('wait ,        ,200,  0,   0');
  fSenarioList.Add('wait ,        ,800,  0,   0');

  fSenarioList.Add('add  ,TBoss1  ,  0,330,-128');
  fSenarioList.Add('wait ,TBoss1  ,  0,  0,   0');
  fSenarioList.Add('wait ,        ,400,  0,   0');
  fSenarioList.Add('goto ,        ,  0,  1,   0');
end;

destructor TStage.Destroy;
begin
  fSenarioList.Free;
  inherited;
end;

procedure TStage.DoCollision;
var i,j:Integer;
begin
  for i := 0 to fChild.Count-1 do
  begin
    if (TSpliteBase(fChild[i]).State=TSpliteState.spExist) then
    begin
      if (TSpliteBase(fChild[i]).Kind=TSpliteKind.skPlayer) then
      begin
        for j := 0 to fChild.Count-1 do
        begin
          if (i<>j) and (TSpliteBase(fChild[j]).State=TSpliteState.spExist) and
             (
               (TSpliteBase(fChild[j]).Kind=TSpliteKind.skEnemy) or
               (TSpliteBase(fChild[j]).Kind=TSpliteKind.skEnemyBullet)
             ) then
          begin
            TSpliteBase(fChild[i]).IsCollision(fChild[j]);
          end;
        end;
      end
      else if (TSpliteBase(fChild[i]).Kind=TSpliteKind.skEnemy) then
      begin
        for j := 0 to fChild.Count-1 do
        begin
          if (i<>j) and (TSpliteBase(fChild[j]).State=TSpliteState.spExist) and
             (TSpliteBase(fChild[j]).Kind=TSpliteKind.skPlayerBullet) then
          begin
            TSpliteBase(fChild[i]).IsCollision(fChild[j]);
          end;
        end;
      end;
    end;
  end;
end;

procedure TStage.DoDraw;
var i:Integer;
begin
  fCanvas.BeginScene();
  fCanvas.Fill.Color:=$FF000000;
  fCanvas.Fill.Kind:=TBrushKind.Solid;
  fCanvas.FillRect(
    RectF(0,0,800,800),
    0,0,[],1
  );
  for i := 0 to fChild.Count-1 do
  begin
    TSpliteBase(fChild[i]).Draw;
  end;
  if fPrintString<>'' then
  begin
    fCanvas.Fill.Color:=TAlphaColorRec.Blue;
    fCanvas.Font.Size:=30;
    fCanvas.FillText(
      RectF(100,300,700,400),fPrintString,
      False,1,[],
      TTextAlign.Center,TTextAlign.Center);
  end;
  if Assigned(fPlayer) then
  begin
  fCanvas.Fill.Kind:=TBrushKind.Solid;
  fCanvas.Fill.Color:=TAlphaColorRec.Aqua;
  fCanvas.Stroke.Kind:=TBrushKind.Solid;
  fCanvas.Stroke.Thickness:=2;
  fCanvas.Stroke.Color:=TAlphaColorRec.Aqua;
  fCanvas.FillRect(RectF(690,10,690+fPlayer.HP*10,20),0,0,[],1);
  end;
  fCanvas.Stroke.Kind:=TBrushKind.Solid;
  fCanvas.Stroke.Thickness:=2;
  fCanvas.Stroke.Color:=TAlphaColorRec.Aqua;
  fCanvas.DrawRect(RectF(690,10,790,20),0,0,[],1);
  fCanvas.EndScene;
end;

procedure TStage.DoFrame;
var k:SmallInt;
    JoyInfo:TJoyInfo;
begin
  if fStageState=TStageState.ssTitle then
  begin
    DrawTitle();
    k:=GetKeyState(VK_SPACE);
    if k<0 then
      fStageState:=TStageState.ssPlay;
    if joyGetPos(JOYSTICKID1,@JoyInfo)=JOYERR_NOERROR then
      if ((JoyInfo.wButtons and JOY_BUTTON1)=JOY_BUTTON1) or
         ((JoyInfo.wButtons and JOY_BUTTON2)=JOY_BUTTON2) then
        fStageState:=TStageState.ssPlay;
    if fStageState=TStageState.ssPlay then
    begin
      Clear();
      fPrintString:='';
      fFrame:=-1;
      fSenarioNum:=0;
      fPlayerDeadFrame:=0;
    end;
  end
  else
  begin
    DoSenario();
    DoMove();
    DoCollision();
    DoDraw();
    if not Assigned(fPlayer) then
      Inc(fPlayerDeadFrame);
    if fPlayerDeadFrame>200 then
      fStageState:=TStageState.ssTitle;
  end;
end;

procedure TStage.DoMove;
var i:Integer;
begin
  for i := 0 to fChild.Count-1 do
    TSpliteBase(fChild[i]).Move;
  for i := fChild.Count-1 downto 0 do
    if TSpliteBase(fChild[i]).State=TSpliteState.spDestroy then
    begin
      if Assigned(fPlayer) and (fChild[i]=fPlayer) then
        fPlayer:=nil;
      TSpliteBase(fChild[i]).Free;
      fChild.Delete(i);
    end;
end;

procedure TStage.DoSenario;
var StrArr:TArray<String>;
    b:TSpliteBase;
    i:Integer;
    Waiting:Boolean;
begin
  Waiting:=False;
  if fFrame=-1 then
  begin
    StrArr:=fSenarioList[fSenarioNum].Split([',']);
    fSenario.Action:=LowerCase(trim(StrArr[0]));
    fSenario.ObjName:=trim(StrArr[1]);
    fSenario.WaitFrame:=StrToInt(StrArr[2]);
    fSenario.x:=StrToFloat(StrArr[3]);
    fSenario.y:=StrToFloat(StrArr[4]);
    if fSenario.WaitFrame>0 then inc(fFrame);
  end;
  if (fSenario.Action='add') then
  begin
    if (fSenario.ObjName='TOwnShip') then
    begin
      b:=TPlayer.Create(self, fFieldBmp);
      b.Position:=PointF(fSenario.x,fSenario.y);
      fPlayer:=TPlayer(b);
    end
    else if (fSenario.ObjName='TEnemy1') then
    begin
      b:=TEnemy1.Create(self, fFieldBmp);
      b.Position:=PointF(fSenario.x,fSenario.y);
    end
    else if(fSenario.ObjName='TEnemy2') then
    begin
      b:=TEnemy2.Create(self, fFieldBmp);
      b.Position:=PointF(fSenario.x,fSenario.y);
    end
    else if (fSenario.ObjName='TBoss1') then
    begin
      b:=TBoss1.Create(self, fFieldBmp);
      b.Position:=PointF(fSenario.x,fSenario.y);
    end;
  end
  else if(fSenario.Action='print') then
  begin
    fPrintString:=fSenario.ObjName;
    if Assigned(fPlayer) then
      if fPrintString='' then
        fPlayer.CanShot:=True
      else
        fPlayer.CanShot:=False;
  end
  else if (fSenario.Action='wait') and (fSenario.ObjName<>'') then
  begin
    for i := 0 to fChild.Count-1 do
    begin
      if TSpliteBase(fChild[i]).ClassName=fSenario.ObjName then
      begin
        Waiting:=True;
        Break;
      end;
    end;
  end;

  if not Waiting then
  begin
    if fSenario.WaitFrame>0 then
    begin
      if fFrame>=fSenario.WaitFrame then
        fFrame:=-1
      else
        Inc(fFrame);
    end;
    if fFrame=-1 then
    begin
      if fSenario.Action='goto' then
        fSenarioNum:=Trunc(fSenario.x)
      else
        Inc(fSenarioNum);
      if fSenarioNum>(fSenarioList.Count-1) then fSenarioNum:=1;
      DoSenario();
    end;
  end;
end;

procedure TStage.DrawTitle;
begin
  fCanvas.BeginScene();
  fCanvas.Fill.Color:=$FF000000;
  fCanvas.Fill.Kind:=TBrushKind.Solid;
  fCanvas.FillRect(RectF(0,0,800,800), 0, 0, [], 1);
  fCanvas.Fill.Color:=TAlphaColorRec.Blue;
  fCanvas.Font.Size:=60;
  fCanvas.FillText(
    RectF(100,200,700,300), 'タイトル',
    False, 1, [], TTextAlign.Center, TTextAlign.Center
  );
  fCanvas.Fill.Color:=TAlphaColorRec.Blue;
  fCanvas.Font.Size:=40;
  fCanvas.FillText(
    RectF(100,600,700,700), 'Press the Space Key',
    False, 1, [], TTextAlign.Center,TTextAlign.Center);
  fCanvas.EndScene;
end;


{ TSpliteBase }
constructor TSpliteBase.Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);
begin
  inherited;
  fPosition.Create(0,0);
  fW:=64;
  fH:=64;
  fCollisionRect.Create(fW*0.05,fH*0.05,fW*0.95,fH*0.95);
  fAliveArea.Create(-100,-200,fFieldBmp.width+100,fFieldBmp.Height+100);
  fKind:=TSpliteKind.skEnemy;
  fHP:=1;
  fExplodeFrame:=0;
  FHitting:=0;
  fState:=TSpliteState.spExist;
  fExplodeList:=Form2.ImageList1;
end;

destructor TSpliteBase.Destroy;
begin
  inherited;
end;

procedure TSpliteBase.Draw;
var Opacity:Single;
begin
  if fHitting>0 then Opacity:=0.6 else Opacity:=1.0;
  if fState=TSpliteState.spExist then
  begin
    fCanvas.DrawBitmap(
      fBmp,
      RectF(0,0,fBmp.Width,fBmp.Height),
      RectF(fPosition.X,fPosition.Y,fPosition.X+fW,fPosition.Y+fH),
      Opacity
    );
  end
  else
  begin
    fExplodeList.Draw(
      fCanvas,
      RectF(fPosition.X,fPosition.Y,fPosition.X+fW,fPosition.Y+fH),
      trunc(fExplodeFrame)
    );
  end;
end;

function TSpliteBase.GetPosition:TPointF;
begin
  result:=fPosition;
end;

procedure TSpliteBase.IsCollision(target:TSpliteBase);
var SelRect,TarRect,AllRect:TRectF;
begin
  SelRect:=fCollisionRect;
  SelRect.Offset(fPosition);
  TarRect:=target.CollisionRect;
  TarRect.Offset(target.Position);
  AllRect.Left:=Min(SelRect.Left,TarRect.Left);
  AllRect.Right:=Max(SelRect.Right,TarRect.Right);
  AllRect.Top:=Min(SelRect.Top,TarRect.Top);
  AllRect.Bottom:=Max(SelRect.Bottom,TarRect.Bottom);
  if (AllRect.Width<SelRect.Width+TarRect.Width) and
     (AllRect.Height<SelRect.Height+TarRect.Height) then
  begin
    if target.HP>=fHP then
    begin
      target.HP:=Target.HP-fHP;
      if target.HP<=0 then
        target.State:=TSpliteState.spExplode;
      fHP:=0;
      fState:=TSpliteState.spExplode;
    end
    else
    begin
      fHP:=fHP-target.HP;
      if (fKind=TSpliteKind.skPlayer) or (fKind=TSpliteKind.skEnemy) then
        fHitting:=12;
      target.HP:=0;
      target.State:=TSpliteState.spExplode;
    end;
  end
  else
  begin
    if fHitting>0 then dec(fHitting);
  end;
end;

procedure TSpliteBase.SetPosition(pt: TPointF);
begin
  fPosition:=pt;
end;


{ TPlayer }
constructor TPlayer.Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);
begin
  inherited;
  fBmp:=Form2.Image1.Bitmap;
  fKind:=TSpliteKind.skPlayer;
  fHP:=10;
  fPosition.Create(450,700);
  fShotWaitCount:=0;
  fCanShot:=False;
end;

procedure TPlayer.Move;
var KeyState1,KeyState2:SmallInt;
    JoyInfo:TJoyInfo;
    Dx,Dy:Single;
    ShotFlag:Boolean;
    Splite:TSpliteBase;
begin
  if fState=TSpliteState.spExplode then
  begin
    fExplodeFrame:=fExplodeFrame+0.25;
    if fExplodeFrame>fExplodeList.Count then
      fState:=TSpliteState.spDestroy;
  end
  else
  begin
    Dx:=0;
    Dy:=0;
    ShotFlag:=False;
    if fShotWaitCount>0 then dec(fShotWaitCount);
    if (fShotWaitCount=0) and fCanShot then
    begin
      KeyState1:=GetKeyState(VK_SPACE);
      if KeyState1<0 then
      begin
        ShotFlag:=True;
        fShotWaitCount:=8;
      end;
    end;
    KeyState1:=GetKeyState(VK_LEFT);
    KeyState2:=GetKeyState(VK_NUMPAD4);
    if (KeyState1<0) or (KeyState2<0) then Dx:=-2;
    KeyState1:=GetKeyState(VK_UP);
    KeyState2:=GetKeyState(VK_NUMPAD8);
    if (KeyState1<0) or (KeyState2<0) then Dy:=-2;
    KeyState1:=GetKeyState(VK_RIGHT);
    KeyState2:=GetKeyState(VK_NUMPAD6);
    if (KeyState1<0) or (KeyState2<0) then Dx:=2;
    KeyState1:=GetKeyState(VK_DOWN);
    KeyState2:=GetKeyState(VK_NUMPAD2);
    if (KeyState1<0) or (KeyState2<0) then Dy:=2;

    if joyGetPos(JOYSTICKID1,@JoyInfo)=JOYERR_NOERROR then
    begin
      if (Dx=0) and (Dy=0) then
      begin
        Dx:=(Single(JoyInfo.wXpos)-32767.0)/32767*2;
        Dy:=(Single(JoyInfo.wYpos)-32767.0)/32767*2;
      end;
      //ボタン1,2
      if (fShotWaitCount=0) and fCanShot then
      begin
        if ((JoyInfo.wButtons and JOY_BUTTON1)=JOY_BUTTON1) or
           ((JoyInfo.wButtons and JOY_BUTTON2)=JOY_BUTTON2) then
        begin
          ShotFlag:=True;
          fShotWaitCount:=8;
        end;
      end;
    end;
    if ShotFlag then
    begin
      Splite:=TPlayerBullet.Create(fParent,fFieldBmp);
      TBullet1(Splite).Position:=PointF(fPosition.X+fW/2-Splite.W/2,fPosition.Y-Splite.H/2);
    end;
    Dx:=fPosition.X+Dx;
    Dy:=fPosition.Y+Dy;
    if Dx<0 then Dx:=0;
    if Dx>(fFieldBmp.Width-fW) then Dx:=fFieldBmp.Width-fW;
    if Dy<0 then Dy:=0;
    if Dy>(fFieldBmp.Height-fH) then Dy:=fFieldBmp.Height-fH;
    fPosition.X:=Dx;
    fPosition.Y:=Dy;
  end;
end;


{ TSplite }
constructor TSplite.Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);
begin
  inherited;
  fSenarioList:=TStringList.Create;
  fFrame:=-1;
  fSenarioNum:=0;
  fKind:=TSpliteKind.skEnemy;
end;

destructor TSplite.Destroy;
begin
  fSenarioList.Free;
  inherited;
end;

procedure TSplite.Move();
var StrArr:TArray<String>;
    Splite:TSpliteBase;
    i:Integer;
begin
  if fState=TSpliteState.spExplode then
  begin
    fExplodeFrame:=fExplodeFrame+0.25;
    if fExplodeFrame>fExplodeList.Count then fState:=TSpliteState.spDestroy;
  end
  else
  begin
    if fFrame=-1 then
    begin
      StrArr:=fSenarioList[fSenarioNum].Split([',']);
      fSenario.Action:=LowerCase(Trim(StrArr[0]));
      fSenario.Frame:=StrToInt(Trim(StrArr[1]));
      fSenario.Dx:=StrToFloat(Trim(StrArr[2]));
      fSenario.Dy:=StrToFloat(Trim(StrArr[3]));
      if fSenario.Frame>0 then inc(fFrame);
    end;
    if fSenario.Action='move' then
    begin
      fPosition.X:=fPosition.X+fSenario.Dx;
      fPosition.Y:=fPosition.Y+fSenario.Dy;
      if (fPosition.X<(fAliveArea.Left-fW)) or
         (fPosition.X>fAliveArea.Right) or
         (fPosition.Y<(fAliveArea.Top-fH)) or
         (fPosition.Y>fAliveArea.Bottom) then
      begin
        fState:=TSpliteState.spDestroy;
      end;
    end
    else if fSenario.Action='shot1' then
    begin
      Splite:=TBullet1.Create(fParent,fFieldBmp);
      TBullet1(Splite).Position:=
        PointF(fPosition.X+fW/2,fPosition.Y+fH);
      TBullet1(Splite).SenarioList.Clear;
      TBullet1(Splite).SenarioList.Add('move,100,0,4');
    end
    else if fSenario.Action='shot3' then
    begin
      i:=60;
      while i<=120 do
      begin
        Splite:=TBullet1.Create(fParent,fFieldBmp);
        TBullet1(Splite).Position:=
          PointF(
            fPosition.X+fW/2+Cos(i/180*Pi)*fW/2,
            fPosition.Y+fH/2+Sin(i/180*Pi)*fH/2
          );
        TBullet1(Splite).SenarioList.Clear;
        TBullet1(Splite).SenarioList.Add(
          format('move,100,%f,%f',[Cos(i/180*Pi)*4,Sin(i/180*Pi)*4])
        );
        inc(i,30);
      end;
    end
    else if fSenario.Action='shot5' then
    begin
      i:=60;
      while i<=120 do
      begin
        Splite:=TBullet1.Create(fParent,fFieldBmp);
        TBullet1(Splite).Position:=
          PointF(
            fPosition.X+fW/2+Cos(i/180*Pi)*fW/2,
            fPosition.Y+fH/2+Sin(i/180*Pi)*fH/2
          );
        TBullet1(Splite).SenarioList.Clear;
        TBullet1(Splite).SenarioList.Add(
          format('move,100,%f,%f',[Cos(i/180*Pi)*4,Sin(i/180*Pi)*4])
        );
        inc(i,15);
      end;
    end
    else if fSenario.Action='shot12' then
    begin
      i:=0;
      while i<360 do
      begin
        Splite:=TBullet1.Create(fParent,fFieldBmp);
        TBullet1(Splite).Position:=
          PointF(
            fPosition.X+fW/2+Cos(i/180*Pi)*fW/4-Splite.W/2,
            fPosition.Y+fH/2+Sin(i/180*Pi)*fH/4-Splite.H/2
          );
        TBullet1(Splite).SenarioList.Clear;
        TBullet1(Splite).SenarioList.Add(
          format('move,100,%f,%f',[Cos(i/180*Pi)*4,Sin(i/180*Pi)*4])
        );
        inc(i,30);
      end;
    end
    else if fSenario.Action='shot24' then
    begin
      i:=0;
      while i<360 do
      begin
        Splite:=TBullet1.Create(fParent,fFieldBmp);
        TBullet1(Splite).Position:=
          PointF(
            fPosition.X+fW/2+Cos(i/180*Pi)*fW/4-Splite.W/2,
            fPosition.Y+fH/2+Sin(i/180*Pi)*fH/4-Splite.H/2
          );
        TBullet1(Splite).SenarioList.Clear;
        TBullet1(Splite).SenarioList.Add(
          format('move,100,%f,%f,0,0',[Cos(i/180*Pi)*4,Sin(i/180*Pi)*4])
        );
        inc(i,15);
      end;
    end
    else if fSenario.Action='shot12c' then
    begin
      i:=0;
      while i<360 do
      begin
        Splite:=TBullet2.Create(fParent,fFieldBmp);
        TBullet2(Splite).Position:=
          PointF(
            fPosition.X+fW/2+Cos(i/180*Pi)*fW/4-Splite.W/2,
            fPosition.Y+fH/2+Sin(i/180*Pi)*fH/4-Splite.H/2
          );
        TBullet2(Splite).SenarioList.Clear;
        TBullet2(Splite).SenarioList.Add(
          format('move,100,%f,%f,0,0',[Cos(i/180*Pi)*4,Sin(i/180*Pi)*4])
        );
        inc(i,30);
      end;
    end
    else if fSenario.Action='goto' then
      fSenario.Frame:=-1;

    if fSenario.Frame>0 then
    begin
      if fFrame>=fSenario.Frame then
        fFrame:=-1
      else
        inc(fFrame);
    end;

    if fFrame=-1 then
    begin
      if fSenario.Action='goto' then
      begin
        fSenarioNum:=trunc(fSenario.Dx);
      end
      else
      begin
        inc(fSenarioNum);
        if fSenarioNum>(fSenarioList.Count-1) then fSenarioNum:=0;
      end;
      Move();
    end;
  end;
end;


{ TEnemy1 }
constructor TEnemy1.Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);
begin
  inherited;
  fBmp:=Form2.Image2.Bitmap;
  fSenarioList.Add('move ,100, 0, 1');
  fSenarioList.Add('shot1,  0, 0, 0');
  fHP:=2;
end;


{ TEnemy2 }
constructor TEnemy2.Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);
begin
  inherited;
  fBmp:=Form2.Image3.Bitmap;
  fSenarioList.Add('move ,100, 0, 1');
  fSenarioList.Add('shot3,  0, 0, 0');
  fHP:=2;
end;


{ TBoss1 }
constructor TBoss1.Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);
begin
  inherited;
  fBmp:=Form2.Image4.Bitmap;
  fSenarioList.Add('move  ,100, 0, 2');
  fSenarioList.Add('shot12c,  0, 0, 0');
  fSenarioList.Add('move  ,300, 1, 0');
  fSenarioList.Add('shot12c,  0, 0, 0');
  fSenarioList.Add('move  ,300, 0, 1');
  fSenarioList.Add('shot12c,  0, 0, 0');
  fSenarioList.Add('move  ,300,-1, 0');
  fSenarioList.Add('shot12c,  0, 0, 0');
  fSenarioList.Add('wait  ,100, 0, 0');
  fSenarioList.Add('shot12c,  0, 0, 0');
  fSenarioList.Add('move  ,300,-1, 0');
  fSenarioList.Add('shot12c,  0, 0, 0');
  fSenarioList.Add('move  ,300, 0,-1');
  fSenarioList.Add('shot12c,  0, 0, 0');
  fSenarioList.Add('move  ,300, 1, 0');
  fSenarioList.Add('shot24,  0, 0, 0');
  fSenarioList.Add('wait  ,100, 0, 0');
  fSenarioList.Add('goto  ,  0, 1, 0');
  fW:=300 div 2;
  fH:=500 div 2;
  fCollisionRect.Create(fW*0.1,fH*0.05,fW*0.9,fH*0.95);
  fKind:=TSpliteKind.skEnemy;
  fHP:=300;
end;


{ TBullet1 }
constructor TBullet1.Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);
begin
  inherited;
  fBmp:=Form2.Image5.Bitmap;
  fSenarioList.Add('move,100,0,4,0,0');
  fW:=16;
  fH:=16;
  fCollisionRect.Left:=fW*0.1;;
  fCollisionRect.Top:=fH*0.1;
  fCollisionRect.Right:=fW*0.9;
  fCollisionRect.Bottom:=fH*0.9;
  fKind:=TSpliteKind.skEnemyBullet;
  fHP:=1;
end;


{ TBullet2 }
constructor TBullet2.Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);
begin
  inherited;
  fBmp:=Form2.Image6.Bitmap;
  fSenarioList.Add('move,100,2,2,0,0');
  fW:=32;
  fH:=32;
  fCollisionRect.Left:=fW*0.1;;
  fCollisionRect.Top:=fH*0.1;
  fCollisionRect.Right:=fW*0.9;
  fCollisionRect.Bottom:=fH*0.9;
  fKind:=TSpliteKind.skEnemyBullet;
  fHP:=2;
end;


{ TPlayerBullet }
constructor TPlayerBullet.Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);
begin
  inherited;
  fBmp:=Form2.Image7.Bitmap;
  fSenarioList.Add('move,100,0,-5,0,0');
  fW:=16;
  fH:=16;
  fCollisionRect.Create(fW*0.1,fH*0.1,fW*0.9,fH*0.9);
  fKind:=TSpliteKind.skPlayerBullet;
  fHP:=1;
end;


end.

Form1（Unit1）のソースコードの記述

「Shift + F12」キーを押してForm1(Unit1)に切り替えて、Form1の何もないところをダブルクリック（コードエディタに切り替わる）して以下ソースコードを記述します。

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  FMX.Layouts, FMX.Controls.Presentation, FMX.StdCtrls,
  Unit2, FMX.ScrollBox, FMX.Memo, FMX.Memo.Types;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private 宣言 }
    Stage:TStage;
    TimePrevious:Integer;
    procedure Idle(Sender:TObject;var done:boolean);
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}
uses System.Math, Winapi.MMSystem;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form2:=TForm2.Create(nil);
  Image1.Align:=TAlignLayout.Fit;
  Image1.WrapMode:=TImageWrapMode.Fit;
  Image1.Width:=Min(self.ClientWidth,self.ClientHeight);
  Image1.Height:=Min(self.ClientWidth,self.ClientHeight);
  //画像サイズは800×800固定とします。
  //ウィンドウを800×800以上に拡大すると画像がぼやけますが拡大表示されます。
  Image1.Bitmap.Width:=800;
  Image1.Bitmap.Height:=800;
  Stage:=TStage.Create(nil,Image1.Bitmap);
  TimePrevious:=0;
  timeBeginPeriod(1); //分解能を1msに設定
  Application.OnIdle:=Idle;
  WindowState:=TWindowState.wsMaximized;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Stage.Free;
  Form2.Free;
  timeEndPeriod(1);  //分解能を元に戻す
end;

procedure TForm1.Idle(Sender: TObject;var done:boolean);
const FPS:Integer=60;  //60フレームで動作させる
var TimePerFrame,TimeNow,TimeDiff:Integer;
begin
  TimePerFrame:=Trunc(1000/FPS);//1フレーム当たりのミリ秒を計算
  done:=False;//連続して呼び出される
  if TimePrevious=0 then
    TimePrevious:=timeGetTime()
  else
  begin
    TimeNow:=timeGetTime();
    TimeDiff:=TimeNow-TimePrevious;
    if TimeDiff>=TimePerFrame then
    begin
      if TimeDiff>TimePerFrame then
        TimeDiff:=Min(TimeDiff-TimePerFrame,TimePerFrame);
      TimePrevious:=TimeNow-TimeDiff;
      Stage.DoFrame;
    end;
  end;
end;

end.

実行画面

［実行］⇒［実行 F9］Delphi IDEを起動して[ファイル]⇒[新規作成]⇒[マルチデバイス アプリケーション - Delphi]をクリックします。

ソースコード一式ダウンロード

クラス階層図

クラスの階層は以下のようになっています。

TBase
  ├─TStage
  └─TSpliteBase
        ├─TPlayer
        └─TSplite
              ├─TEnemy1
              ├─TEnemy2
              ├─TBoss1
              ├─TBullet1
              ├─TBullet2
              └─TPlayerBullet

各クラスの概要

TBase=class(TObject)

全てのクラスはこのクラスを基底として派生する。 子オブジェクトをTList型フィールド変数【fChild】で最低限管理する機能のみが備わっている。

strict privateメソッド

procedure AddChild(Obj:TBase);

objを子オブジェクトとして「fChild:TList;」に追加する

publicメソッド

Constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);virtual;

コンストラクタ

Destructor Destroy();override;

デストラクタ
全ての子オブジェクトを破棄する

TStage=class(TBase)

全体を管理するクラス。
フィールド変数「fSenarioList」にシナリオを入れるとシナリオを解釈して実行する。

strict privateメソッド

procedure DoMove();

子オブジェクトの移動(Move)メソッドを呼ぶ

procedure DoCollision();

子オブジェクトの衝突判定(IsCollision)メソッドを呼ぶ

procedure DoDraw();

ステージの描画

procedure DoSenario();

ステージ全体シナリオを解釈して実行する

procedure DrawTitle();

タイトルの描画と開始待ち

procedure Clear();

子オブジェクトの破棄、子オブジェクトリストのクリア

publicメソッド

Constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);virtual;

コンストラクタ
ステージ全体のシナリオを設定する

Destructor Destroy();override;

デストラクタ

procedure DoFrame();

全体の進行を行う。

開始していない時

DrawTitle();を呼ぶ
キー又はボタンの入力待ち

開始中

子オブジェクトの以下メソッドを呼ぶ
DoSenario();
DoMove();
DoCollision();
DoDraw();

TSpliteBase=class(TBase)

表示（Drawメソッド）、衝突判定（IsCollisionメソッド）機能を備えたクラス。
TSpliteKind型フィールド変数【fKind】で「プレイヤー」「敵」「弾」「プレイヤーの弾」の区分をしている。
TSpliteKind=(skPlayer,skPlayerBullet,skEnemy,skEnemyBullet)

publicメソッド

procedure Move();virtual;abstract;

移動用の仮想メソッド。実装は派生クラスで行う。

procedure Draw();virtual;

描画メソッド

procedure IsCollision(target:TSpliteBase);virtual;

衝突判定メソッド

Constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);virtual;

コンストラクタ

Destructor Destroy();override;

デストラクタ

TPlayer=class(TSpliteBase)

プレイヤーの機能を備えたクラス。
入力（キーボード・ジョイスティック）による移動（Moveメソッド）機能を備えたクラス。

publicメソッド

procedure Move();override;

キー、ボタン、スティック入力で移動機能を備えたメソッド

Constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);virtual;

コンストラクタ

Destructor Destroy();override;

デストラクタ

TSplite=class(TSpliteBase)

フィールド変数「fSenarioList」にシナリオを入れるとシナリオを解釈して移動（Moveメソッド）する機能を備えたクラス。

publicメソッド

procedure Move();override;

シナリオを解釈してアクション（移動など）を行う機能を備えたメソッド

Constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);virtual;

コンストラクタ

Destructor Destroy();override;

デストラクタ

TEnemy1=class(TSplite)

敵１のクラス

publicメソッド

Constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);virtual;

コンストラクタ
シナリオの設定、画像の設定、大きさの設定、衝突判定範囲の設定等を行う

TEnemy2=class(TSplite)

敵２のクラス

publicメソッド

Constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);virtual;

コンストラクタ
シナリオの設定、画像の設定、大きさの設定、衝突判定範囲の設定等を行う

TBoss1=class(TSplite)

ボス１のクラス

publicメソッド

Constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);virtual;

コンストラクタ
シナリオの設定、画像の設定、大きさの設定、衝突判定範囲の設定等を行う

TBullet1=class(TSplite)

敵の弾のクラス

publicメソッド

Constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);virtual;

コンストラクタ
シナリオの設定、画像の設定、大きさの設定、衝突判定範囲の設定等を行う

TBullet2=class(TSplite)

敵の弾のクラス

publicメソッド

Constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);virtual;

コンストラクタ
シナリオの設定、画像の設定、大きさの設定、衝突判定範囲の設定等を行う

TPlayerBullet=class(TSplite)

プレイヤーの弾のクラス

publicメソッド

Constructor Create(Parent:TBase;FieldBmp:FMX.Graphics.TBitmap);virtual;

コンストラクタ
シナリオの設定、画像の設定、大きさの設定、衝突判定範囲の設定等を行う

シナリオの解説

TStage.CreateでシナリオをfSenarioList(TStringList型)に入れるとシナリオを解釈してステージを進めます。
シナリオには以下の種類があります。

TSpliteの派生クラスではシナリオをfSenarioList(TStringList型)に入れるとシナリオを解釈して移動したり弾を発射します。
シナリオには以下の種類があります。