CODEWITHSUNDEEP
delphilistviewdragdelphi-xe4
Michael Riley - AKA Gunny
Michael Riley - AKA Gunny

Reputation: 5184

How to change the ListView OnDrag image?

I'm using a ListView with the ViewStyle := vsReport. When I drag a row from one point to another point it takes the value of column one of the row being dragged (in the case it's 1) and displays it inside a dark grey rectangle as shown below.

enter image description here

I've tried looking around in the XE4 source code but can't find where this background color is set. I'd like to change this background color to clSkyBlue (or something similar) but don't know how it's done.

How do you go about changing the default dark grey background image of the drag operation?

Upvotes: 4

Views: 984

Answers (1)

Sertac Akyuz
Sertac Akyuz

Reputation: 54822

VCL's drag operations does not have drag images out of the box, but it does provide a mechanism for providing a drag image to be used. This is normally done by constructing your own "drag image list", either by overriding the GetDragImages method of the control itself (when an internal drag object is used), or by constructing your own "drag object" when the drag is started, and assemble an image list in its GetDragImages method to be called by the VCL when the drag is initiated.

This mechanism is a bit different though for TListView and TTreeView controls because the underlying api controls themselves natively support providing a drag image for the item that's being dragged. Hence, unlike other controls, these controls override their GetDragImages methods and return the image list that's being created in overriden DoStartDrag methods where the controls ask the api to provide the image list. This is why you won't be able to find where a drag image is created in VCL code.

To override this behavior, one could possibly override these (and possibly a few other) methods in a descendant class and implement them. I don't know if this would be easy or not, I find providing an image list through constructing a drag object in the OnStartDrag event handler easier. This normally does not have any effect, since by the time GetDragImages of our drag object is called, the VCL already has settled on an image list which the api has supplied and the api has created a temporary list that's being dragged. Then, we can force the dragging of the original image list to an end and substitute our own.

Below is an oversimplified example. Apart from error handling, resource protecting, hot spot determining etc.. look to VCL code to see how it ensures there's actually an item that's being dragged. 

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;

Upvotes: 3

Related Questions