横スクロールするメニューを考える (Delphi)

最近のスマホのアプリでメニューバーの部分が横スクロールするパターンがあるので、こんな感じかなと作ってみた

こんなの作りました

これは Win32で実行していますが、スマホでも同様に動きます

考え方

ToolBar の上に、横長のパネルを貼り付けて、それをぐりぐり動かしています。
パネルの X 座標の左右の限界値ですが、

• 右方向に押し出したときの限界の座標値は 0
• 左方向に押し出された際の X 座標の限界値は、Form.Width - Panel.Width の値になります (Panel.Width の値の方が大きいので、X 座標はマイナス値になる)

カーソルや指で触れたとき、放したときを MouseDown, MouseUp イベントで検知し MouseMove イベントで押したまま移動しているのであれば、その距離分をぐりぐり動かします。

画面の構造

オレンジのコンポーネントの HitTest プロパティは True に、ブルー側は False にしています。つまり 横長の Panel と、ボタンの上の文字に当たる Label 上のマウスイベントを検知するようにしています

設計画面

ざくっと！

サンプルコード

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.Layouts, FMX.ListBox;

type
  TForm1 = class(TForm)
    ToolBar1: TToolBar;
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    Panel3: TPanel;
    LabelX: TLabel;
    Panel4: TPanel;
    Label2: TLabel;
    ListBox1: TListBox;
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure LabelClick(Sender: TObject);
  private
    saveX: Single;
    scFLG: Boolean;
    { private 宣言 }
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.LabelClick(Sender: TObject);
begin
// ボタンに見せかけた部分に触れたら ListBox 内に自分のコンポーネント名を表示
  ListBox1.Items.Add(TLabel(Sender).Name);
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
// 横長のメニューにマウス(指)がクリック(触れたとき)に、
// スクロールのためのフラグを ON にして、クリックされた X 座標の現在位置を保存
  SaveX := X;
  scFLG := True;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
begin
// フラグが ON の時のみ計算を行なう
  if scFLG then
    Panel1.Position.X := Panel1.Position.X + (X - saveX);

// スクロールの限界値をチェック
// 超えている場合は、左右の限界点を代入
  if Panel1.Position.X < (Form1.Width - Panel1.Width) then
    Panel1.Position.X := Form1.Width - Panel1.Width;
  if Panel1.Position.X > 0 then
    Panel1.Position.X := 0;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
// マウス(指)が離れたのでフラグ OFF
  scFLG := False;
end;

end.