項目のD&D移動時の移動位置表示 (リストボックス)

なんと無くメモ。

リストボックス等の項目をD&Dで移動出来るようにした場合の項目の移動先を表示する処理。

リストボックスの場合。FPrevIdxはフォーム変数です。

// OnStartDragイベント FPrevIdxを初期化する
procedure TForm1.ListBox1StartDrag(Sender: TObject; var DragObject: TDragObject);
begin
  FPrevIdx := -1;
end;

// OnMouseDown ドラッグ処理を開始
procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    (Sender As TControl).BeginDrag(False, 5);
end;

// OnDragDrop ドロップ処理。 X,Y座標からアイテムインデックスを取得。
// 現在のインデックスをそのインデックスに移動する。
procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  Idx: Integer;
begin
  Idx := ListBox1.ItemAtPos(Point(X, Y), True);
  if Idx > -1 then
  begin
    ListBox1.Items.Move(ListBox1.ItemIndex, Idx);
  end;
  FPrevIdx := -1;
end;

// OnDragOverイベント
procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
    State: TDragState; var Accept: Boolean);
var
  TargetIdx: Integer;
  Cvs: TCanvas;

  Rc: TRect;
  Lb: TListBox;
begin
  // 同一のリストボックス内での移動に限定
  Accept := Sender = Source;
  if Accept then
  begin
    Lb := Sender as TListBox;
    // 座標からアイテムインデックスを取得
    TargetIdx := Lb.ItemAtPos(Point(X, Y), True);

    if TargetIdx > -1 then
    begin
      // もう1回描画したら線が消えるように Pen.ModeをpmXorにする
      Cvs := Lb.Canvas;
      Cvs.Pen.Color := clRed;
      Cvs.Pen.Mode := pmXor;
      Cvs.Pen.Style := psSolid;
      Cvs.Pen.Width := 3;

      // FPrevIdx(前回描画したインデックス)が-1でなければFPrevIdxのアイテムの挿入線を上書きする。
      if FPrevIdx > -1 then
      begin
        rc := Lb.ItemRect(FPrevIdx);
        InflateRect(rc, -1, -1);
        if Lb.ItemIndex >= FPrevIdx then
        begin
          Cvs.MoveTo(rc.Left, rc.Top);
          Cvs.LineTo(rc.Right, rc.Top);
        end else begin
          Cvs.MoveTo(rc.Left, rc.Bottom);
          Cvs.LineTo(rc.Right, rc.Bottom);
        end;
      end;
      rc := Lb.ItemRect(TargetIdx);
      InflateRect(rc, -1, -1);

      // 今現在の選択インデックスとドロップ先のインデックスを比較して
      // 現在の方が大きければ上側に小さければ下側に線を描画する。
      if Lb.ItemIndex >= TargetIdx then
      begin
        Cvs.MoveTo(rc.Left, rc.Top);
        Cvs.LineTo(rc.Right, rc.Top);
      end else begin
        Cvs.MoveTo(rc.Left, rc.Bottom);
        Cvs.LineTo(rc.Right, rc.Bottom);
      end;
      // 線を描画したインデックスを記憶しておく
      FPrevIdx := TargetIdx;
    end;
  end;
end;

これで、下図みたいな感じで挿入位置に水色の線が表示されます。