はじめに

前回まででゲームの体裁は整いました。
今回はゲームの中身に関係する話「コリジョン判定」を作ります。

コリジョン判定とは

日本語では「衝突判定」となります。
つまり、ある物体と物体がぶつかっている（被っている）かどうか、を判定する事です。
コリジョン判定は、シューティングゲームの被弾判定や、アクションゲームでジャンプした時の着地判定、などなど、多くのゲームで必要な機能になります。

コリジョン判定を作る

基礎編

次図のような事象を考えます。

オレンジ色は弾、緑は敵だとします。
それぞれは移動していて、次フレームには別の場所に移動します。
この移動する軌跡を線分とした線分の方程式を作り、それぞれの２つの線分に交点がある場合は敵に弾が当たったと判定出来ます。

では線分の方程式を作成して…となりそうですが、そうはならないのです！

実践編

ゲームの判定タイミングは Frame 単位になります。
そして、60[FPS] だった場合、1 Frame は 16.67[msec] 程です。
その間、敵と弾はせいぜい数ピクセル移動するだけ、遅い物体であれば１ピクセルも動かないかも知れません。

つまり、線分の方程式を立てるまでも無く「物体１の左上と物体２の右下の差」が「物体１の幅＋物体２の幅」より小さい場合衝突している、と判定できます（高さも同様です）。

図１：現在の敵と弾の位置

図２：次フレームの敵と弾の位置

図１は衝突していませんが、図２は衝突しています。

これをコードで考えると…

物体１の位置：X1, Y1
物体１の幅と高さ: W1, H1

物体２の位置：X2, Y2
物体２の幅と高さ: W2, H2

とした場合

var L := Min(X1, X2);           // 左
var T := Min(Y1, Y2);           // 上
var R := Max(X1 + W1, X2 + W2); // 右
var B := Max(Y1 + H1, Y2 + H2); // 下

var W := R - L;
var H := B - T;

if (W < W1 + W2) or (H < H1 + H2) then
begin
  // 衝突
end
else
begin
  // 衝突していない
end;

として判定できます。
非常に簡単です。

一点注意があります。
最初に書いた通り移動が高々数ピクセルだからこの簡易的な方法で判定できますが、とてつもなく高速に移動した場合はこの判定をすり抜けてしまいます。
そのため最高速度を設定するか、速度に上限を設けられない場合は、線分の方程式で判定する必要があります。

今回はコリジョン判定をオブジェクト外接矩形で考えますが、実際のゲームではキャラクタの大きさを超えない大きさの矩形を使う事がほとんどです。
意図的に矩形を 1 ピクセルにしているゲームもあります。
どのようなコリジョン判定用矩形・点を使うかはゲームデザイン次第です。

コリジョン判定を組み込む

今まで作ったプログラムに衝突判定を組み込みましょう。

IntersectsWith

Delphi の場合、先ほどのコリジョン判定のコードは非常に簡単に実装できます。
それは TRectF に定義してある IntersectsWith メソッドがあるからです。
IntersectsWith はある矩形とある矩形が交わっている場合 True を返すメソッドです。
IntersectsWith の中身は先ほどのコードと同じ事をやっています。

便利な IntersectsWith を利用するため TGameObject に Bounds というプロパティを増設し、矩形を得られるようにしました。

Boundsの増設

type
  TGameObject = class
  private
    function GetBounds: TRectF;
    (中略)
  public
    (中略)
    property Bounds: TRectF read GetBounds;
  end;

implementation
  (中略)

function TGameObject.GetBounds: TRectF;
begin
  Result := RectF(FX, FY, FX + FWidth, FY + FHeight);
end;

これで

Bounds.IntersectsWith(AObject.Bounds); // 戻り値は Boolean

とすることで、コリジョン判定ができるようになりました。

TCollidableObject の作成

次に、コリジョン判定を持った GameObject である TCollidableObject クラスを作成します。
コリジョン判定があるオブジェクトは全てここから派生させます。

TCollidableObjectの定義

unit uCollidableObject;

interface

uses
  uGameMaster;

type
  // 衝突状態を表す型
  // None:     衝突していない
  // Collided: 衝突した
  // Stay:     衝突している（衝突状態が続いている）
  TCollisionState = (None, Collided, Stay);

  // 衝突判定を持っているオブジェクト
  TCollidableObject = class(TGameObject)
  private
    FCollisionState: TCollisionState;
  protected
    procedure UpdateCollision(
      const AState: TCollisionState;
      const AObject: TCollidableObject); virtual;
    property CollisionState: TCollisionState read FCollisionState;
  public
    function CheckCollision(const AObject: TCollidableObject): Boolean;
  end;


implementation

{ TCollidableObject }

function TCollidableObject.CheckCollision(
  const AObject: TCollidableObject): Boolean;
begin
  // 表示されていない物とは衝突判定はない
  if (not Visible) or (not AObject.Visible) then
    Exit(False);

  // AObject と自身が衝突しているか判断します。
  Result := Bounds.IntersectsWith(AObject.Bounds);

  // 衝突の状態を取得します。
  var OldState := FCollisionState;

  if Result then
  begin
    case FCollisionState of
      Collided:
        FCollisionState := TCollisionState.Stay;

      None:
        FCollisionState := TCollisionState.Collided;
    end;
  end
  else
  begin
    FCollisionState := TCollisionState.None;
  end;

  // 衝突の状態が変わった場合、UpdateCollision を呼び出す
  if OldState <> FCollisionState then
    UpdateCollision(FCollisionState, AObject);
end;

procedure TCollidableObject.UpdateCollision(
  const AState: TCollisionState;
  const AObject: TCollidableObject);
begin
  // 継承先で処理を記述する
end;

end.

CheckCollistion で引数のオブジェクトと衝突しているか判断して、衝突状態が変化する度に UpdateCollision が呼ばれるようにしました。

では、これを TBallObject に組み込みます。

TBallObject にコリジョン判定をつける

では、TBallObject の継承元を TCollidableObject にして、衝突判定を実装してみます。

TBallObjectの定義

type
  TBallObject = class(TCollidableObject)
    (中略)
  protected
    procedure UpdateCollision(
      const AState: TCollisionState;
      const AObject: TCollidableObject); override;
    (中略)
  end;

TBallObjectの衝突判定

procedure TBallObject.UpdateCollision(
  const AState: TCollisionState;
  const AObject: TCollidableObject);
var
  Ball: TBallObject absolute AObject;
begin
  // 衝突初回のみ
  if AState = TCollisionState.Collided then
  begin
    if AObject is TBallObject then
    begin
      // TBallObject と衝突した場合は速度を交換する
      var VX := Ball.FVX;
      var VY := Ball.FVY;

      Ball.FVX := FVX;
      Ball.FVY := FVY;

      FVX := VX;
      FVY := VY;
    end
    else
    begin
      // それ以外の物体と衝突した場合は方向を反転する
      // 実際は X 方向と Y 方向どちらにあたったかを考えて方向反転しないといけない
      // X 方向であたったのに Y 方向も反転してしまったらおかしいため
      FVX := -FVX;
      FVY := -FVY;
    end;
  end;
end;

GameMaster に判定呼び出し処理を実装する

TGameMaster.TLoopThread.Update メソッドにコリジョン判定部分を追加します。

procedure TGameMaster.TLoopThread.Update;
begin
  // 各更新処理を呼ぶ
  for var Obj in FGameMaster.FObjects do
     Obj.Update;

  // コリジョン判定を呼び出す
  var Checked := TList<TGameObject>.Create;
  try
    for var Obj1 in FGameMaster.FObjects do
    begin
      // 既に衝突判定したオブジェクトは再度衝突判定が走らないように
      // リストに追加しておく
      Checked.Add(Obj1);

      if (Obj1 is TCollidableObject) then
      begin
        for var Obj2 in FGameMaster.FObjects do
        begin
          // TCollidableObject かつ、未判定
          if (Obj2 is TCollidableObject) and not Checked.Contains(Obj2) then
            TCollidableObject(Obj1).CheckCollision(TCollidableObject(Obj2));
        end;
      end;
    end;
  finally
    Checked.Free;
  end;
end;

これでコードができあがりました。

動作を見てみましょう

動作確認

Gif になっているので遅く感じますが、実際はもっと滑らかかつスピーディーに動いています。

上手く衝突判定できていますね！

コードまとめ

今回でコードの話は終わりです。
そこで全てのコードを書いておきます。
試す場合は、新規作成で「マルチデバイスアプリケーション」を選んで FireMonkey フォームを作成してください。
OnCreate, OnDestroy, OnKeyDown, OnKeyUp, OnShow のイベントハンドラを作り、uMain.pas と同じ内容を記載してください。
FGameMaster の宣言や Windows の設定を変更している部分などがあるので、それらも記載してください。

あとのソースはプロジェクトに追加するだけで大丈夫です。

uGameMaster コード全文

unit uGameMaster;

interface

uses
  System.Classes
  , System.Diagnostics
  , System.Types
  , System.SysUtils
  , System.Generics.Collections
  , FMX.Graphics
  , uGamePad
  ;

type
  TGameObject = class;

  TGameMaster = class
  private type
    TLoopThread = class(TThread)
    private var
      FFPS: Double;
      FFrameCount: Integer;
      FFPSWatch: TStopWatch;
      FGameMaster: TGameMaster;
    private
      procedure Update;
      procedure Render;
    protected
      procedure Execute; override;
    public
      constructor Create(const AGM: TGameMaster); reintroduce;
    end;
  private var
    FLoop: TLoopThread;
    FCanvas: TCanvas;
    FCanvasR: TRectF;
    FObjects: TList<TGameObject>;
    FPad: TGamePad;
    FBallLauncher: TGameObject;
  private
    procedure CalcCanvasRect;
  public
    constructor Create(const ACanvas: TCanvas); reintroduce;
    destructor Destroy; override;
  public
    procedure Start;
    procedure AddObject(const AObj: TGameObject);
    procedure RemoveObject(const AObj: TGameObject);
  public
    property Canvas: TCanvas read FCanvas;
    property CanvasR: TRectF read FCanvasR;
    property Pad: TGamePad read FPad;
    property BallLauncher: TGameObject read FBallLauncher;
  end;

  TGameObject = class
  private var
    FGameMaster: TGameMaster;
    FX: Single;
    FY: Single;
    FOldX: Single;
    FOldY: Single;
    FWidth: Single;
    FHeight: Single;
    FVisible: Boolean;
  private
    function GetDX: Single;
    function GetDY: Single;
    function GetBounds: TRectF;
  protected
    property GameMaster: TGameMaster read FGameMaster;
  public
    constructor Create(const AGM: TGameMaster); reintroduce; virtual;
    destructor Destroy; override;
    procedure Move(const AX, AY: Single; const ANeedRange: Boolean = False);
    procedure Start; virtual;
    procedure Update; virtual;
    procedure Render; virtual;
    procedure Finish; virtual;
  public
    property X: Single read FX write FX;
    property Y: Single read FY write FY;
    property OldX: Single read FOldX write FOldX;
    property OldY: Single read FOldY write FOldY;
    property Width: Single read FWidth write FWidth;
    property Height: Single read FHeight write FHeight;
    property Bounds: TRectF read GetBounds;
    property DX: Single read GetDX;
    property DY: Single read GetDY;
    property Visible: Boolean read FVisible write FVisible;
  end;

implementation

uses
  System.UITypes
  , System.Math
  , FMX.Forms
  , FMX.Types
  , uCollidableObject
  , uBallLauncher
  ;

type
  TStopwatchHelper = record helper for TStopwatch
  private
    function GetElapsedMicroSec: Double;
  public
    property ElapsedMicroSec: Double read GetElapsedMicroSec;
  end;

{ TStopwatchHelper }

function TStopwatchHelper.GetElapsedMicroSec: Double;
begin
  Result := Elapsed.Ticks * 1000 / TStopwatch.Frequency;
end;

{ TGameMaster }

procedure TGameMaster.AddObject(const AObj: TGameObject);
begin
  FObjects.Add(AObj);
end;

procedure TGameMaster.CalcCanvasRect;
begin
  FCanvasR := RectF(0, 0, FCanvas.Width, FCanvas.Height);
end;

constructor TGameMaster.Create(const ACanvas: TCanvas);
begin
  inherited Create;

  FObjects := TList<TGameObject>.Create;
  FBallLauncher := TBallLauncher.Create(Self); // GameObject なので自動的に破棄

  FCanvas := ACanvas;
  CalcCanvasRect;

  FLoop := TLoopThread.Create(Self);
end;

destructor TGameMaster.Destroy;
begin
  FLoop.Terminate;
  while not FLoop.Finished do
    Sleep(100);

  var Objects := FObjects;
  for var Obj in Objects do
    Obj.Free;

  FObjects.Free;

  inherited;
end;

procedure TGameMaster.RemoveObject(const AObj: TGameObject);
begin
  FObjects.Remove(AObj);
end;

procedure TGameMaster.Start;
begin
  if not FLoop.Started then
    FLoop.Start;
end;

{ TGameLoop.TLoopThread }

constructor TGameMaster.TLoopThread.Create(const AGM: TGameMaster);
begin
  inherited Create(True);

  FGameMaster := AGM;
  FreeOnTerminate := True;
end;

procedure TGameMaster.TLoopThread.Execute;
begin
  var SW: TStopwatch;
  var SleepWatch: TStopwatch;
  var AdjustTime := 0.0;

  FFrameCount := 0;
  FFPSWatch := TStopwatch.StartNew;

  // アプリケーションやスレッドが終了したら終わらせる
  while (not Terminated) and (not Application.Terminated) do
  begin
    SW.Reset;
    SW.Start;

    // 描画矩形の計算
    FGameMaster.CalcCanvasRect;

    // 更新・描画処理を呼び出す
    Update;
    Render;

    SW.Stop;

    // 余り時間
    var SleepTime := 16.67 - SW.ElapsedMicroSec - AdjustTime;

    if SleepTime > 0 then
    begin
      SleepWatch.Reset;
      SleepWatch.Start;

      Sleep(Round(SleepTime));

      SleepWatch.Stop;

      AdjustTime := SleepWatch.ElapsedMicroSec - SleepTime;
    end
    else
      AdjustTime := 0;
  end;

  // 終了処理
end;

procedure TGameMaster.TLoopThread.Render;
begin
  FGameMaster.FCanvas.BeginScene;
  try
    try
      // 背景のクリア
      FGameMaster.FCanvas.Clear(TAlphaColors.Black);

      // 各描画処理を呼ぶ
      for var Obj in FGameMaster.FObjects do
         Obj.Render;

      // FPS 表示
      FGameMaster.FCanvas.Fill.Color := TAlphaColors.White;
      FGameMaster.FCanvas.Fill.Kind := TBrushKind.Solid;
      FGameMaster.FCanvas.FillText(
        RectF(
          6,
          FGameMaster.FCanvasR.Bottom - 28,
          FGameMaster.FCanvas.Width,
          FGameMaster.FCanvasR.Bottom
        ),
        Format('FPS: %.3f', [FFPS]),
        False,
        1,
        [],
        TTextAlign.Leading,
        TTextAlign.Center);
    except
    end;
  finally
    FGameMaster.FCanvas.EndScene;;
  end;

  // FPS 更新処理
  Inc(FFrameCount);
  var FPSElapsed := FFPSWatch.ElapsedMilliseconds;
  if FPSElapsed > 999 then
  begin
    FFPS := FFrameCount * 1000 /  FPSElapsed;

    FFrameCount := 0;
    FFPSWatch.Reset;
    FFPSWatch.Start;
  end;
end;

procedure TGameMaster.TLoopThread.Update;
begin
  // 各更新処理を呼ぶ
  for var Obj in FGameMaster.FObjects do
     Obj.Update;

  // コリジョン判定を呼び出す
  var Checked := TList<TGameObject>.Create;
  try
    for var Obj1 in FGameMaster.FObjects do
    begin
      // 既に衝突判定したオブジェクトは再度衝突判定が走らないように
      // リストに追加しておく
      Checked.Add(Obj1);

      if (Obj1 is TCollidableObject) then
      begin
        for var Obj2 in FGameMaster.FObjects do
        begin
          // TCollidableObject かつ、未判定
          if (Obj2 is TCollidableObject) and not Checked.Contains(Obj2) then
            TCollidableObject(Obj1).CheckCollision(TCollidableObject(Obj2));
        end;
      end;
    end;
  finally
    Checked.Free;
  end;
end;

{ TGameObject }

constructor TGameObject.Create(const AGM: TGameMaster);
begin
  inherited Create;

  FGameMaster := AGM;
  FGameMaster.AddObject(Self);

  FVisible := True;

  Start;
end;

destructor TGameObject.Destroy;
begin
  Finish;

  FGameMaster.RemoveObject(Self);

  inherited;
end;

procedure TGameObject.Finish;
begin
  // 継承先で変更
end;

function TGameObject.GetBounds: TRectF;
begin
  Result := RectF(FX, FY, FX + FWidth, FY + FHeight);
end;

function TGameObject.GetDX: Single;
begin
  Result := FX - FOldX;
end;

function TGameObject.GetDY: Single;
begin
  Result := FY - FOldY;
end;

procedure TGameObject.Move(const AX, AY: Single; const ANeedRange: Boolean);
begin
  FOldX := FX;
  FOldY := FY;

  if ANeedRange then
  begin
    FX := EnsureRange(AX, 0, FGameMaster.CanvasR.Width - FWidth);
    FY := EnsureRange(AY, 0, FGameMaster.CanvasR.Height - FHeight);;
  end
  else
  begin
    FX := AX;
    FY := AY;
  end;
end;

procedure TGameObject.Render;
begin
  // 継承先で変更
end;

procedure TGameObject.Start;
begin
  // 継承先で変更
end;

procedure TGameObject.Update;
begin
  // 継承先で変更
end;

end.

uBallObject コード全文

unit uBallObject;

interface

uses
  System.SysUtils
  , System.Types
  , System.UITypes
  , uGameMaster
  , uCollidableObject
  , PK.Utils.Log
  ;

type
  TBallColor = (Red, Green, Blue);

  TBallObject = class(TCollidableObject)
  private var
    FVX: Single;
    FVY: Single;
    FColor: TAlphaColor;
    FBallColor: TBallColor;
    FDiameter: Single;
  protected
    procedure UpdateCollision(
      const AState: TCollisionState;
      const AObject: TCollidableObject); override;
  public
    procedure SetParam(
      const AColor: TBallColor;
      const AX, AY, ADiameter, AVX, AVY: Single);
    procedure Start; override;
    procedure Render; override;
    procedure Update; override;
    procedure Assign(const ASource: TBallObject);
    procedure ChangeSpeed(const AVX, AVY: Single);
    procedure ChangeColor(const AColor: TBallColor);
    property Color: TAlphaColor read FColor;
  end;

implementation

const
  BALL_COLOR_VALUES: array [TBallColor] of TAlphaColor = (
    TAlphaColors.Deeppink,
    TAlphaColors.Greenyellow,
    TAlphaColors.Dodgerblue
  );

{ TBallObject }

procedure TBallObject.Assign(const ASource: TBallObject);
begin
  with ASource do
    Self.SetParam(FBallColor, X, Y, FDiameter, FVX, FVY);
end;

procedure TBallObject.ChangeColor(const AColor: TBallColor);
begin
  FBallColor := AColor;
  FColor := BALL_COLOR_VALUES[FBallColor];
end;

procedure TBallObject.ChangeSpeed(const AVX, AVY: Single);
begin
  FVX := AVX;
  FVY := AVY;
end;

procedure TBallObject.Render;
begin
  if Visible then
  begin
    GameMaster.Canvas.Fill.Color := FColor;
    GameMaster.Canvas.FillEllipse(RectF(X, Y, X + FDiameter, Y + FDiameter), 1);
  end;
end;

procedure TBallObject.SetParam(
  const AColor: TBallColor;
  const AX, AY, ADiameter, AVX, AVY: Single);
begin
  FBallColor := AColor;
  FColor := BALL_COLOR_VALUES[FBallColor];
  X := AX;
  Y := AY;
  FDiameter := ADiameter;
  FVX := AVX;
  FVY := AVY;

  Width := FDiameter;
  Height := FDiameter;
end;

procedure TBallObject.Start;
begin
end;

procedure TBallObject.Update;
begin
  var R := GameMaster.CanvasR;
  R.Right := R.Right - Width;
  R.Bottom := R.Bottom - Height;

  if (X < 0) or (X > R.Width) then
    FVX := -FVX;

  if (Y < 0) or (Y > R.Height) then
    FVY := -FVY;

  Move(X + FVX, Y + FVY);
end;

procedure TBallObject.UpdateCollision(
  const AState: TCollisionState;
  const AObject: TCollidableObject);
var
  Ball: TBallObject absolute AObject;
begin
  // 衝突初回のみ
  if AState = TCollisionState.Collided then
  begin
    if AObject is TBallObject then
    begin
      // TBallObject と衝突した場合は速度を交換する
      var VX := Ball.FVX;
      var VY := Ball.FVY;

      Ball.FVX := FVX;
      Ball.FVY := FVY;

      FVX := VX;
      FVY := VY;
    end
    else
    begin
      // それ以外の物体と衝突した場合は方向を反転する
      FVX := -FVX;
      FVY := -FVY;
    end;
  end;
end;

end.

uBallLauncher コード全文

unit uBallLauncher;

interface

uses
  System.SysUtils
  , uGameMaster
  , uGamePad
  , uBallObject
  ;

type
  TBallState = (Stop, Prepare, Color, Inflate, Angle, Speed, Launch);

  TBallLauncher = class(TGameObject)
  private const
    BALL_DIAMETER_MAX = 50;
    BALL_DIAMETER_MIN = 8;
    POD_WIDTH = 80;
    POD_HEIGHT = 8;
    ANGLE_MIN = 15;
    ANGLE_MAX = 165;
    SPEED_MIN = 3;
    SPEED_MAX = 24;
    SPEED_K = 5;
    COLOR_WAIT = 16;
    SELF_WIDTH = 80;
    SELF_HEIGHT = 8;
    SELF_SPEED = 8;
  private var
    FBall: TBallObject;
    FBallState: TBallState;
    FBallColor: TBallColor;
    FBallAngle: Single;
    FBallSpeed: Single;
    FBallDiameter: Single;
    FSign: Integer;
    FColorWait: Integer;
    FPressed: Boolean;
  public
    procedure Start; override;
    procedure Update; override;
    procedure Render; override;
  end;

implementation

uses
  System.Types
  , System.UITypes
  , System.Math
  , System.Math.Vectors
  , FMX.Graphics
  , PK.Utils.Log
  ;

{ TBallLauncher }

procedure TBallLauncher.Render;
begin
  with GameMaster, Canvas do
  begin
    Fill.Kind := TBrushKind.Solid;
    Fill.Color := TAlphaColors.White;

    FillRect(RectF(X, Y, X + POD_WIDTH, Y + POD_HEIGHT), 1);

    case FBallState of
      TBallState.Angle, TBallState.Speed:
      begin
        Stroke.Kind := TBrushKind.Solid;
        Stroke.Dash := TStrokeDash.Dash;
        Stroke.Thickness := 1;
        Stroke.Color := FBall.Color;

        var OX := FBall.X + FBallDiameter / 2;
        var OY := FBall.Y + FBallDiameter / 2;

        var C, S: Single;
        SinCos(DegToRad(FBallAngle), S, C);

        var  Sp := FBallSpeed * SPEED_K;

        DrawLine(PointF(OX, OY), PointF(OX + Sp * C, OY - Sp * S), 1);
      end;
    end;
  end;
end;

procedure TBallLauncher.Start;
begin
  FBall := TBallObject.Create(GameMaster);
  FBall.Visible := False;

  Width := SELF_WIDTH;
  Height := SELF_HEIGHT;
end;

procedure TBallLauncher.Update;

  procedure IncValue(var AValue: Single; const AMin, AMax: Single);
  begin
    AValue := AValue + FSign;

    if (AValue < AMin) then
    begin
      AValue := AMin;
      FSign := -FSign;
    end;

    if (AValue > AMax) then
    begin
      AValue := AMax;
      FSign := -FSign;
    end;
  end;

begin
  if Y = 0 then
  begin
    // 初期化: 位置を中央下部に
    Move(
      (GameMaster.CanvasR.Width - Width) / 2,
      GameMaster.CanvasR.Height - Height);
  end;

  if GameMaster.Pad.IsPressed(TPadButton.Left) then
  begin
    // 砲台を動かす
    Move(X - SELF_SPEED, Y);
  end;

  if GameMaster.Pad.IsPressed(TPadButton.Right) then
  begin
    // 砲台を動かす
    Move(X + SELF_SPEED, Y);
  end;

  if GameMaster.Pad.IsPressed(TPadButton.A) then
  begin
    // A ボタンが押されたら
    FPressed := True;

    case FBallState of
      TBallState.Stop:
      begin
        // 準備に移動
        FBallState := TBallState.Prepare;
      end;
    end;
  end
  else
  begin
    // A ボタンが離されていたら
    case FBallState of
      TBallState.Prepare:
      begin
        // ボール準備
        if FPressed then
        begin
          FBallState := TBallState.Color;
          FBallColor := TBallColor.Red;
          FBallDiameter := BALL_DIAMETER_MAX;
          FColorWait := 0;
          FBall.Visible := True;
        end;
      end;

      // 色選択
      TBallState.Color:
      begin
        if FPressed then
        begin
          FBallState := Inflate;
          FSign := -1;
        end;

        Inc(FColorWait);
        if FColorWait = COLOR_WAIT then
        begin
          FColorWait := 0;

          var C := Ord(FBallColor) + 1;
          if (C > Ord(High(TBallColor))) then
            FBallColor := Low(TBallColor)
          else
            Inc(FBallColor);

          FBall.ChangeColor(FBallColor);
        end;
      end;

      // サイズ選択
      TBallState.Inflate:
      begin
        if FPressed then
        begin
          FBallState := Angle;
          FSign := 2;
          FBallSpeed := SPEED_MAX;
        end;

        IncValue(FBallDiameter, BALL_DIAMETER_MIN, BALL_DIAMETER_MAX);
      end;

      // 角度選択
      TBallState.Angle:
      begin
        if FPressed then
        begin
          FBallState := Speed;
          FSign := 1;
        end;

        IncValue(FBallAngle, ANGLE_MIN, ANGLE_MAX);
      end;

      // 速度選択
      TBallState.Speed:
      begin
        if FPressed then
          FBallState := TBallState.Launch;

        IncValue(FBallSpeed, SPEED_MIN, SPEED_MAX);
      end;

      // ボールを発射
      TBallState.Launch:
      begin
        var B := TBallObject.Create(GameMaster);
        B.Assign(FBall);
        var C, S: Single;
        SinCos(DegToRad(FBallAngle), S, C);
        B.ChangeSpeed(C * FBallSpeed, -S * FBallSpeed);

        FBall.Visible := False;
        FBallState := TBallState.Stop;
      end;
    end;

    FPressed := False;

    // 状態を反映
    FBall.SetParam(
      FBallColor,
      X + (Width - FBallDiameter) / 2,
      Y - FBallDiameter, FBallDiameter,
      0,
      0);
  end;
end;

end.

uGamePad コード全文

unit uGamePad;

interface

uses
  System.SysUtils, System.Diagnostics;

type
  TPadButton = (Left, Up, Right, Down, A, B, X, Y, L, R);

  TGamePad = record
  private type
    TButtonInfo = record
      FIsPressed: Boolean;
      FHoldTimeWatch: TStopwatch;
      FHoldTime: Integer;
    end;
  private var
    FButtons: array [TPadButton] of TButtonInfo;
  public
    // ボタンが押されたときに呼ぶ
    procedure Press(const AButton: TPadButton);
    // ボタンが離されたときに呼ぶ
    procedure Release(const AButton: TPadButton);
    // ボタンが押されているか確認する
    function IsPressed(const AButton: TPadButton): Boolean;
    // ボタンが押されていた時間 [msec]
    function GetHoldTime(const AButton: TPadButton): Integer;
  end;

implementation

{ TGamePad }

function TGamePad.GetHoldTime(const AButton: TPadButton): Integer;
begin
  Result := FButtons[AButton].FHoldTime;
end;

function TGamePad.IsPressed(const AButton: TPadButton): Boolean;
begin
  Result := FButtons[AButton].FIsPressed;
end;

procedure TGamePad.Press(const AButton: TPadButton);
begin
  with FButtons[AButton] do
  begin
    if FIsPressed then
      FHoldTime := FHoldTimeWatch.ElapsedMilliseconds
    else
    begin
      FIsPressed := True;
      FHoldTime := 0;

      FHoldTimeWatch.Reset;
      FHoldTimeWatch.Start;
    end;
  end;
end;

procedure TGamePad.Release(const AButton: TPadButton);
begin
  with FButtons[AButton] do
  begin
    FHoldTimeWatch.Stop;

    FIsPressed := False;
    FHoldTime := FHoldTimeWatch.ElapsedMilliseconds;
  end;
end;

end.

uCollidableObject コード全文

unit uCollidableObject;

interface

uses
  uGameMaster;

type
  // 衝突状態を表す型
  // None:     衝突していない
  // Collided: 衝突した
  // Stay:     衝突している（衝突状態が続いている）
  TCollisionState = (None, Collided, Stay);

  // 衝突判定を持っているオブジェクト
  TCollidableObject = class(TGameObject)
  private
    FCollisionState: TCollisionState;
  protected
    procedure UpdateCollision(
      const AState: TCollisionState;
      const AObject: TCollidableObject); virtual;
    property CollisionState: TCollisionState read FCollisionState;
  public
    function CheckCollision(const AObject: TCollidableObject): Boolean;
  end;


implementation

{ TCollidableObject }

function TCollidableObject.CheckCollision(
  const AObject: TCollidableObject): Boolean;
begin
  // 表示されていない物とは衝突判定はない
  if (not Visible) or (not AObject.Visible) then
    Exit(False);

  // AObject と自身が衝突しているか判断します。
  Result := Bounds.IntersectsWith(AObject.Bounds);

  // 衝突の状態を取得します。
  var OldState := FCollisionState;

  if Result then
  begin
    case FCollisionState of
      Collided:
        FCollisionState := TCollisionState.Stay;

      None:
        FCollisionState := TCollisionState.Collided;
    end;
  end
  else
  begin
    FCollisionState := TCollisionState.None;
  end;

  // 衝突の状態が変わった場合、UpdateCollision を呼び出す
  if OldState <> FCollisionState then
    UpdateCollision(FCollisionState, AObject);
end;

procedure TCollidableObject.UpdateCollision(
  const AState: TCollisionState;
  const AObject: TCollidableObject);
begin
  // 継承先で処理を記述する
end;

end.

uMain コード全文

unit uMain;

interface

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

type
  TfrmMain = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: WideChar;
      Shift: TShiftState);
  private var
    FGameMaster: TGameMaster;
  public
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.fmx}

{$IFDEF MSWINDOWS}
uses
  Winapi.Windows
  , Winapi.DwmApi
  , FMX.Platform.Win
  , uBallObject
  , uGamePad
  ;
{$ENDIF}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  {$IFDEF MSWINDOWS}
    var CornerRound: DWORD := 1;

    DwmSetWindowAttribute(
      FormToHWND(Self),
      DWMWA_WINDOW_CORNER_PREFERENCE,
      @CornerRound,
      SizeOf(CornerRound)
    );
  {$ENDIF}

  FGameMaster := TGameMaster.Create(Canvas);
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FGameMaster.Free;
end;

procedure TfrmMain.FormKeyDown(
  Sender: TObject;
  var Key: Word;
  var KeyChar: WideChar;
  Shift: TShiftState);
begin
  case Key of
    vkLeft:  FGameMaster.Pad.Press(TPadButton.Left);
    vkRight: FGameMaster.Pad.Press(TPadButton.Right);
    vkUp:    FGameMaster.Pad.Press(TPadButton.Up);
    vkDown:  FGameMaster.Pad.Press(TPadButton.Down);
    vkShift: FGameMaster.Pad.Press(TPadButton.B);
  end;

  case KeyChar of
    ' ': FGameMaster.Pad.Press(TPadButton.A);
  end;
end;

procedure TfrmMain.FormKeyUp(
  Sender: TObject;
  var Key: Word;
  var KeyChar: WideChar;
  Shift: TShiftState);
begin
  case Key of
    vkLeft:  FGameMaster.Pad.Release(TPadButton.Left);
    vkRight: FGameMaster.Pad.Release(TPadButton.Right);
    vkUp:    FGameMaster.Pad.Release(TPadButton.Up);
    vkDown:  FGameMaster.Pad.Release(TPadButton.Down);
    vkShift: FGameMaster.Pad.Release(TPadButton.B);
  end;

  case KeyChar of
    ' ': FGameMaster.Pad.Release(TPadButton.A);
  end;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  FGameMaster.Start;
end;

end.

まとめ

今回、動きのあるゲームに必須のコリジョン判定を作成しました。
これが一番簡単な「Box Collision」の仕組みです。
Unity などのゲームエンジンでは Collider があるので自分で作成する機会は減少しているかもしれません。
でも BoxCollider の中ではこういう処理をしてるのかな？と知っていると何かの役に立つかも知れません。

今回でコードの説明は終わりです。

第６回に続く