ビジョントレーニング　アプリを作る（WindowsでもAndroidでも動く）(FMX使用) ～Delphiでお手軽プログラミング

• ホーム
• Delphiでお手軽プログラミング
• ビジョントレーニング　アプリを作る（WindowsでもAndroidでも動く）(FMX使用) ～Delphiでお手軽プログラミング

ビジョントレーニング　アプリを作る（WindowsでもAndroidでも動く）(FMX使用) ～Delphiでお手軽プログラミング

完成イメージ

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

プログラミング

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.StdCtrls,
  FMX.Controls.Presentation, FMX.Objects, FMX.Layouts
  ,System.Diagnostics;

type
  TRec=record
    i:Integer;
    p:TPointF;
    wh:Integer;
  end;

  TForm1 = class(TForm)
    ScaledLayout1: TScaledLayout;
    Image1: TImage;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure FormCreate(Sender: TObject);
  private
    { private 宣言 }
    ct:integer;
    rec:array of TRec;
    StopWatch : TStopWatch;
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
var c:TCanvas;
    i,j:integer;
    flg:boolean;
begin
  c:=Image1.Bitmap.Canvas;
  c.BeginScene();
  c.Fill.Kind:=TBrushKind.Solid;
  c.Fill.Color:=$FFFFFFFF;
  //全体を白で塗る
  c.FillRect(
    RectF(
      0, 0,                //x,y
      Image1.Bitmap.Width, //幅
      Image1.Bitmap.Height //高さ
    ),
    0, 0, //角を丸める半径
    [],   //四隅の何処の角を丸めるか
    1     //透明度
  );
  c.EndScene;

  //1～30の数字のxy座標と大きさの配列を確保
  SetLength(rec,30);

  for i := 0 to Length(rec)-1 do
  begin
    rec[i].i:=i+1;
    flg:=true;
    while flg do
    begin
      rec[i].p.X:=Random(600)+50;
      rec[i].p.Y:=Random(600)+50;
      rec[i].wh:=random(20)+30;
      flg:=false;
      for j := 0 to i-1 do
      begin
        if ((rec[i].p.X+rec[i].wh)>(rec[j].p.X-rec[j].wh)) and
           ((rec[i].p.X-rec[i].wh)<(rec[j].p.X+rec[j].wh)) and
           ((rec[i].p.Y+rec[i].wh)>(rec[j].p.Y-rec[j].wh)) and
           ((rec[i].p.Y-rec[i].wh)<(rec[j].p.Y+rec[j].wh)) then
        begin
          flg:=true;
          break;
        end;
      end;
    end;
  end;

  c.BeginScene();
  for i := 0 to Length(rec)-1 do
  begin
    c.Font.Style := [];
    c.Font.Size := rec[i].wh;

    j:=Random(3);
    if j=0 then
    begin
      c.Fill.Color  :=TAlphaColors.Red;
      c.Stroke.Color:=TAlphaColors.Red;
    end
    else if j=1 then
    begin
      c.Fill.Color  :=TAlphaColors.Blue;
      c.Stroke.Color:=TAlphaColors.Blue;
    end
    else
    begin
      c.Fill.Color  :=TAlphaColors.Black;
      c.Stroke.Color:=TAlphaColors.Black;
    end;

    //テキストの描画
    c.FillText(
      RectF(
        rec[i].p.X-rec[i].wh,
        rec[i].p.Y-rec[i].wh,
        rec[i].p.X+rec[i].wh,
        rec[i].p.Y+rec[i].wh
      ),
      inttostr(rec[i].i),
      false,1,[],
      TTextAlign.Center, TTextAlign.Center
    );
    //円の描画
    c.DrawEllipse(
      RectF(
        rec[i].p.X - rec[i].wh,
        Rec[i].p.Y - rec[i].wh,
        rec[i].p.X + rec[i].wh,
        Rec[i].p.Y + rec[i].wh
      ),
      1
    );
  end;
  c.EndScene;

  StopWatch.Stop;
  StopWatch.Reset;
  StopWatch.Start;

  ct:=0;
  timer1.Enabled:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
  StopWatch := TStopWatch.StartNew;
  Timer1.Enabled:=False;
  Timer1.Interval:=20;
  Button1.Text:='開始';
  Image1.Bitmap.Width:=700;
  Image1.Bitmap.Height:=700;

  Label1.Text:='';
  Label2.Text:='';

  Image1.WrapMode:=TImageWrapMode.Fit;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
var xx,yy:double;
begin
  xx:=X*Image1.Bitmap.Width/Image1.Width;
  yy:=Y*Image1.Bitmap.Height/Image1.Height;

  if ((rec[ct].p.X-rec[ct].wh)<xx) and
     ((rec[ct].p.X+rec[ct].wh)>xx) and
     ((rec[ct].p.Y-rec[ct].wh)<yy) and
     ((rec[ct].p.Y+rec[ct].wh)>yy) then
  begin
    inc(ct);
  end;

  if ct>=Length(rec) then
  begin
    timer1.Enabled:=false;
    label2.Text:='終了';
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Text:=
    format('%10.2f秒',[StopWatch.ElapsedMilliseconds/1000]);
  label2.Text:=inttostr(ct+1)+' を押して';
end;

end.

実行ボタンを押す(WindowsでもAndroidでも動作します)