VCL 的拖动操作没有开箱即用的拖动图像,但它确实提供了一种机制来提供要使用的拖动图像。这通常通过构建您自己的“拖动图像列表”来完成,或者通过覆盖GetDragImages
控件本身的方法(当使用内部拖动对象时),或者通过在开始拖动时构建您自己的“拖动对象”,并组装GetDragImages
启动拖动时由 VCL 调用的方法中的图像列表。
TListView
这种机制与控件有点不同,TTreeView
因为底层的 api 控件本身就支持为被拖动的项目提供拖动图像。因此,与其他控件不同,这些控件会覆盖它们的GetDragImages
方法并返回在覆盖方法中创建的图像列表,DoStartDrag
其中控件要求 api 提供图像列表。这就是为什么您将无法在 VCL 代码中找到创建拖动图像的位置的原因。
要覆盖这种行为,可以在后代类中覆盖这些(可能还有其他一些)方法并实现它们。我不知道这是否容易,我发现通过在OnStartDrag
事件处理程序中构造拖动对象来提供图像列表更容易。这通常不会产生任何影响,因为在GetDragImages
调用拖动对象时,VCL 已经确定了 api 提供的图像列表,并且 api 已经创建了一个正在拖动的临时列表。然后,我们可以强制结束原始图像列表的拖动并替换我们自己的。
下面是一个过于简单的例子。除了错误处理、资源保护、热点确定等。查看 VCL 代码以了解它如何确保实际存在被拖动的项目。
type
TListWiewDragControlObjectEx = class(TDragControlObjectEx)
protected
function GetDragImages: TDragImageList; override;
end;
function TListWiewDragControlObjectEx.GetDragImages: TDragImageList;
var
Bmp: TBitmap;
R: TRect;
begin
Bmp := TBitmap.Create;
Bmp.Canvas.Brush.Color := clSkyBlue;
R := TListView(Control).Selected.DisplayRect(drBounds);
Bmp.SetSize(R.Right - R.Left, R.Bottom - R.Top);
Bmp.Canvas.Font := TListView(Control).Font;
Bmp.Canvas.TextOut(0, 0, TListView(Control).Selected.Caption);
Result := TDragImageList.Create(Control);
Result.Width := Bmp.Width;
Result.Height := Bmp.Height;
ImageList_EndDrag; // end the drag with the temporary list
Result.SetDragImage(Result.Add(Bmp, nil), 0, 0);
Bmp.Free;
end;
procedure TForm1.ListView1StartDrag(Sender: TObject;
var DragObject: TDragObject);
begin
DragObject := TListWiewDragControlObjectEx.Create(ListView1);
DragObject.AlwaysShowDragImages := True;
end;