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

# はじめに

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

# Windows / macOS の場合

[TListBox.AllowDrag プロパティ](https://docwiki.embarcadero.com/Libraries/ja/FMX.ListBox.TListBox.AllowDrag) を True にするだけ！！

<img src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/12977/3fcdf2b9-d8e6-1728-b297-1923a8042d14.png" width=600>

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

<img src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/12977/90c0331e-f07b-d43b-138c-f80a4fe6c48b.gif" width=400>

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

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

<img src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/12977/f6331193-fada-3d96-bb95-04a1ec8e304d.gif" width=400>

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

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

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

<img src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/12977/dab2a818-6c1a-afdc-f653-1e6cebb1b4b6.png" width=400>

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

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

[IFMXDragDropService](https://docwiki.embarcadero.com/Libraries/ja/FMX.Platform.IFMXDragDropService) は、Windows / macOS で提供されているサービスでこれが使える場合、AllowDrag が効きます。
なので、最初にこれが取得できるかを見て、使える場合 FDraggable を True にします。

```delphi
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 ではドラッグ動作が発生しなくなりました。

```delphi
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 し、以下のように書き換えます。

```delphi
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;
```

:::note info
* [TControl.Pressed](https://docwiki.embarcadero.com/Libraries/ja/FMX.Controls.TControl.Pressed) は、現在マウスの左ボタンが押されているかどうかを返すプロパティ
* [TControl.PressedPosition](https://docwiki.embarcadero.com/Libraries/ja/FMX.Controls.TControl.PressedPosition) は、MouseDown 時の位置が入っているプロパティ
* [ItemDown](https://docwiki.embarcadero.com/Libraries/ja/FMX.ListBox.TCustomListBox.ItemDown)は MouseDown した時に Mouse の下にあった Item を表すプロパティ (範囲外なら nil です)
* [MakeScreenshot](https://docwiki.embarcadero.com/Libraries/ja/FMX.Controls.TControl.MakeScreenshot) は、コントロールのスクリーンショットを TBitmap として返すメソッド
:::

#### windows / macOS の解説
ここで重要なのは [IRoot.BeginInternalDrag](https://docwiki.embarcadero.com/Libraries/Sydney/ja/FMX.Types.IRoot.BeginInternalDrag) です。

このメソッドを呼ぶとデフォルトのドラッグ動作が始まり、ドロップ(MouseUp)するまで返ってきません。
デフォルトのドラッグ動作はコントロールによって違いますが、TListBox の場合はアイテムをドラッグして順番を並べ替える動作です。

つまるところ、MouseDown で呼んでいた IRoot.BeginInternalDrag を MouseMove に移動させただけです。

これで Windows / macOS では目的の動作が実装できました。

#### Android / iOS の解説
Android / iOS の場合は、MouseMove 時に指の下にある Item と MouseDown 時に指の下にあった Item を随時入れ替えることで Drag を実現しています。

#### 実行動画
MouseDown してそのままドラッグできてる～！
<img src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/12977/a15dc280-9319-8620-4d16-7b347b10de16.gif" width=400>

# ソース
全ソースコードは↓の Gist にあります。
https://gist.github.com/freeonterminate/b57c2f6f9f7f62782ed24c53e6cb34be

# 最後に
大量のアイテムを並べ替える必要がある場合 or モバイルでも並べ替えたい場合に有効です。