[Delphi] FMX TListBox で Drag & Drop でアイテムの位置を変えたい

Last updated at 2023-12-15Posted at 2023-12-15

はじめに

ListBox の Item を Drag & Drop して順番を変えたいよー！

Windows / macOS の場合

TListBox.AllowDrag プロパティを True にするだけ！！

すると次のように Drag & Drop できようになります。

お気づきになっただろうか…？

１度選択したアイテムじゃ無いとドラッグできない！
MouseDown と同時にドラッグしてもドラッグできない！

MouseDown と同時にドラッグすると選択 Item が変わるとか誰得なの～
しかも、Andorid / iOS だと AllowDrag が True でもドラッグできないの！

MouseDown と同時にドラッグできるようにする

MouseDown して一定以上ドラッグするとドラッグになり、一定を超えなければ通常の選択動作になるようにしたい。

これを実現する TDraggableItemListBox を作成します。

1. IFMXDragDropSrvice があるかどうか取得する

IFMXDragDropService は、Windows / macOS で提供されているサービスでこれが使える場合、AllowDrag が効きます。
なので、最初にこれが取得できるかを見て、使える場合 FDraggable を True にします。

constructor TDraggableItemListBox.Create(AOwner: TComponent);
begin
  inherited;

  AllowDrag := True;
  FMoveThreashold := MOVE_THREASHOLD; // 閾値

  // AllowDrag が効くか
  FDraggable :=
    TPlatformServices.Current.SupportsPlatformService(IFMXDragDropService);
end;

2. MouseDown でのドラッグ動作を禁止する

前述の１度選択したものをドラッグできる仕組みは TCustomListBox.MouseDown で実装されています。
この動作をしてほしくないので MouseDown でのドラッグ操作を禁止します。
具体的には MouseDown を override して inherited を呼ぶ時に AllowDrag に False を指定します。
これで MouseDown ではドラッグ動作が発生しなくなりました。

procedure TDraggableListBox.MouseDown(AButton: TMouseButton; AShift: TShiftState; AX, AY: Single);
begin
  // AllowDrag が有効な場合
  if FDraggable then
  begin
    AllowDrag := False;
    try
      inherited;
    finally
      AllowDrag := True;
    end;
  end
  else
    inherited;

  // Android / iOS でドラッグ中を示すフラグを降ろす
  FMobileDragging := False;
end;

3. MouseMove でドラッグさせる

MouseMove で一定の閾値を超えて動いた時、Drag & Drop を動作させます。
そのために、TCustomListBox.MouseMove を override し、以下のように書き換えます。

procedure TDraggableListBox.MouseMove(AShift: TShiftState; AX, AY: Single);
begin
  inherited;

  // LButton が押されている &
  // 押されている Item がある &
  // モバイルでドラッグ中 or 閾値以上動いたか
  if
    Pressed and
    (ItemDown <> nil) and
    (
      (FMobileDragging) or
      (PressedPosition.Distance(PointF(AX, AY)) > FMoveThreashold)
    )
  then
  begin
    // MouseDown されている Item を示す ItemDown プロパティをローカル変数に入れる
    //（入れなくても良い）
    var Item := ItemDown;

    // 以前の Index を覚えて置く
    var OldIndex := Item.Index;

    if FDraggable then
    begin
      // AllowDrag が有効な場合 (Windows / macOS)

      // アニメーション中なら止める
      AniCalculations.MouseLeave;

      // Drag & Drop 開始
      try
        var Screenshot := Item.MakeScreenshot;
        try
          // IRoot の BeginInternalDrag メソッドを呼ぶとドラッグ動作が始まる
          Root.BeginInternalDrag(Selected, Screenshot);
        finally
          Screenshot.Free;
        end;
      finally
        // BeginInternalDrag の中で既に MouseUp されてしまっているため
        // MouseDown - MouseUp のペアが正しくなるように、ここで強制的に呼ぶ
        MouseUp(TMouseButton.mbLeft, AShift, AX, AY);
      end;
    end
    else
    begin
      // AllowDrag が無効な場合 (Android / iOS)

      // 現在位置に Item があるか？
      // あった場合、ItemDown と同じか？
      var Target := ItemByPoint(AX, AY);
      if (Item = Target) or (Target = nil) then
        Exit;

      // ドラッグ中フラグを立てて連続的に MouseMove に入るようにする
      FMobileDragging := True;

      // 現在位置の Item と MouseDown 時の Item を入れ替える
      var TargetSelected := Target.IsSelected;
      Content.Exchange(Item, Target);
      SelectionController.SetSelected(Item, True);
      SelectionController.SetSelected(Target, TargetSelected);
    end;

    // 古い Index と新しい Index が別の物だったらイベントを呼ぶ
    var NewIndex :=  Item.Index;
    if (OldIndex <> NewIndex) and Assigned(FOnDropItem) then
      FOnDropItem(Self, Item, OldIndex, NewIndex);
  end;
end;