Delphi
FMX
FireMonkey

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

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

こんなの作りました

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

考え方

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

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

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

画面の構造

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

設計画面

ざくっと!
sc01.png

サンプルコード

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.