Delphiで作る3Dシューティングゲーム開発【全ソースコード付】 ～Delphiソースコード集

Delphiで作る3Dシューティングゲーム開発【全ソースコード付】 ～Delphiソースコード集

Delphi Community Edition(12)で3D表示のシューティングゲームを作成します。
表示が3Dなだけで内部的には2Dです。
Delphiの3Dはゲーム用のライブラリではない為、使用が少し面倒です。

プロジェクトの作成と画面設計

[ファイル]⇒[新規作成]⇒[マルチデバイス アプリケーション -Delphi]をクリックし「空のアプリケーション」を選択して「OK」ボタンを押して、新規プロジェクトを作成します。
[ファイル]⇒[すべて保存]をクリックして、プロジェクト用のディレクトリを作成し、プロジェクト(Project1)とユニット(Unit1)を保存します。

フォーム(Form1)に右下のペイン[ツールパレット]から「TViewport3D」をドラッグ＆ドロップします。
「Viewport3D1」に右下のペイン[ツールパレット]から「TSphere」×３つ、「TLightMaterialSource」をドラッグ&ドロップします。
以下のプロパティを設定します。

モデリングデータを以下からダウンロードします。
obj_mtl.zip(30KB)ダウンロード
解凍すると以下６つのファイルが生成されます。
self.obj、self.mtl、enemy.obj、enemy.mtl、ship.obj、ship.mtl

「Viewport3D1」に右下のペイン[ツールパレット]から「TModel3D」を３つドラッグ＆ドロップします。

以下のプロパティを設定します。

ソースコードの記述

キーボードの「F12」キーを押して「コード」エディタに切り替え、以下ソースコードを貼り付けます。
キーボードの「F12」キーを押して「デザイン」エディタに切り替えます。 左上ペイン「構造」にある「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.Viewport3D, FMX.Objects3D, System.Math.Vectors, FMX.Controls3D,
  FMX.Types3D, FMX.MaterialSources{,FMX.Layers3D};

type
  TStage=class;

  TForm1 = class(TForm)
    Viewport3D1: TViewport3D;
    Sphere1: TSphere;
    Sphere2: TSphere;
    Sphere3: TSphere;
    LightMaterialSource1: TLightMaterialSource;
    LightMaterialSource2: TLightMaterialSource;
    LightMaterialSource3: TLightMaterialSource;
    Model3D1: TModel3D;
    Model3D2: TModel3D;
    Model3D3: TModel3D;
    Model3D1Mat11: TLightMaterialSource;
    Model3D1Mat21: TLightMaterialSource;
    Model3D2Mat11: TLightMaterialSource;
    Model3D2Mat21: TLightMaterialSource;
    Model3D3Mat11: TLightMaterialSource;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private 宣言 }
    Stage:TStage;
    TimePrevious:Integer;
    procedure Idle(Sender:TObject;var done:boolean);
  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;
    fParentObj:TFmxObject;
  public
    procedure ClearChild();
    Constructor Create(Parent:TBase;ParentObj:TFmxObject);virtual;
    Destructor Destroy();override;
  end;

  TPlayer=class;

  TStage=class(TBase)
  strict private
    const fTitle='タイトル';
    const fSub='Push Space Key.';
    procedure DoMove();
    procedure DoCollision();
    procedure DoDraw();
    procedure DoSenario();
    procedure DrawTitle();
  strict protected
    fSenarioList:TStringList;
    fSenario:TStageSenario;
    fFrame:Integer;
    fSenarioNum:Integer;
    fPrintString:String;
    fStageState:TStageState;
    fPlayer:TPlayer;
    fPlayerDeadFrame:Integer;
    fText:TText3D;
    fText2:TText3D;
    fGrid3D:TGrid3D;
    fLight:TLight;
    fViewPort:TViewport3D;
    fCamera:FMX.Controls3D.TCamera;
    fDummy:TDummy;
  public
    constructor Create(Parent:TBase;ParentObj:TFmxObject);override;
    Destructor Destroy();override;
    procedure DoFrame();
  end;

  TSpliteBase=class(TBase)
  strict private
    function GetPosition():TPointF;
    procedure SetPosition(pt:TPointF);
  strict protected
    fW,fH,fD:Single;
    fCollisionRect:TRectF;
    fKind:TSpliteKind;
    fAliveArea:TRectF;
    fHP:Single;
    fState:TSpliteState;
    fExplodeFrame:Single;
    fPosition:TPointF;
    fProxy:TProxyObject;
  public
    property Position:TPointF read GetPosition write SetPosition;
    property W:Single read fW;
    property H:Single read fH;
    property D:Single read fD;
    property HP:Single read fHP write fHP;
    property Kind:TSpliteKind read fKind;
    property State:TSpliteState read fState write FState;
    property CollisionRect:TRectF read fCollisionRect;
    property Proxy:TProxyObject read fProxy write fProxy;
    procedure Move();virtual;abstract;
    procedure Draw();virtual;
    procedure IsCollision(target:TSpliteBase);virtual;
    Destructor Destroy();override;
    constructor Create(Parent:TBase;ParentObj:TFmxObject);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;ParentObj:TFmxObject);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;ParentObj:TFmxObject);override;
  end;

  TEnemy1=class(TSplite)
  public
    constructor Create(Parent:TBase;ParentObj:TFmxObject);override;
  end;

  TEnemy2=class(TSplite)
  public
    constructor Create(Parent:TBase;ParentObj:TFmxObject);override;
  end;

  TBoss1=class(TSplite)
  public
    constructor Create(Parent:TBase;ParentObj:TFmxObject);override;
  end;

  TBullet1=class(TSplite)
  public
    constructor Create(Parent:TBase;ParentObj:TFmxObject);override;
  end;

  TBullet2=class(TSplite)
  public
    constructor Create(Parent:TBase;ParentObj:TFmxObject);override;
  end;

  TPlayerBullet=class(TSplite)
  public
    constructor Create(Parent:TBase;ParentObj:TFmxObject);override;
  end;


var
  Form1: TForm1;

implementation

{$R *.fmx}

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

{TForm1}

procedure TForm1.FormCreate(Sender: TObject);
begin
  //X→、Y↓、Z奥
  Viewport3D1.Width:=800;
  Viewport3D1.Height:=800;
  Viewport3D1.Align:=TAlignLayout.Fit;
  Viewport3D1.Margins.Create(RectF(8,8,8,8));
  Viewport3D1.Color:=TAlphaColorRec.Black;

  Sphere1.Visible:=False;
  Sphere2.Visible:=False;
  Sphere3.Visible:=False;

  Model3D1.Visible:=False;
  Model3D2.Visible:=False;
  Model3D3.Visible:=False;
  Model3D1.WrapMode:=TMeshWrapMode.Original;
  Model3D2.WrapMode:=TMeshWrapMode.Original;
  Model3D3.WrapMode:=TMeshWrapMode.Original;

  Stage:=TStage.Create(nil,Viewport3D1);
  TimePrevious:=0;
  timeBeginPeriod(1); //分解能を1msに設定
  Application.OnIdle:=Idle;
  WindowState:=TWindowState.wsMaximized;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Stage.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フレーム当たりのミリ秒を計算
  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;
      Viewport3D1.BeginUpdate;
      Stage.DoFrame;
      Viewport3D1.EndUpdate;
      Viewport3D1.Repaint;
    end;
  end;
  done:=False;//連続して呼び出される
end;


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

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

constructor TBase.Create(Parent:TBase;ParentObj:TFmxObject);
begin
  fParent:=Parent;
  fParentObj:=ParentObj;
  fChild:=TList.Create;
  if Assigned(fParent) then fParent.AddChild(self);
end;

destructor TBase.Destroy;
begin
  //子オブジェクトの破棄
  ClearChild();
  fChild.Free;
  inherited;
end;


{ TStage }
constructor TStage.Create(Parent:TBase;ParentObj:TFmxObject);
begin
  inherited Create(Parent,ParentObj);
  fCamera:=FMX.Controls3D.TCamera.Create(fParentObj);
  fCamera.Parent:=(fParentObj);
  fCamera.Position.Point:=Point3D(40,40,-100);
  fCamera.AngleOfView:=50;
  TViewport3D(fParentObj).Camera:=fCamera;
  TViewport3D(fParentObj).UsingDesignCamera:=False;

  fLight:=TLight.Create(ParentObj);
  fLight.Parent:=ParentObj;
  fLight.RotationAngle.Point:=Point3D(45,30,0);

  fDummy:=TDummy.Create(ParentObj);
  fDummy.Parent:=ParentObj;
  fDummy.SetSize(800,800,1);
  fDummy.Scale.Point:=Point3D(0.1, 0.1, 0.1);

  fPrintString:='';
  fFrame:=-1;
  fSenarioNum:=0;
  fPlayer:=nil;
  fText:=TText3D.Create(fDummy);
  fText.Parent:=fDummy;
  fText.Position.Point:=Point3D(400, 100, 0);
  fText.SetSize(800, 80, 0);
  fText.Font.Size:=80;
  fText.Text:=fTitle;
  fText.MaterialSource:=Form1.LightMaterialSource3;
  //以下のようにフロントだけにしないと激重になる（バージョンによるかも）
  fText.Sides:=[TExtrudedShapeSide.Front];

  fText2:=TText3D.Create(fDummy);
  fText2.Parent:=fDummy;
  fText2.Position.Point:=Point3D(400,700,0);
  fText2.SetSize(800,40,0);
  fText2.Font.Size:=40;
  fText2.Text:=fSub;
  fText2.MaterialSource:=Form1.LightMaterialSource3;
  //以下のようにフロントだけにしないと激重になる（バージョンによるかも）
  fText2.Sides:=[TExtrudedShapeSide.Front];

  fGrid3D:=TGrid3D.Create(fDummy);
  fGrid3D.Parent:=fDummy;
  fGrid3D.Frequency:=50;
  fGrid3d.Marks:=4;
  fGrid3D.SetSize(800,800,0.01);
  fGrid3D.Position.Point:=Point3D(400,400,25);
  fGrid3D.Opacity:=0;

  fStageState:=TStageState.ssTitle;
  fSenarioList:=TStringList.Create;
  fSenarioList.Add('add  ,TOwnShip,  0,400, 700');
  fSenarioList.Add('print,Stage1  ,120,  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
  for i := 0 to fChild.Count-1 do
  begin
    TSpliteBase(fChild[i]).Draw;
  end;
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
      fText.Text:='';
      fText2.Text:='';
      fGrid3D.Opacity:=0;
      ClearChild();
      fPrintString:='';
      fFrame:=-1;
      fSenarioNum:=0;
      fPlayerDeadFrame:=0;
      TAnimator.AnimateFloat(fGrid3D,'Opacity',1,0.4);
      TAnimator.AnimateFloat(fCamera,'Position.Y',80,0.8);
      TAnimator.AnimateFloat(fCamera,'Position.Z',-92,0.8);
      TAnimator.AnimateFloat(fCamera,'RotationAngle.X',20,0.8);
    end;
  end
  else
  begin
    DoSenario();
    DoMove();
    DoCollision();
    DoDraw();
    if not Assigned(fPlayer) then
      Inc(fPlayerDeadFrame);
    if fPlayerDeadFrame>200 then
    begin
      ClearChild;
      fStageState:=TStageState.ssTitle;
      TAnimator.AnimateFloat(fGrid3D, 'Opacity', 0, 0.2);
      TAnimator.AnimateFloat(fCamera, 'Position.Y', 40, 0.8);
      TAnimator.AnimateFloat(fCamera, 'Position.Z', -100, 0.8);
      TAnimator.AnimateFloat(fCamera, 'RotationAngle.X', 0, 0.8);
      fText.Text:=fTitle;
      fText2.Text:=fSub;
    end;
  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, fDummy);
      b.Position:=PointF(fSenario.x,fSenario.y);
      fPlayer:=TPlayer(b);
    end
    else if (fSenario.ObjName='TEnemy1') then
    begin
      b:=TEnemy1.Create(self, fDummy);
      b.Position:=PointF(fSenario.x,fSenario.y);
    end
    else if(fSenario.ObjName='TEnemy2') then
    begin
      b:=TEnemy2.Create(self, fDummy);
      b.Position:=PointF(fSenario.x,fSenario.y);
    end
    else if (fSenario.ObjName='TBoss1') then
    begin
      b:=TBoss1.Create(self, fDummy);
      b.Position:=PointF(fSenario.x,fSenario.y);
    end;
  end
  else if(fSenario.Action='print') then
  begin
    fPrintString:=fSenario.ObjName;
    if fText.Text<>fPrintString then fText.Text:=fPrintString;
    if Assigned(fPlayer) then
    begin
      if fPrintString='' then
        fPlayer.CanShot:=True
      else
        fPlayer.CanShot:=False;
    end;
  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
      Inc(fFrame);
      if fFrame>=fSenario.WaitFrame then fFrame:=-1;
    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
  //タイトル画面で何かするならここに記述
end;


{ TSpliteBase }
constructor TSpliteBase.Create(Parent:TBase;ParentObj:TFmxObject);
begin
  inherited;
  fPosition.Create(0,0);
  fW:=64;
  fH:=64;
  fD:=64;
  fCollisionRect.Create(fW*0.05,fH*0.05,fW*0.95,fH*0.95);
  fAliveArea.Create(-100,-200,TDummy(fParentObj).width+100,TDummy(fParentObj).Height+100);
  fKind:=TSpliteKind.skEnemy;
  fHP:=1;
  fExplodeFrame:=0;
  fState:=TSpliteState.spExist;
  fProxy:=TProxyObject.Create(fParentObj);
  fProxy.Parent:=fParentObj;
  fProxy.Scale.Point:=Point3D(fW, fH, fD);
end;

destructor TSpliteBase.Destroy;
begin
  fProxy.Free;
  inherited;
end;

procedure TSpliteBase.Draw;
begin
  fProxy.Position.Point:=Point3D(fPosition.X,fPosition.Y,0);
  if fState=TSpliteState.spExplode then
  begin
    fProxy.Scale.Point:=Point3D(
      fW-Abs(fW*2/3*(30-fExplodeFrame)/60),
      fH-Abs(fH*2/3*(30-fExplodeFrame)/60),
      fD-Abs(fD*2/3*(30-fExplodeFrame)/60)
    );
    fProxy.RotationAngle.Y:=fExplodeFrame*3;
  end;
end;

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

procedure TSpliteBase.IsCollision(target:TSpliteBase);
var SelRect,TarRect,AllRect:TRectF;
    SelPos,TarPos:TPointF;
begin
  SelRect:=fCollisionRect;
  SelPos:=fPosition;
  SelPos.Offset(-fW/2,-fH/2);
  SelRect.Offset(SelPos);
  TarRect:=target.CollisionRect;
  TarPos:=Target.Position;
  TarPos.Offset(-Target.W/2,-Target.H/2);
  TarRect.Offset(TarPos);
  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
      begin
        target.HP:=0;
        target.State:=TSpliteState.spExplode;
        target.Proxy.SourceObject:=Form1.Sphere1;
      end;
      fHP:=0;
      fState:=TSpliteState.spExplode;
      fProxy.SourceObject:=Form1.Sphere1;
    end
    else
    begin
      fHP:=fHP-target.HP;
      target.HP:=0;
      target.State:=TSpliteState.spExplode;
      target.Proxy.SourceObject:=Form1.Sphere1;
    end;
  end;
end;

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


{ TPlayer }
constructor TPlayer.Create(Parent:TBase;ParentObj:TFmxObject);
begin
  inherited;
  fProxy.SourceObject:=Form1.Model3D1;
  fKind:=TSpliteKind.skPlayer;
  fHP:=10;
  fPosition:=PointF(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+1;
    if fExplodeFrame>60 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,fParentObj);
      TBullet1(Splite).Position:=PointF(fPosition.X,fPosition.Y-fW/2);
    end;
    Dx:=fPosition.X+Dx;
    Dy:=fPosition.Y+Dy;
    if Dx<(fW/2) then Dx:=fW/2;
    if Dx>(TDummy(fParentObj).Width-fW/2) then Dx:=TDummy(fParentObj).Width-fW/2;
    if Dy<(fH/2) then Dy:=(fH/2);
    if Dy>(TDummy(fParentObj).Height-fH/2) then Dy:=TDummy(fParentObj).Height-fH/2;

    fPosition:=PointF(Dx,Dy);
    fProxy.Position.Point:=Point3D(fPosition.X,fPosition.Y,0);
  end;
end;


{ TSplite }
constructor TSplite.Create(Parent:TBase;ParentObj:TFmxObject);
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+1;
    if fExplodeFrame>60 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,fParentObj);
      TBullet1(Splite).Position:=
        PointF(fPosition.X,fPosition.Y+fH/2);
      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,fParentObj);
        TBullet1(Splite).Position:=
          PointF(
            fPosition.X+Cos(i/180*Pi)*fW/2,
            fPosition.Y+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,fParentObj);
        TBullet1(Splite).Position:=
          PointF(
            fPosition.X+Cos(i/180*Pi)*fW/2,
            fPosition.Y+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,fParentObj);
        TBullet1(Splite).Position:=
          PointF(
            fPosition.X+Cos(i/180*Pi)*fW/4-Splite.W/2,
            fPosition.Y+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,fParentObj);
        TBullet1(Splite).Position:=
          PointF(
            fPosition.X+Cos(i/180*Pi)*fW/4-Splite.W/2,
            fPosition.Y+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)*3,Sin(i/180*Pi)*3])
        );
        inc(i,15);
      end;
    end
    else if fSenario.Action='shot24a' then
    begin
      i:=8;
      while i<368 do
      begin
        Splite:=TBullet1.Create(fParent,fParentObj);
        TBullet1(Splite).Position:=
          PointF(
            fPosition.X+Cos(i/180*Pi)*fW/4-Splite.W/2,
            fPosition.Y+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)*3,Sin(i/180*Pi)*3])
        );
        inc(i,15);
      end;
    end
    else if fSenario.Action='shot12c' then
    begin
      i:=0;
      while i<360 do
      begin
        Splite:=TBullet2.Create(fParent,fParentObj);
        TBullet2(Splite).Position:=
          PointF(
            fPosition.X+Cos(i/180*Pi)*fW/4-Splite.W/2,
            fPosition.Y+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;ParentObj:TFmxObject);
begin
  inherited;
  fProxy.SourceObject:=Form1.Model3D2;
  fSenarioList.Add('move ,100, 0, 1');
  fSenarioList.Add('shot1,  0, 0, 0');
  fHP:=2;
  fProxy.Scale.Point:=Point3D(fW,fH,fD);
end;


{ TEnemy2 }
constructor TEnemy2.Create(Parent:TBase;ParentObj:TFmxObject);
begin
  inherited;
  fProxy.SourceObject:=Form1.Model3D2;
  fSenarioList.Add('move ,100, 0, 1');
  fSenarioList.Add('shot3,  0, 0, 0');
  fHP:=2;
  fProxy.Scale.Point:=Point3D(fW,fH,fD);
end;


{ TBoss1 }
constructor TBoss1.Create(Parent:TBase;ParentObj:TFmxObject);
begin
  inherited;
  fProxy.SourceObject:=Form1.Model3D3;
  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  ,60, 0, 0');
  fSenarioList.Add('shot24a,  0, 0, 0');
  fSenarioList.Add('wait  ,60, 0, 0');
  fSenarioList.Add('shot24,  0, 0, 0');
  fSenarioList.Add('wait  ,100, 0, 0');
  fSenarioList.Add('shot24a,  0, 0, 0');
  fSenarioList.Add('wait  ,60, 0, 0');
  fSenarioList.Add('shot24,  0, 0, 0');
  fSenarioList.Add('wait  ,100, 0, 0');
  fSenarioList.Add('goto  ,  0, 1, 0');
  fW:=200;
  fH:=300;
  fD:=180;
  fCollisionRect:=RectF(fW*0.1,fH*0.05,fW*0.9,fH*0.95);
  fKind:=TSpliteKind.skEnemy;
  fHP:=300;
  fProxy.Scale.Point:=Point3D(fW,fH,fD);
end;


{ TBullet1 }
constructor TBullet1.Create(Parent:TBase;ParentObj:TFmxObject);
begin
  inherited;
  fProxy.SourceObject:=Form1.Sphere2;
  fSenarioList.Add('move,100,0,4,0,0');
  fW:=16;
  fH:=16;
  fD:=16;
  fCollisionRect:=RectF(fW*0.1,fH*0.1,fW*0.9,fH*0.9);
  fKind:=TSpliteKind.skEnemyBullet;
  fHP:=1;
  fProxy.Scale.Point:=Point3D(fW,fH,fD);
end;


{ TBullet2 }
constructor TBullet2.Create(Parent:TBase;ParentObj:TFmxObject);
begin
  inherited;
  fProxy.SourceObject:=Form1.Sphere2;
  fSenarioList.Add('move,100,2,2,0,0');
  fW:=32;
  fH:=32;
  fD:=32;
  fCollisionRect:=RectF(fW*0.1,fH*0.1,fW*0.9,fH*0.9);
  fKind:=TSpliteKind.skEnemyBullet;
  fHP:=2;
  fProxy.Scale.Point:=Point3D(fW,fH,fD);
end;


{ TPlayerBullet }
constructor TPlayerBullet.Create(Parent:TBase;ParentObj:TFmxObject);
begin
  inherited;
  fSenarioList.Add('move,100,0,-5,0,0');
  fProxy.SourceObject:=Form1.Sphere3;
  fW:=16;
  fH:=16;
  fD:=16;
  fCollisionRect:=RectF(fW*0.1,fH*0.1,fW*0.9,fH*0.9);
  fKind:=TSpliteKind.skPlayerBullet;
  fHP:=1;
  fProxy.Scale.Point:=Point3D(fW,fH,fD);
end;


end.

実行

［実行］⇒［実行］をクリックして実行します。

注意した点など

バージョンに依存するのかもしれないですが、以下のような問題点が発生して工夫をしなければなりませんでした。

TText3DのSidesプロパティ

プロパティの値が Sides = [Front,Back,Shaft] だと全体的に表示がかなり重くなりました。
Sides = [Front] に変更すると表示が軽くなった。

TModel3DのWrapModeプロパティ

MeshCollectionプロパティにOBJファイル(3Dモデリングファイル)を読み込んだ時に
WrapMode = Fit だと、TModel3Dの幅・高さ・奥行きにフィットせず、幅・高さ・奥行きの２／１にフィットする場合があった。
WrapMode = Original に変更し、OBJファイルの原点を(0, 0, 0)で幅・高さ・奥行きの大きさが1になるようにモデリングして対応した。
OBJファイルの問題なのか、ライブラリの不具合なのかは不明。

TProxyObjectの挙動

TProxyObjectは3Dモデル(TModel3D)を参照して同一の3Dモデルを複数表示するのに欠かせないのですがTProxy自体は光の影響を受けない。
例えばTProxyObjectが参照している3Dモデル(TModel3D)に光が当たっていていなくてTProxyObjectに光が当たっていても、光が当たっていない状態で表示される。

材質（TLightMaterialSource）オブジェクトの生成について

3Dモデルファイル(OBJファイル)に材質設定(MTLファイル)があり、例えば１０個の材質設定があるとTLightMaterialSourceオブジェクトが１０個生成される。
複数のOBJファイルとマテリアル（材質）ファイルを使用するとフォーム上に大量のTLightMaterialSourceオブジェクトが生成されてしまう。
更にOBJファイルの再取り込みを行うと追加でTLightMaterialSourceオブジェクトが生成されるので、以前の不要なTLightMaterialSourceオブジェクトがどれか判りにくくなる。
よって、なるべく材質を少なくした3Dモデリングを行った方が良いと思います。

別Unit（フォーム）のTModel3DオブジェクトやTLightMaterialSourceオブジェクトを参照した場合

Unit1のTForm1にあるTViewport3D上にTProxyObjectオブジェクトを置いて、Unit2のTForm2にあるTModel3DオブジェクトやTLightMaterialSourceオブジェクトを参照すると、実行時にエラーになって動かない。
よって、1つのユニット内で全てのソースを記述しました。
もしかしたら方法が有るのかもしれないですが。

TCameraの撮影範囲

TCameraは距離１(near)～１０００(far)のオブジェクトを表示します。
この値(near,far)はライブラリで固定されていて変更することが出来ない。
TDummyをScaleプロパティ(0.1, 0.1, 0.1)等で親オブジェクトとして使用し1/10倍単位にするなど工夫が必要。

その他

Delphiの3D座標系が X軸は右方向（→）、Y軸は下方向（↓）、Z軸は奥行き方向（奥）なので、 ローカル座標系として空間座標変換を行うために TDummyを置いてScaleプロパティを（1, -1, -1）に設定しても、思った通りの座標系にならないと思われる。

ご参考

機体のモデリングにはShade3Dを使用しました。

最後に

Delphi Community Edition（Delphi 12）で作成した3Dシューティングゲームの全ファイル一式（コンパイルした実行用exeファイル含む）を以下からダウンロードできます。
fmx_3d_shooting.zip(9,081KB)ダウンロード