[SOLVED] Almost There... Drag And Drop Animation

[DeBritto]

Hi Folks,
I'm trying to create an "animation" that shows a moving cell of a StringList. Then I discovered that there an example that does almost what I need. The problem is that the code below shows all the control area moving and I need to show the active cell only, not the window area (pls see gif below).
Please, I'm trying to do this but I still don't figure it out. Can you help me with that?
Warm regards,
Chris

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
9.   ExtCtrls;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     Button1: TButton;
17.     Label1: TLabel;
18.     Panel1: TPanel;
19.     procedure Button1StartDrag(Sender: TObject; var DragObject: TDragObject);
20.     procedure Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);
21.     procedure Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
22.       State: TDragState; var Accept: Boolean);
23.   private
24.     { private declarations }
25.   public
26.     { public declarations }
27.   end;
28.  
29.   { TMyDragObject }
30.  
31.   TMyDragObject = class(TDragControlObject)
32.   private
33.     FDragImages: TDragImageList;
34.   protected
35.     function GetDragImages: TDragImageList; override;
36.   public
37.     constructor Create(AControl: TControl); override;
38.     destructor Destroy; override;
39.   end;
40.  
41. var
42.   Form1: TForm1;
43.  
44. implementation
45.  
46. {$R unit1.lfm}
47.  
48. { TForm1 }
49.  
50. procedure TForm1.Button1StartDrag(Sender: TObject; var DragObject: TDragObject);
51. begin
52.   // user started dragging on Button1
53.   // create our own TDragControlObject which provides an image.
54.   DragObject := TMyDragObject.Create(Sender as TControl);
55. end;
56.  
57. procedure TForm1.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);
58. begin
59.   ShowMessage('Congratulations. You dropped button on me :)')
60. end;
61.  
62. procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
63.   State: TDragState; var Accept: Boolean);
64. var
65.   Control: TControl;
66. begin
67.   if Source is TControl then
68.     Control := Source as TControl
69.   else
70.   if Source is TDragControlObject then
71.     Control := (Source as TDragControlObject).Control
72.   else
73.     Control := nil;
74.   Accept := Control is TButton;
75. end;
76.  
77. { TMyDragObject }
78.  
79. function TMyDragObject.GetDragImages: TDragImageList;
80. begin
81.   Result := FDragImages;
82. end;
83.  
84. constructor TMyDragObject.Create(AControl: TControl);
85. var
86.   Bitmap: TBitmap;
87. begin
88.   inherited Create(AControl);
89.   FDragImages := TDragImageList.Create(AControl);
90.   AlwaysShowDragImages := True;
91.  
92.   Bitmap := TBitmap.Create;
93.   Bitmap.Width := AControl.Width;
94.   Bitmap.Height := AControl.Height;
95.   if AControl is TWinControl then
96.     (AControl as TWinControl).PaintTo(Bitmap.Canvas, 0, 0);
97.   FDragImages.Width := Bitmap.Width;
98.   FDragImages.Height := Bitmap.Height;
99.   FDragImages.Add(Bitmap, nil);
100.   FDragImages.DragHotspot := Point(Bitmap.Width, Bitmap.Height);
101.   Bitmap.Free;
102. end;
103.  
104. destructor TMyDragObject.Destroy;
105. begin
106.   FDragImages.Free;
107.   inherited Destroy;
108. end;
109.  
110. end.
111.  
112.  

[Handoko]

(pls see gif below).

Where is the gif you mentioned?
I have problem finding it.

Not really sure what you want, your code seems to work on my test.

[DeBritto]

Hi @Handoko,
I'm so Sorry. I forgot to upload the gif. It is fixed now.
Can you help me?
Warm Regards,
Chris

[Handoko]

Can you provide the source code? I need the source code to test and to understand the issue. If you're not willing to publicize it, you can create a demo that showing the issue.

To attach the source code to the forum:
Create a new folder, copy and paste all the necessary files except: the binary (exe file), *.bak, lib and backup folders. Compress the folder and send the zip here.

[DeBritto]

Hi @Handoko,

I've created an example that simulates the issue. As you'll see when you start to drag one StringGrid cell the Bitmap of all the StringGrid control is painted. What I need is the Bitmap of the specific cell that is being dragged only.
Best Regards,
Chris

[jamie]

I believe you can make a Cursor from a bitmap. assign that cursor to the list using an unused index..

The cursors are in the "Screens" class

In the stringgrid you need to update this cursor each time you get reading to do a drag operation, the image
would be that of the CELL.
Here is some example of loading it from a file. in your case you would get it from the cell.

http://delphi.cjcsoft.net/viewthread.php?tid=49594

You may even be able to use TIcon to do the same..

[DeBritto]

Hi @Jamie,
Very good idea! The only issue is that the other solution gives me a bitmap with the real content of the cell, and this other option I'll have a standard bitmap.
Best regards

[Handoko]

I improved your code (added lines #108 - #119). It still has some minor issues but I believe you can fix them to achieve exactly what you want:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
9.   ExtCtrls, Grids;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     Button1: TButton;
17.     Panel1: TPanel;
18.     StringGrid1: TStringGrid;
19.     procedure Button1StartDrag(Sender: TObject; var DragObject: TDragObject);
20.     procedure Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);
21.     procedure Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
22.       State: TDragState; var Accept: Boolean);
23.     procedure StringGrid1StartDrag(Sender: TObject; var DragObject: TDragObject
24.       );
25.   private
26.     { private declarations }
27.   public
28.     { public declarations }
29.   end;
30.  
31.   { TMyDragObject }
32.  
33.   TMyDragObject = class(TDragControlObject)
34.   private
35.     FDragImages: TDragImageList;
36.   protected
37.     function GetDragImages: TDragImageList; override;
38.   public
39.     constructor Create(AControl: TControl); override;
40.     destructor Destroy; override;
41.   end;
42.  
43. var
44.   Form1: TForm1;
45.  
46. implementation
47.  
48. {$R unit1.lfm}
49.  
50. { TForm1 }
51.  
52. procedure TForm1.Button1StartDrag(Sender: TObject; var DragObject: TDragObject);
53. begin
54.   // user started dragging on Button1
55.   // create our own TDragControlObject which provides an image.
56.   DragObject := TMyDragObject.Create(Sender as TControl);
57. end;
58.  
59. procedure TForm1.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);
60. begin
61.   ShowMessage('Congratulations. You dropped button on me :)')
62. end;
63.  
64. procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
65.   State: TDragState; var Accept: Boolean);
66. var
67.   Control: TControl;
68. begin
69.   if Source is TControl then
70.     Control := Source as TControl
71.   else
72.   if Source is TDragControlObject then
73.     Control := (Source as TDragControlObject).Control
74.   else
75.     Control := nil;
76.   Accept := Control is TButton;
77. end;
78.  
79. procedure TForm1.StringGrid1StartDrag(Sender: TObject;
80.   var DragObject: TDragObject);
81. begin
82.    DragObject := TMyDragObject.Create(Sender as TControl);
83. end;
84.  
85. { TMyDragObject }
86.  
87. function TMyDragObject.GetDragImages: TDragImageList;
88. begin
89.   Result := FDragImages;
90. end;
91.  
92. constructor TMyDragObject.Create(AControl: TControl);
93. var
94.   ARect   : TRect;
95.   Bitmap  : TBitmap;
96.   Cropped : TBitmap;
97. begin
98.   inherited Create(AControl);
99.   FDragImages := TDragImageList.Create(AControl);
100.   AlwaysShowDragImages := True;
101.  
102.   Bitmap := TBitmap.Create;
103.   Bitmap.Width := AControl.Width;
104.   Bitmap.Height := AControl.Height;
105.   if AControl is TWinControl then
106.     (AControl as TWinControl).PaintTo(Bitmap.Canvas, 0, 0);
107.  
108.   if AControl is TStringGrid then
109.   begin
110.     with (AControl as TStringGrid) do
111.       ARect := CellRect(Col, Row);
112.     Cropped := TBitmap.Create;
113.     Cropped.SetSize(ARect.Width, ARect.Height);
114.     Cropped.Canvas.CopyRect
115.       (Rect(0, 0, ARect.Width, ARect.Height), Bitmap.Canvas, ARect);
116.     Bitmap.SetSize(ARect.Width, ARect.Height);
117.     Bitmap.Canvas.Draw(0, 0, Cropped);
118.     Cropped.Free;
119.   end;
120.  
121.   FDragImages.Width := Bitmap.Width;
122.   FDragImages.Height := Bitmap.Height;
123.   FDragImages.Add(Bitmap, nil);
124.   FDragImages.DragHotspot := Point(Bitmap.Width, Bitmap.Height);
125.   Bitmap.Free;
126. end;
127.  
128. destructor TMyDragObject.Destroy;
129. begin
130.   FDragImages.Free;
131.   inherited Destroy;
132. end;
133.  
134. end.

[ASerge]

1. TDragControlObject is not released automatically, so there is a memory leak. You must inherit from TDragControlObjectEx.

Code: Pascal  [Select][+][-]

1. TMyDragObject = class(TDragControlObjectEx)

2. Button1StartDrag and StringGrid1StartDrag do the same and can be combined.

3. Hotspot must be set to mouse position.
4. No need to create a separate TBitmap to copy a part of it to the beginning.
5. Grid.Col and Grid.Row may not coincide with the position of the mouse, you need to calculate the grid cell.

Code: Pascal  [Select][+][-]

1. constructor TMyDragObject.Create(AControl: TControl);
2. var
3.   LRect: TRect;
4.   LBitmap: TBitmap;
5.   LCanvas: TCanvas;
6.   StartPos: TPoint;
7.   GridPos: TGridCoord;
8. begin
9.   inherited;
10.   FDragImages := TDragImageList.Create(Control);
11.   AlwaysShowDragImages := True;
12.   StartPos := Control.ScreenToClient(Mouse.CursorPos);;
13.   LBitmap := TBitmap.Create;
14.   try
15.     LBitmap.Width := Control.Width;
16.     LBitmap.Height := Control.Height;
17.     LCanvas := LBitmap.Canvas;
18.     if Control is TWinControl then
19.       TWinControl(Control).PaintTo(LCanvas, 0, 0);
20.     if Control is TStringGrid then
21.     begin
22.       GridPos := TStringGrid(Control).MouseToCell(StartPos);
23.       LRect := TStringGrid(Control).CellRect(GridPos.X, GridPos.Y);
24.       StartPos.Offset(-LRect.Left, -LRect.Top);
25.       LCanvas.CopyRect(Rect(0, 0, LRect.Width, LRect.Height), LCanvas, LRect);
26.       LBitmap.Width := LRect.Width;
27.       LBitmap.Height := LRect.Height;
28.     end;
29.     FDragImages.Width := LBitmap.Width;
30.     FDragImages.Height := LBitmap.Height;
31.     FDragImages.Add(LBitmap, nil);
32.     FDragImages.DragHotspot := StartPos;
33.   finally
34.     LBitmap.Free;
35.   end;
36. end;

6. DragOver can be simplified:

Code: Pascal  [Select][+][-]

1. procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
2.   State: TDragState; var Accept: Boolean);
3. var
4.   LSource: TObject;
5. begin
6.   LSource := Source;
7.   if LSource is TDragObject then
8.     LSource := TDragObject(LSource).Control;
9.   Accept := LSource is TButton;
10. end;

[DeBritto]

Hi Folks,

You all are AWESOME!
It's working now. It's because of this that I love Pascal if you have the skills, then you could do awesome things.

I just made some adjustments in order to create a bitmap with cell's content only, i.e. leaving the gridline space behind.

Warm regards,
Guys you rock!

Code: Pascal  [Select][+][-]

1. constructor TMyDragObject.Create(AControl: TControl);
2. var
3.   LRect: TRect;
4.   LBitmap: TBitmap;
5.   LCanvas: TCanvas;
6.   StartPos: TPoint;
7.   GridPos: TGridCoord;
8.   LineWidth : Integer;
9. begin
10.   inherited;
11.   FDragImages := TDragImageList.Create(Control);
12.   AlwaysShowDragImages := True;
13.   StartPos := Control.ScreenToClient(Mouse.CursorPos);;
14.   LBitmap := TBitmap.Create;
15.  
16.   try
17.     LBitmap.Width := Control.Width;
18.     LBitmap.Height := Control.Height;
19.     LCanvas := LBitmap.Canvas;
20.  
21.     if Control is TWinControl then
22.        TWinControl(Control).PaintTo(LCanvas, 0, 0);
23.  
24.     if Control is TStringGrid then
25.     begin
26.       GridPos := TStringGrid(Control).MouseToCell(StartPos);
27.       LRect := TStringGrid(Control).CellRect(GridPos.X, GridPos.Y);
28.       StartPos.Offset(-LRect.Left, -LRect.Top);
29.       LCanvas.CopyRect(Rect(0, 0, LRect.Width, LRect.Height), LCanvas, LRect);
30.       LBitmap.Width := LRect.Width;
31.       LBitmap.Height := LRect.Height;
32.     end;
33.  
34.     LineWidth := TStringGrid(Control).GridLineWidth div 2;
35.     FDragImages.Width := LBitmap.Width-LineWidth;
36.     FDragImages.Height := LBitmap.Height-LineWidth;
37.     FDragImages.Add(LBitmap, nil);
38.     FDragImages.DragHotspot := StartPos;
39.   finally
40.     LBitmap.Free;
41.   end;
42. end;
43.  

[DeBritto]

HI Folks,
You really helped me to accomplish my goal. But I'm thinking if we can push forward a little, something beyond my skills for sure.

Is it possible to paint something on the bitmap of the cell that is being moved, in order to shows if the dragged cell will be dropped  AFTER or BEFORE the source cell?

I don't have a clue on how to do this. Maybe paint a small red arrow at the left or the right of the cell, if its position - compared to the target cell, the one that is below the moving bitmap - is in a far left of the far right position.

Please see the gif attached, just to have an idea.
Warm Regards,
Christian