サークルメニューを作ってみよう

お題　サークルメニューを作ってみよう

ゲームやCADで使われているサークルメニューは、マウス操作向けの何気にカッコイイ感じのメニューです。
それをDelphi の VCLアプリで作ってみましょう。

環境と準備

言語　Delphi 11 Community Edition
ターゲットプラットフォーム Windows 32ビット
※64ビットでもできますが、32ビットの方がデバッグしやすいため、32ビットがお勧め。完成したら、64ビットに切り替えてコンパイルしても良いです。

画面を準備します

今回は、formをふたつ使います。
form1 がアプリの本体です。
form2 にサークルメニューを表示します。

ファイル > 新規作成 > Windows VCLアプリケーション
まず、form1 と Vclアプリケーションのプロジェクトを作ります。

コンポーネントのバレットから、ボタン、エデット、ラベルをひとつずつ貼り付けてください。
form1は、form2を呼び出すための台紙として機能します。

form1のプログラムコード(unit1.pas)の全文

Form1 は、サークルメニューを呼びだす台紙になります
button1 をクリックすると、form2のサークルメニューをモード付きで表示します。
結果は、Edit1のテキストに表示します。

form1 (unit1.pas) のプログラム全文　[クリックで開いてください]

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Unit2;

procedure TForm1.Button1Click(Sender: TObject);
begin
  form2.showmodal;

  Edit1.Text:=form2.CirCleMenu[Form2.gCircleResult].caption+'が選択されました';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Label1.Caption:='ねこが現れました。どうする？';
  Button1.Caption:='選択円を表示';
end;

end.

form2のプログラムコード(unit2.pas)の全文

実際にサークルメニューを描く form2 (unit2.pas) プログラムの全文を折り畳みで載せます。

form2 (unit2.pas) のプログラム全文　[クリックで開いてください]

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Types, Vcl.ExtCtrls;

type TCirCleMenu = record  //選択円のデータを仕舞う構造体
   CirX,             //選択円の中心 X
   CirY:longint;     //選択円の中心 Y
   Caption:string;   //選択円のキャプション
 end;

type
  TForm2 = class(TForm)
    //サークルメニューを表示
    procedure FormPaint(Sender: TObject);

    //メニューを選択
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

    //メニューにマウスを載せたとき色を変える
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    gCircleResult:longint; //グローバル変数 form1への回答連絡用
    oldpos:longint; //ひとつ前に載せた選択円の場所
    CirCleMenu: array[0..11] of TCirCleMenu; //選択円を１２個用意します

    //マウスの座標が選択円の何番目に在るか？
    function  AskCirCleMenuId(x,y:longint):longint;

    //サークルメニューを描画
    procedure DrawCirMenu;
    procedure DrawCirSub(pos,Clr:longint);
  end;

const
   LRadSize =200; //メニュー半径200pix
   SRadSize =50;  //小さいメニュー半径 30pix
   CenterX=LRadSize+SRadSize*2;   //メニュー表示位置中心
   CenterY=LRadSize+SRadSize*2;

var
  Form2: TForm2;

implementation

{$R *.dfm}

//マウスダウンイベントでポチった選択円を判定して、form1へ回答
procedure TForm2.FormCreate(Sender: TObject);
begin
  form2.Width :=(CenterX+LRadSize+SRadSize*2);
  form2.Height:=(CenterY+LRadSize+SRadSize*2);
  BorderStyle:=bsnone;
  BorderWidth:=0;
  font.Name:='Meiryo UI';
  font.Size:=10;
  font.Color:=clGray;

  //テストデータ　ネコの気持ちは難しい
  form2.CirCleMenu[0].Caption:='吸う';
  form2.CirCleMenu[1].Caption:='しっぽで遊ぶ';
  form2.CirCleMenu[2].Caption:='一緒にこたつで寝る';
  form2.CirCleMenu[3].Caption:='おもちゃをあげる';
  form2.CirCleMenu[4].Caption:='お風呂に入れる';
  form2.CirCleMenu[5].Caption:='モフモフする';
  form2.CirCleMenu[6].Caption:='猫まんまをあげる';
  form2.CirCleMenu[7].Caption:='かつおぶしをあげる';
  form2.CirCleMenu[8].Caption:='障子でやりたい放題';
  form2.CirCleMenu[9].Caption:='爪とぎ段ボールを用意';
  form2.CirCleMenu[10].Caption:='ボールを投げる';
  form2.CirCleMenu[11].Caption:='猫缶をあげる';
end;

procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Pos:longint;
begin
  Pos:=AskCirCleMenuId(x,y);  //ポチった位置を問合せ
  if pos=-1 then
    exit;        //resultが-1はハズレ

  gCircleResult:=Pos; //form1への回答はグローバル変数を使います
  form2.Close;        //form2を閉じます
end;

//マウス移動イベントで選択円のどれに載せたか？　判定して描画します
procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  pos:longint;
begin
  Pos:=AskCirCleMenuId(x,y);  //ポチった位置を問合せ

  //載せたメニューを黄色に塗ります
  with form2.Canvas do
  begin
    if Pos=-1 then
    begin
      DrawCirSub(oldpos,clSilver);
      exit;
    end;

    //古い位置の円を描き直す
    if OldPos>=0 then
      DrawCirSub(oldpos,clSilver);

    if pos>=0 then
      DrawCirSub(pos,clYellow);

    OldPos:=Pos;  //処理の最後で、古い位置を更新
  end;

end;

//サークルメニューを描画します
procedure TForm2.DrawCirMenu;
var
  i:longint;
  R:TRect;
begin
  with form2.Canvas do
  begin
    //form2の全部を黒ベタ塗り
    R:=rect(0,0,Form2.Width,form2.Height); //矩形領域を作成
    brush.Color:=clblack;    //ブラシの色を黒にする
    FillRect(R);             //矩形領域を塗ります
    TransparentColor:=true;  //透過色の機能を使います
    TransparentColorValue:=clblack;  //透過色は黒色に設定

    //選択円から外れたときの判定のために、背景が必要
    //透過する場所はmousemoveイベントが起きないので判定できないんです
     brush.Color:=clGray;    //ブラシの色を灰色にする
     pen.Color:=clGray;      //ペンの色を灰色にする
     form2.Canvas.Ellipse(CenterX-LRadSize-SRadSize-10,
     CenterY-LRadSize-SRadSize-10, CenterX+LRadSize+SRadSize+10,
     CenterY+LRadSize+SRadSize+10); //背景に灰色の円を描く。

    //見た目重視で真ん中を抜きます
    brush.Color:=clblack;
    form2.Canvas.Ellipse(
      CenterX-LRadSize+SRadSize+10, CenterY-LRadSize+SRadSize+10,
      CenterX+LRadSize-SRadSize-10, CenterY+LRadSize-SRadSize-10);
      //背景に真ん中を黒=透過色で抜きます

    //選択円を１２個描きます
    for i:=0 to 11 do
      DrawCirSub(i,clSilver);

  end;
end;

//Posの位置に、Clrの色で、選択円をひとつ分描きます。
procedure Tform2.DrawCirSub(pos,Clr:longint);
var
  rd:Double;
  ax,ay,bx,by:longint;
  TextR:TRect;
begin
  rd:= 3.14 / 6;  //2π で１周なので　π / 6 で1/12

  with form2.Canvas do
  begin
      with CirCleMenu[Pos] do
      begin
        CirX:=Trunc(cos(rd*pos-rd*3)*LRadSize+CenterX); //-rd*3 はスタートを
        CirY:=Trunc(sin(rd*pos-rd*3)*LRadSize+CenterY); //零時の位置にするため
                                                        //３引いてます

        //円を描く
        pen.Color:=Clr;     //ペンの色を銀色
        brush.Color:=Clr;   //ブラシの色も銀色

        //楕円を描画(左上x, 左上y, 右下x, 右下y);
        Ellipse(CirX-SRadSize,CirY-SRadSize,CirX+SRadSize,CirY+SRadSize);

        //文字描画
        //10時の位置の座標(ax,ay)
        ax:=Trunc(cos(rd*10-rd*3)*SRadSize+CirX);  //-rd*3 は　スタートを零時に
        ay:=Trunc(sin(rd*10-rd*3)*SRadSize+cirY);  //するために３引いてます

        // 4時の位置の座標(bx,by)
        bx:=Trunc(cos(rd*4-rd*3)*SRadSize+CirX);
        by:=Trunc(sin(rd*4-rd*3)*SRadSize+cirY);

        //テキスト矩形領域を作成 4pixは余白
        TextR:=rect(ax+4,ay,bx-4,by);

        //テキスト描画API(キャンバスのハンルドル,
        //Pchar(文字列データ), -1で文字数自動計算,
        //矩形領域はTRect型, DT_WORDBREAKで自動折返し)
        Drawtext(form2.Canvas.handle,Pchar(Caption),-1,TextR,DT_WORDBREAK);
      end;
  end;
end;


//form2を描画するイベントからサークルメニューの描画を呼出
procedure TForm2.FormPaint(Sender: TObject);
begin
  DrawCirMenu;
end;


//問合せ、マウス座標 X,Y は選択円のどこにある？
//時計と同じ配置にしています。回答は、０～11
function  Tform2.AskCirCleMenuId(x,y:longint):longint;
var
  i:longint;
  Lx,Ly,L:longint;
begin
  //選択円１２個についてマウス座標X,Yをチェック
  for i:=0 to 11 do
    with CirCleMenu[i] do
    begin
      Lx:=abs(CirX-x)*abs(CirX-x);  // 2点間の距離
      Ly:=abs(CirY-y)*abs(CirY-y);  // べき乗演算子がないので２回掛け
      L:=Trunc(Sqrt(Lx+Ly));        // L=Sqrt( (X2-X1)^2 + (y2-y1)^2 )

      if L<SRadSize then
      begin
        result:=i;  //中心から半径未満の距離X,Yがあるから、選択円の中
        exit;       //判定に通った選択円の番号をresultに返します
      end;
    end;

  result:=-1; //外れているときは-１を返します
end;

end.

プログラムの抜粋説明

実際にサークルメニューを作る Form2 (Unit2.pas)について、抜粋でご説明します。

選択円のデータを仕舞うRecordについて

サークルメニューには、いろんなデザインがありますが、ここでは１２か所の選択円があるメニューを作ります。
選択円のデータを保持するため、レコード構造体を作ります。
選択円の中心座標 X,Y と 半径 と 表示する文字列を持てるようにします。

type TCirCleMenu = record  //選択円のデータを仕舞う構造体
   CirX,             //選択円の中心 X
   CirY:longint;     //選択円の中心 Y
   Caption:string;   //選択円のキャプション
 end;
 

recordで保持しているデータは、サークルメニューの選択円で下図のように使います。

form2 の宣言部について

unit2.pasを抜粋

type
  TForm2 = class(TForm)
    //サークルメニューを表示
    procedure FormPaint(Sender: TObject);

    //メニューを選択
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

    //メニューにマウスを載せたとき色を変える
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    gCircleResult:longint; //グローバル変数 form1への回答連絡用
    oldpos:longint; //ひとつ前に載せた選択円の場所
    CirCleMenu: array[0..11] of TCirCleMenu; //選択円を１２個用意します

    //マウスの座標が選択円の何番目に在るか？
    function  AskCirCleMenuId(x,y:longint):longint;

    //サークルメニューを描画
    procedure DrawCirMenu;
    procedure DrawCirSub(pos,Clr:longint);
  end;

FormPaintイベント

フォームを描画するタイミングで自動的に呼ばれるイベントハンドラです。ここから、サークルメニューを描く手続き DrawCirMenu を呼び出します。　

FormMouseDownイベント

フォームの中でマウスのボタンを押し下げたときに発生します。クリックと違い、左右どっちのボタンでも発生します。押し下げただけで発生します。
ここでもらえるマウス座標から、選択円のどれをポチったのかを判定します。

FormMouseMoveイベント

フォームの中でマウスを転がしたら発生するイベントです。マウスを移動させただけで発生します。カッコよさを実現するために、選択しない状態でも、選択円の上にマウスを載せただけで、選択円の色を変えるために使います。
やっぱりカッコ良さは大事です。

AskCirCleMenuId(x,y:longint):longint;

オリジナルで書く手続きです。マウス座標X,Y から選択円の上にマウスがあるのか？　を判定して回答を0から11の番号で返します。

DrawCirMenu; と DrawCirSub(pos,Clr:longint);

サークルメニューを実際に描きます。

※手続きの細かい内容は、後述の実現部で説明します。

次にグローバル変数の宣言について

gCircleResult

form2 から form1 へ選択結果を返すための連絡用変数です。

oldpos

ひとつ前にマウスを載せた選択円を覚えるために使います。このデータを使って、マウスが移動したら、古い選択円の絵を、元の色に描き直します。

CirCleMenu: array[0..11] of TCirCleMenu;

さきほど宣言した 選択円のデータを仕舞うためのRecordを配列で１２個用意します。
１２個って数を決めてますから、配列の宣言方法は　array[0..11] of 型　って書き方になります。

実現部にプログラムについて

実現に書くプログラムは、
・サークルメニューの絵を描く手続き
・マウスの位置を調べる手続き
のふたつのグループに分かれます。

DrawCirMenuで、サークルメニューの絵を描きます。　

formには、透過色の設定があります。
TransparentColor:=true; で TransparentColorValue に設定した色を透過するようになります。
このプログラムの例では、form2のウインドウ領域をclBlackで黒ベタに塗ってからの、TransparentColorValue := clblack; なので、真っ黒を透過します。　
次に、選択円を表示する手続きを１２回呼び出して、選択円が１２個並ぶサークルメニューを描いてます。
あと、黒色を透過しますから、文字フォントの色は、黒以外にしてください。お勧めは、ClGrayです。

//サークルメニューを描画します
procedure TForm2.DrawCirMenu;
var
  i:longint;
  R:TRect;
begin
  with form2.Canvas do
  begin
    //form2の全部を黒ベタ塗り
    R:=rect(0,0,Form2.Width,form2.Height); //矩形領域を作成
    brush.Color:=clblack;    //ブラシの色を黒にする
    FillRect(R);             //矩形領域を塗ります
    TransparentColor:=true;  //透過色の機能を使います
    TransparentColorValue:=clblack;  //透過色は黒色に設定

    //選択円から外れたときの判定のために、背景が必要
    //透過する場所はmousemoveイベントが起きないので判定できないんです
    brush.Color:=clGray;    //ブラシの色を灰色にする
    pen.Color:=clGray;      //ペンの色を灰色にする
     form2.Canvas.Ellipse(CenterX-LRadSize-SRadSize-10,
     CenterY-LRadSize-SRadSize-10, CenterX+LRadSize+SRadSize+10,
     CenterY+LRadSize+SRadSize+10); //背景に灰色の円を描く。

    //見た目重視で背景の真ん中を抜きます。これ、なくても動作します。
    brush.Color:=clblack;
    form2.Canvas.Ellipse(
      CenterX-LRadSize+SRadSize+10, CenterY-LRadSize+SRadSize+10,
      CenterX+LRadSize-SRadSize-10, CenterY+LRadSize-SRadSize-10);
      //背景に真ん中を黒=透過色で抜きます

    //選択円を１２個描きます
    for i:=0 to 11 do
      DrawCirSub(i,clSilver);
  end;
end;

DrawCirSubは、サークルメニューの選択円のひとつ分を描きます。

DrawCirMenu 手続きから呼び出されて、Pos(0～11)の位置に、Clrの色で、選択円をひとつ分描きます。
１２個の選択円の中心座標は、ここで絵を描くときに使った数値をCirCleNume[pos]のCirXとCirYに格納します。格納した中心座標は、別途、マウスの位置判定の手続きで使用します。

表示文字は、CirCleNume[pos]のCaption から読み出しています。
テスト用の文字列は、form2.Createの中で用意しています。

//Posの位置に、Clrの色で、選択円をひとつ分描きます。
procedure Tform2.DrawCirSub(pos,Clr:longint);
var
  rd:Double;
  ax,ay,bx,by:longint;
  TextR:TRect;
begin
  rd:= 3.14 / 6;  //2π で１周なので　π / 6 で1/12

  with form2.Canvas do
  begin
      with CirCleMenu[Pos] do
      begin
        CirX:=Trunc(cos(rd*pos-rd*3)*LRadSize+CenterX); //-rd*3 はスタートを
        CirY:=Trunc(sin(rd*pos-rd*3)*LRadSize+CenterY); //零時の位置にするため
                                                        //３引いてます

        //円を描く
        pen.Color:=Clr;     //ペンの色を銀色
        brush.Color:=Clr;   //ブラシの色も銀色

        //楕円を描画(左上x, 左上y, 右下x, 右下y);
        Ellipse(CirX-SRadSize,CirY-SRadSize,CirX+SRadSize,CirY+SRadSize);

        //文字描画
        //10時の位置の座標(ax,ay)
        ax:=Trunc(cos(rd*10-rd*3)*SRadSize+CirX);  //-rd*3 は　スタートを零時に
        ay:=Trunc(sin(rd*10-rd*3)*SRadSize+cirY);  //するために３引いてます

        // 4時の位置の座標(bx,by)
        bx:=Trunc(cos(rd*4-rd*3)*SRadSize+CirX);
        by:=Trunc(sin(rd*4-rd*3)*SRadSize+cirY);

        //テキスト矩形領域を作成 4pixは余白
        TextR:=rect(ax+4,ay,bx-4,by);

        //テキスト描画API(キャンバスのハンルドル,
        //Pchar(文字列データ), -1で文字数自動計算,
        //矩形領域はTRect型, DT_WORDBREAKで自動折返し)
        Drawtext(form2.Canvas.handle,Pchar(Caption),-1,TextR,DT_WORDBREAK);
      end;
  end;
end;

Ellipse で円を描きます。

Ellipseは、対角線で与えられた楕円を描く手続きです。
輪郭線は、Canvasのpenで、塗りつぶしはBrushを用います。

文字表示は、DrawtextというAPIを使います。

DT_WORDBREAKを書式に指定すると、面倒な折り返し処理を丸投げできます。
文字数も、第３パラメータを-1にすると、自動計算してくれます。
文字表示の矩形領域は、TRect型を与えます。

パラメータ	意味
1　hDC	デバイスコンテキストのハンドル。つまり、form2.Canvas.handle
2　lpString	文字列。Pchar(String)でゼロで終わる文字列に変換してます
3　nCount	文字数。-1を指定すると自動計算します
4　lpRect	文字を詰める矩形領域。TRect型
5　uFormat	書式。 DT_WORDBREAKで自動折り返し

※DrawTextを使用するときは、uses節に、System.Typesを書き足してください。

文字を描く矩形領域の計算は、選択円を描くときの計算を流用します。
つまり、選択円の中で１０時と４時の座標を使って、選択円に内接する長方形を算出します。

座標の計算はこうなっています。

CenterX,CenterY がサークルメニュー全体の中心です。
さらに、CenterX,CenterYから半径LRadSizeに、30度刻みで12か所に、選択円の中心があります。
選択円は、半径SRadSizeの円を描きます。
選択円の位置は、時計と同じになるように調整しています。
また、マウスが乗っている選択円は、色を変えるようにしています。

マウスの位置判定をします。

選択円の番号(0～11) := AskCirCleMenuId(マウス座標 x,y); で判定します。
１２個の選択円について、マウス座標のX,Y と 選択円の中心と半径を比較して、選択円の中か外かを判定しています。

//問合せ、マウス座標 X,Y は選択円のどこにある？
//時計と同じ配置にしています。回答は、０～11
function  Tform2.AskCirCleMenuId(x,y:longint):longint;
var
  i:longint;
  Lx,Ly,L:longint;
begin
  //選択円１２個についてマウス座標X,Yをチェック
  for i:=0 to 11 do
    with CirCleMenu[i] do
    begin
      Lx:=abs(CirX-x)*abs(CirX-x);  // 2点間の距離
      Ly:=abs(CirY-y)*abs(CirY-y);  // べき乗演算子がないので２回掛け
      L:=Trunc(Sqrt(Lx+Ly));        // L=Sqrt( (X2-X1)^2 + (y2-y1)^2 )

      if L<SRadSize then
      begin
        result:=i;  //中心から半径未満の距離に、マウスのX,Yがあるから、選択円の中
        exit;       //判定に通った選択円の番号をresultに返します
      end;
    end;

  result:=-1; //外れているときは-１を返します
end;

マウスの移動 (MouseMoveイベント) に合わせて選択円を描き直します

AskCirCleMenuId( マウス座標 x,y ); で得た選択円の位置 0～11　に合わせて、選択円を描き直します。
古い選択円を銀色で描き直してから、新しい選択円を描き直します。
最後に、古い選択円の番号を更新します。

//マウス移動イベントで選択円のどれに載せたか？　判定して描画します
procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  pos:longint;
begin
  Pos:=AskCirCleMenuId(x,y);  //度の選択円内にマウスがいるか？　を問合せ

  //載せたメニューを黄色に塗ります
  with form2.Canvas do
  begin
    if Pos=-1 then   //-1はすべての選択円の外の余白にマウスがいる
    begin
      DrawCirSub(oldpos,clSilver);
      exit;
    end;

    //古い位置の円を描き直す
    if OldPos>=0 then
      DrawCirSub(oldpos,clSilver);

    if pos>=0 then
      DrawCirSub(pos,clYellow);

    OldPos:=Pos;  //処理の最後で、古い位置を更新
  end;

end;

実行します。

くるっと１２か所に、ネコと仲良くなるために必要な選択肢が表示されますか？
マウスを載せると色が黄色になりますか？
ポチれますか？

上手く行ったら、成功です。