はじめに
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;
- TControl.Pressed は、現在マウスの左ボタンが押されているかどうかを返すプロパティ
- TControl.PressedPosition は、MouseDown 時の位置が入っているプロパティ
- ItemDownは MouseDown した時に Mouse の下にあった Item を表すプロパティ (範囲外なら nil です)
- MakeScreenshot は、コントロールのスクリーンショットを TBitmap として返すメソッド
windows / macOS の解説
ここで重要なのは IRoot.BeginInternalDrag です。
このメソッドを呼ぶとデフォルトのドラッグ動作が始まり、ドロップ(MouseUp)するまで返ってきません。
デフォルトのドラッグ動作はコントロールによって違いますが、TListBox の場合はアイテムをドラッグして順番を並べ替える動作です。
つまるところ、MouseDown で呼んでいた IRoot.BeginInternalDrag を MouseMove に移動させただけです。
これで Windows / macOS では目的の動作が実装できました。
Android / iOS の解説
Android / iOS の場合は、MouseMove 時に指の下にある Item と MouseDown 時に指の下にあった Item を随時入れ替えることで Drag を実現しています。
実行動画
MouseDown してそのままドラッグできてる～！
ソース
全ソースコードは↓の Gist にあります。
https://gist.github.com/freeonterminate/b57c2f6f9f7f62782ed24c53e6cb34be
最後に
大量のアイテムを並べ替える必要がある場合 or モバイルでも並べ替えたい場合に有効です。