項目の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;