ブロック崩しゲームの作成(WindowsとAndroidで動作) ～Delphiソースコード集

Delphiを起動してプロジェクトを作成し、オブジェクトを配置し、プロパティを設定する

Delphiを起動し［ファイル］→［新規作成］→［マルチデバイスアプリケーション-Delphi］をクリックします。
［空のアプリケーション］を選択して［OK］ボタンを押します。
ツールパレットからTTimerを２つフォームへドラッグ＆ドロップします。（名前はデフォルトのままTimer1とTimer2）
TImage（名前はデフォルトのままImage1）もフォームへドラッグ＆ドロップします。

Timer1のIntervalプロパティを20にし、EnableプロパティをFalseに設定します。
Timer2のIntervalプロパティを1にします。
Form1のプロパティClientHeightを480に、ClientWidthプロパティを410に設定します。
Image1のnameプロパティをimgにします。またWidthプロパティとHeightプロパティを410に設定し、AlignプロパティをFitに設定します。

プログラミング

変数、Form1のOnCreateイベント、Timer1のOnTimerイベント、Timer2のOnTimerイベント、imgのOnMouseMoveイベント、imgのOnMouseDownイベント等、以下のソースと同じように入力（コピペ？）します。

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;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    img: TImage;
    Timer2: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure imgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure Timer2Timer(Sender: TObject);
    procedure imgMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
  private
    { private 宣言 }
  public
    { public 宣言 }
    block_x:array of integer;
    block_y:array of integer;
    block_f:array of boolean;
    c:integer;
    ball_x:double;
    ball_y:double;
    ball_wx:double;
    ball_wy:double;
    racket_x:double;
    racket_w:double;
    procedure MyDraw();
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  timer2.Enabled:=False;
  img.Bitmap.Width:=410;
  img.Bitmap.Height:=410;
  img.Bitmap.BitmapScale:=img.Width/img.Bitmap.Width;
  Timer1.Enabled:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
  c:=30;
  SetLength(block_x,c);
  SetLength(block_y,c);
  SetLength(block_f,c);

  for i := 0 to c-1 do
  begin
    block_x[i]:=(i mod 10)*40 + 10;
    block_y[i]:=(i div 10) *30 + 30;
    block_f[i]:=true;
  end;

  racket_x:=80;
  racket_w:=50;
  ball_x:=30;
  ball_y:=150;
  ball_wx:=1;
  ball_wy:=2;
end;

procedure TForm1.imgMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
var xx:single;
begin
  xx:=x/img.Bitmap.BitmapScale;
  racket_x:=xx-racket_w / 2;
  if racket_x<0 then
    racket_x:=0;

  if racket_x>(img.Bitmap.Width-racket_w ) then
    racket_x:=(img.Bitmap.Width-racket_w );
end;


procedure TForm1.imgMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
var xx:single;
begin
  xx:=x/img.Bitmap.BitmapScale;
  racket_x:=xx-racket_w / 2;
  if racket_x<0 then
    racket_x:=0;

  if racket_x>(img.Bitmap.Width-racket_w ) then
    racket_x:=(img.Bitmap.Width-racket_w );
end;

procedure TForm1.MyDraw;
var
    bmp:TBitmap;
    i:integer;
    dstrect,srcrect:TRectF;
begin
  bmp:=TBitmap.Create;
  bmp.Width:=410;
  bmp.Height:=410;
  try
    if bmp.Canvas.BeginScene() then
    begin

      bmp.Canvas.Fill.Kind:=TBrushKind.Solid;
      bmp.Canvas.Fill.Color:=$FFFFFFFF;
      //背景を白色で塗りつぶし
      bmp.Canvas.FillRect(
        RectF(0,0,bmp.Width,bmp.Height),
        0,0,[],1
      );

      for i := 0 to c-1 do
      begin
        if block_f[i] then
        begin
          bmp.Canvas.Fill.Kind:=TBrushKind.Solid;
          bmp.Canvas.Fill.Color:= TAlphaColors.Black;

          bmp.Canvas.FillRect(
            RectF(block_x[i],block_y[i],block_x[i]+30,block_y[i]+20),
            0,0,[],1
          );

        end;
      end;

      bmp.Canvas.Fill.Kind:=TBrushKind.Solid;
      bmp.Canvas.Fill.Color:= TAlphaColors.Black;
      bmp.Canvas.FillEllipse(RectF(racket_x,300,racket_x+racket_w,300+5),1);
      bmp.Canvas.FillRect(
        RectF(racket_x,300,racket_x+racket_w,300+5),
        0,0,[],1
      );
      bmp.Canvas.DrawEllipse(RectF(trunc(ball_x-2),trunc(ball_y-2),trunc(ball_x+2),trunc(ball_y+2)),1 );
      bmp.Canvas.EndScene;

      srcrect:=RectF(0,0,bmp.Width,bmp.Height);
      dstrect:=RectF(0,0,img.Bitmap.Width,img.Bitmap.Height);

      img.Bitmap.Canvas.BeginScene();
      img.Bitmap.Canvas.DrawBitmap(
        bmp,
        srcrect,dstrect,
        1,false
      );
      img.Bitmap.Canvas.EndScene;
    end;
  finally
    bmp.Free;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i:integer;
begin
  ball_x:=ball_x+ball_wx;
  ball_y:=ball_y+ball_wy;

  //ラケットに当たったとき
  if (ball_y>=300) and (ball_y<=305) then
  begin
    if (ball_x>=racket_x) and (ball_x<=(racket_x+racket_w)) then
    begin
      ball_wy:=-ball_wy;
      ball_x:=ball_x+ball_wx;
      ball_y:=ball_y+ball_wy;
      ball_wx:=-(racket_x+(racket_w / 2)-ball_x) / 10;
    end;
  end;

  //壁に当たったとき
  if ball_y<=0 then
  begin
    ball_wy:=-ball_wy;
    ball_y:=0;
  end;

  if ball_x<=0 then
  begin
    ball_wx:=-ball_wx;
    ball_x:=0;
  end;
  if ball_x>=img.Bitmap.width then
  begin
    ball_wx:=-ball_wx;
    ball_x:=img.Bitmap.Width;
  end;

  //blockにあたったとき
  for i := 0 to c - 1 do
  begin
    if  (block_x[i]<=ball_x) and (ball_x<=(block_x[i]+30))
    and (block_y[i]<=ball_y) and (ball_y<=(block_y[i]+20))
    and block_f[i]=true
    then
    begin
      if ((block_x[i]-1)<=ball_x) and (ball_x<=(block_x[i]+1)) then
        ball_wx:=-ball_wx
      else
        ball_wy:=-ball_wy;

      block_f[i]:=false;
    end;
  end;

  if ball_y>=img.Height then
  begin
    timer1.Enabled:=false;
    MessageDlg('ゲームオーバー',TMsgDlgType.mtInformation,[TMsgDlgBtn.mbOK],0,
      procedure(const AResult:TModalResult)
      begin
        ball_x:=30;
        ball_y:=150;
        ball_wx:=1;
        ball_wy:=2;
        timer1.Enabled:=true;
      end
    );
  end;

  MyDraw();
end;

initialization
begin
  FMX.Types.GlobalUseDirect2D:=False;
end;

end.

実行ボタンを押す

実行ボタンを押すと、コンパイルして起動します。
マウスでラケットを左右に動かしてブロックを削除してください。

Androidでも動く

ターゲットプラットフォームをAndroidに切り替えて、実機をUSBで接続して実行しても動きます。
マウスではなく指で操作することになります。