[Solved ... ish] Is TDragImageList.SetDrag broken?
lazarus / 39-Graphics

----------------------------------------------------------------------
EganSolo · 2022-03-05 05:58

As part of a wider question (How to change the drag image in flight
see this topic:
https://forum.lazarus.freepascal.org/index.php/topic,58521.0.html),
I've hit a snag with TDragImageList.SetDrag. Most likely, I must be
using it the wrong way so any suggestions would be helpful.

Here's the entire code in the attached project:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
SetDrag_Main; {$mode objfpc}{$H+} interface uses   Classes , SysUtils
, Forms , Controls , Graphics , Dialogs , StdCtrls; type    { TForm1
}    TForm1 = class(TForm)      ImageList1: TImageList;      ListBox1:
TListBox;      procedure FormCreate(Sender: TObject);      procedure
ListBox1StartDrag(Sender: TObject; var DragObject: TDragObject); 
 private    public    end;   { TPlainDragControlObject }  
TPlainDragControlObject = class(TDragControlObject)  protected   
 function GetDragImages : TDragImageList; override;  end; var   Form1:
TForm1; implementation {$R *.lfm} { TPlainDragControlObject } function
TPlainDragControlObject.GetDragImages: TDragImageList;begin   Result:=
Form1.ImageList1;   Result.SetDragImage(2,32,32); //??end; { TForm1
} procedure TForm1.FormCreate(Sender: TObject);begin  ControlStyle :=
ControlStyle + [csDisplayDragImage];  ListBox1.ControlStyle:=
ListBox1.ControlStyle + [csDisplayDragImage];end; procedure
TForm1.ListBox1StartDrag(Sender: TObject; var DragObject:
TDragObject);begin  If Sender is TListBox  then begin    DragObject :=
TPlainDragControlObject.Create(Sender as TListBox);  end;end; end.  
The overridden method TPlainDragControlObject.GetDragImages, I call
TDragImageList.SetDragImage which, as far as I know, is supposed to
specify the index of the image in the list to display, but the
statement is simply ignored and the image at index 0 is the one that
is always shown.

Here is the code for SetDragImage
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i { 
TDragImageList.SetDragImage  Set index of dragging image and
hotspot}function TDragImageList.SetDragImage(Index, HotSpotX,
HotSpotY: Integer): Boolean;var  CurLockedWindow: HWND;  CurDragPos:
TPoint;  R: TDragImageListResolution;begin  Result := True;  R :=
GetDraggingResolution; //<== Will always return False because the
property Dragging is false.  if R<>nil then  begin    if (FImageIndex
<> Index) or (R.DragHotSpot.X <> HotSpotX) or       (R.DragHotSpot.Y
<> HotSpotY) then    begin      FImageIndex := Index;     
R.DragHotSpot := Point(HotSpotX, HotSpotY);       // restart dragging
with new params      CurLockedWindow := R.FLockedWindow;     
CurDragPos := R.FLastDragPos;      R.EndDrag;     
R.BeginDrag(CurLockedWindow, CurDragPos.X, CurDragPos.Y);    end; 
end;end; 

SetDragImage fails because the method GetDraggingResolution returns
nil. The reason for that failure is because the read-only property 
Dragging of TDragImageListResolution is false. That property is set to
true only when the function BeginDrag of that class is called.

Inspecting the stack, I find that this method is called when
TControl.MouseMove is called as follows:
TControl.MouseMove calls
TDragManagerDefault.MouseMoveTDragManagerDefault.MouseMove calls
DragMoveDragMove calls DragStratedDragStarted then calls
TDragImageList.BeginDragTDragImageList.BeginDrag calls
TDragImageListResolution.BeginDrag
Which brings me back to the question I started with: How are we
supposed to set the index of the image to show?

Any suggestions or thoughts are welcome!

----------------------------------------------------------------------
EganSolo · 2022-03-05 11:57

I still can't figure out what's wrong with the code, but I found a
workaround ... it's kludgy to be sure but it does get the job done.
Since drag-and-drop is eminently a manual process, the clearing and
resetting of an image list won't break the bank or slow your code, but
it's still unsettling.

The solution consists in a few changes:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i  
TPlainDragControlObject = class(TDragControlObject)  private   
 fDragImageList : TDragImageList;     fImageIndex    : Integer      
;  protected     function GetDragImages : TDragImageList; override; 
public     constructor Create(aControl: TControl); override;   
 Property DragImageList : TDragImageList read fDragImageList write
fDragImageList;     Property ImageIndex    : integer read fImageIndex
write fImageIndex;  end; 
The Drag object is a bit more complex with a constructor and two
straightforward properties. Also, it no longer rely on an image list
control, instead it manages its own image list, which makes me wonder
if in fact I need it to descend from TDragControlObject vesus
TDragObject, but I am splitting hair...

The Second change consists in replacing the image list with four
images. This is merely for simplicity's sake since I don't remember
off-hand how to grab an image out of an image list, so I resorted to
the (admittedly) quick and dirty solution of creating four images that
I will use to load the image list of the drag object. In a real-life
project, that will most likely be suboptimal but since is for
demonstration purposes we'll go with it.

The third (and more important change) occurs in the OnStartDrag event
handler of the list view:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TForm1.ListBox1StartDrag(Sender: TObject; var DragObject:
TDragObject);var anItemIndex : integer;    anImage     : TImage
;begin  lbl_Result.Caption := 'We Show the result of the drag here'; 
If Sender is TListBox  then begin    DragObject :=
TPlainDragControlObject.Create(Sender as TListBox);    anItemIndex :=
ListBox1.ItemIndex;    case anItemIndex of      Accept_Idx : anImage
:= img_Accept;      Cog_Idx    : anImage := img_Cog   ;      X_Idx   
 : anImage := img_X     ;      Power_Idx  : anImage := img_Power ;   
end;    With TPlainDragControlObject(DragObject) do    begin     
fDragImageList.Add(anImage.Picture.Bitmap,Nil);      fImageIndex :=
anItemIndex;    end;  end;end; 
We are creating a new drag object for each drag and drop operation but
now, we're populating its drag image list with a lone image selected
based on the item index of the list view. That's it.

With these changes in mind, the drag-and-drop operation works as
expected but it is still unsettling: why carry an image list if the
code is meant to always work with the image at index 0?

Anyway, this solution works for now and I can revert back to figuring
out how to change the image mid-flight...