가로 스크롤하는 메뉴를 생각합니다 (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.