Mam's WebSite
建築CGパース住宅CGパース

Mamの覚書Q&A検索

トップページMamの覚書Q&A検索Delphi(FMX_Android)⇒Q&A


大項目:「 Delphi 」 - 中項目:「 FMX_Android 」

「 Delphi 10.1BerlinでWindowsでもAndroidでも動くブロック崩しゲームを作る 」

Delphi 10.1Berlin Update2でWindowsでもAndroidでも動くブロック崩しゲームを作るには


回答

新規作成からマルチデバイスアプリケーションを選択し空のアプリケーションを選択します。
 
フォームの
ClientHeightを480に、ClientWidthを410に設定します。
Timerを2つフォームにドロップします。
timer2のIntervalを1にします。
timer1のIntervalを20にし、Enableをfalseにします。
TImageをフォームにドロップし、nameをimgにし、WidthとHeightを410にし、AlignをFitにします。
以下ソースコードを記述すれば完成です。

ソース

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,yy:single;
begin
  xx:=x/img.Bitmap.BitmapScale;
  yy:=y/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,yy:single;
begin
  xx:=x/img.Bitmap.BitmapScale;
  yy:=y/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;
  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;
    showmessage('ゲームオーバー');
  end;
  MyDraw();
end;
end.


Mam's WebSite