[Solved ... ish] Is TDragImageList.SetDrag broken?

[EganSolo]

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][+][-]

1. unit SetDrag_Main;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.    Classes , SysUtils , Forms , Controls , Graphics , Dialogs , StdCtrls;
9.  
10. type
11.  
12.    { TForm1 }
13.  
14.    TForm1 = class(TForm)
15.       ImageList1: TImageList;
16.       ListBox1: TListBox;
17.       procedure FormCreate(Sender: TObject);
18.       procedure ListBox1StartDrag(Sender: TObject; var DragObject: TDragObject);
19.    private
20.  
21.    public
22.  
23.    end;
24.  
25.   { TPlainDragControlObject }
26.  
27.   TPlainDragControlObject = class(TDragControlObject)
28.   protected
29.      function GetDragImages : TDragImageList; override;
30.   end;
31.  
32. var
33.    Form1: TForm1;
34.  
35. implementation
36.  
37. {$R *.lfm}
38.  
39. { TPlainDragControlObject }
40.  
41. function TPlainDragControlObject.GetDragImages: TDragImageList;
42. begin
43.    Result:= Form1.ImageList1;
44.    Result.SetDragImage(2,32,32); //??
45. end;
46.  
47. { TForm1 }
48.  
49. procedure TForm1.FormCreate(Sender: TObject);
50. begin
51.   ControlStyle := ControlStyle + [csDisplayDragImage];
52.   ListBox1.ControlStyle:= ListBox1.ControlStyle + [csDisplayDragImage];
53. end;
54.  
55. procedure TForm1.ListBox1StartDrag(Sender: TObject; var DragObject: TDragObject);
56. begin
57.   If Sender is TListBox
58.   then begin
59.     DragObject := TPlainDragControlObject.Create(Sender as TListBox);
60.   end;
61. end;
62.  
63. end.
64.  
65.  

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][+][-]

1. {
2.   TDragImageList.SetDragImage
3.   Set index of dragging image and hotspot
4. }
5. function TDragImageList.SetDragImage(Index, HotSpotX, HotSpotY: Integer): Boolean;
6. var
7.   CurLockedWindow: HWND;
8.   CurDragPos: TPoint;
9.   R: TDragImageListResolution;
10. begin
11.   Result := True;
12.   R := GetDraggingResolution; //<== Will always return False because the property Dragging is false.
13.   if R<>nil then
14.   begin
15.     if (FImageIndex <> Index) or (R.DragHotSpot.X <> HotSpotX) or
16.        (R.DragHotSpot.Y <> HotSpotY) then
17.     begin
18.       FImageIndex := Index;
19.       R.DragHotSpot := Point(HotSpotX, HotSpotY);
20.  
21.       // restart dragging with new params
22.       CurLockedWindow := R.FLockedWindow;
23.       CurDragPos := R.FLastDragPos;
24.       R.EndDrag;
25.       R.BeginDrag(CurLockedWindow, CurDragPos.X, CurDragPos.Y);
26.     end;
27.   end;
28. end;
29.  

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.MouseMove
• TDragManagerDefault.MouseMove calls DragMove
• DragMove calls DragStrated
• DragStarted then calls TDragImageList.BeginDrag
• TDragImageList.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]

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][+][-]

1.   TPlainDragControlObject = class(TDragControlObject)
2.   private
3.      fDragImageList : TDragImageList;
4.      fImageIndex    : Integer       ;
5.   protected
6.      function GetDragImages : TDragImageList; override;
7.   public
8.      constructor Create(aControl: TControl); override;
9.      Property DragImageList : TDragImageList read fDragImageList write fDragImageList;
10.      Property ImageIndex    : integer read fImageIndex write fImageIndex;
11.   end;
12.  

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][+][-]

1. procedure TForm1.ListBox1StartDrag(Sender: TObject; var DragObject: TDragObject);
2. var anItemIndex : integer;
3.     anImage     : TImage ;
4. begin
5.   lbl_Result.Caption := 'We Show the result of the drag here';
6.   If Sender is TListBox
7.   then begin
8.     DragObject := TPlainDragControlObject.Create(Sender as TListBox);
9.     anItemIndex := ListBox1.ItemIndex;
10.     case anItemIndex of
11.       Accept_Idx : anImage := img_Accept;
12.       Cog_Idx    : anImage := img_Cog   ;
13.       X_Idx      : anImage := img_X     ;
14.       Power_Idx  : anImage := img_Power ;
15.     end;
16.     With TPlainDragControlObject(DragObject) do
17.     begin
18.       fDragImageList.Add(anImage.Picture.Bitmap,Nil);
19.       fImageIndex := anItemIndex;
20.     end;
21.   end;
22. end;
23.  

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...