Drag and Drop with dragged text added to drag cursor

Hi,

I am trying to drag and drop a text field between two grids, but with a twist: I want the dragged 
text to appear attached to the cursor as it is dragged across the screen. I got the code for this 
from an article by Brian Long, and is as follows:

{code:delphi}
type
  TCompleteTermDragObjectEx = class(TDragControlObjectEx)
  private
    FDragImages:        TDragImageList;
    FDragged_Term:   string;
  protected
    function GetDragImages: TDragImageList; override;
  public
    constructor Create (Control: TControl; ADragged_Term: string); reintroduce;

    property Dragged_Term: string read FDragged_Term;
  end;

  private
    Drag_Object:     TCompleteTermDragObjectEx;

{---------------------------------------------------}
constructor TCompleteTermDragObjectEx.Create (Control: TControl; ADragged_Term: string);
begin
  inherited Create (Control);
  FDragged_Term := ADragged_Term;
end;

{------------------------------------------------------------------------------}
function TCompleteTermDragObjectEx.GetDragImages: TDragImageList;
var
  Bmp:      TBitmap;
  Txt:      string;
  BmpIdx:   Integer;
begin
  if (not Assigned(FDragImages)) then
    FDragImages := TDragImageList.Create(nil);
  Result := FDragImages;
  Result.Clear;
  Bmp := TBitmap.Create;
  try
//    Txt := Format('      The control called %s says "%s" at %s',
//      [Control.Name, Data, FormatDateTime('h:nn am/pm', Time)]);
//    Txt := FDragged_Term;
    Txt := 'Hi there !!!';
    Bmp.Canvas.Font.Name  := 'Arial';
    Bmp.Canvas.Font.Style := Bmp.Canvas.Font.Style + [fsItalic];
    Bmp.Height := Bmp.Canvas.TextHeight(Txt);
    Bmp.Width  := Bmp.Canvas.TextWidth(Txt);


    Bmp.Canvas.Brush.Color := clOlive;          // Fill background with olive.
    Bmp.Canvas.FloodFill(0, 0, clWhite, fsSurface);

    Bmp.Canvas.TextOut(0, 0, Txt);              // Write the string on the bitmap.
    Result.Width  := Bmp.Width;
    Result.Height := Bmp.Height;
    // Make olive pixels transparent, whilst adding bmp to list.
    BmpIdx := Result.AddMasked(Bmp, clOlive);   // Make olive pixels transparent, whilst adding bmp 
to list.

    Result.SetDragImage(BmpIdx, 0, 0);          //
  finally
    Bmp.Free;
  end
end;

The StartDrag event contains the following line:
  Drag_Object := TCompleteTermDragObjectEx.Create (DictionaryDBGrid, Complete_Word_Dragged);

{code}

The drag and drop operation works correctly, the created Drag_Object has in its Dragged_Term field 
the text that is being dropped, etc.

However, the text being dragged does not appear attached to the cursor. Why ???

Any assistance would be appreciated.

--
JF
0
Jim
3/11/2012 11:20:03 PM
embarcadero.delphi.general 4258 articles. 0 followers. Follow

38 Replies
2587 Views

Similar Articles

[PageSpeed] 0

Forgot to add:
Test program uploaded to Attachments Forum

--
JF
0
Jim
3/12/2012 10:33:59 AM
> {quote:title=Jim Fleming wrote:}{quote}
> The StartDrag event contains the following line:
>   Drag_Object := TCompleteTermDragObjectEx.Create (DictionaryDBGrid, Complete_Word_Dragged);
> 
> {code}
> 
> The drag and drop operation works correctly, the created Drag_Object has in its Dragged_Term field 
> the text that is being dropped, etc.
> 
> However, the text being dragged does not appear attached to the cursor. Why ???
> 
> Any assistance would be appreciated.

Shouldn't Drag_Object be DragObject, or am I missing something?
--
C-H
0
Carl
3/12/2012 2:37:30 PM
Carl, yes you are right, it should be DragObject, for some reason. Must figure out why later.

The example now works, shows the text, but the DragOver validation check fails because Source is not 
the object but the drag control. When it works correctly I'll post the corrected sample so as to 
make it available to others. It will have Hot Spot functionality added by then.

Thanks,

--
Jim Fleming
0
Jim
3/12/2012 5:52:16 PM
> {quote:title=Jim Fleming wrote:}{quote}
> Carl, yes you are right, it should be DragObject, for some reason. Must figure out why later.

It's simply because You need to assign the DragObject var parameter of OnStartDrag, or else the grid and the drag object are unaware of each other.
--
C-H
0
Carl
3/12/2012 7:14:32 PM
Carl, I have posted the corrected and fully-functional sample program, without hotspot 
functionality, to the attachments forum.

--
JF
0
Jim
3/12/2012 10:45:00 PM
> {quote:title=Jim Fleming wrote:}{quote}
> Carl, I have posted the corrected and fully-functional sample program, without hotspot 
> functionality, to the attachments forum.
> 
> --
> JF
Downloaded and made a quick diff analysis. Seems Ok. Because of the custom grids the project didn't compile of course.
--
C-H
0
Carl
3/13/2012 9:35:07 AM
Carl,
Should probably work if you change the grids to TDBGrid. Haven't tried that, though.

--
JF
0
Jim
3/13/2012 9:36:49 AM
> {quote:title=Jim Fleming wrote:}{quote}
> Carl,
> Should probably work if you change the grids to TDBGrid. Haven't tried that, though.
> 
> --
> JF
Too beautiful weather today for any more attempts :-)
--
C-H
0
Carl
3/13/2012 9:54:19 AM
yeah, here too, so took off for the day. Am back at the grindstone now !!!

By the way, I programmed a HotSpot for the text image attached to the cursor just as defined in 
Brian Longs articles, but it didn't work. I don't know why and am curious to know what is wrong. 
Just curious, as I've decided to not use that functionality.

--
JF

<Carl-Henrik Nilsson> escribió en el mensaje news:452813@forums.embarcadero.com...
>> {quote:title=Jim Fleming wrote:}{quote}
>> Carl,
>> Should probably work if you change the grids to TDBGrid. Haven't tried that, though.
>>
>> --
>> JF
> Too beautiful weather today for any more attempts :-)
> --
> C-H
0
Jim
3/13/2012 6:21:39 PM
> {quote:title=Jim Fleming wrote:}{quote}
> By the way, I programmed a HotSpot for the text image attached to the cursor just as defined in 
> Brian Longs articles, but it didn't work. I don't know why and am curious to know what is wrong. 
> Just curious, as I've decided to not use that functionality.
Ok, I took a closer look at the code, and there are a couple of things that need attention.
First of all the FDragImages are never freed, so you have a memory leak and need to override destroy.
Then I suspect that you have to call SetDragImage in Create - within the scope of OnStartDrag
(you didn't state what the problem was exactly).

Try this modified code:

{code}
type
  TCompleteTermDragObjectEx = class(TDragControlObjectEx)
  private
    FDragImages:        TDragImageList;
    FDragged_Term:      string;
  protected
    function GetDragImages: TDragImageList; override;
  public
    //constructor Create(Control: TControl; ADragged_Term: string); reintroduce; //skip this line
    constructor CreateWithDragImages(Control: TControl; ADragged_Term: string);
    destructor Destroy; override;
    property Dragged_Term: string read FDragged_Term;
  end;

constructor TCompleteTermDragObjectEx.CreateWithDragImages(Control: TControl;
  ADragged_Term: string);
var
  Bmp: TBitmap;
  BmpIdx: Integer;
begin
  Create(Control);
  FDragged_Term := ADragged_Term;
  Bmp := TBitmap.Create;
  try
    Bmp.Canvas.Font.Name  := 'Arial';
    Bmp.Canvas.Font.Style := Bmp.Canvas.Font.Style + [fsItalic];
    Bmp.Height := Bmp.Canvas.TextHeight(FDragged_Term );
    Bmp.Width  := Bmp.Canvas.TextWidth(FDragged_Term );

    Bmp.Canvas.Brush.Color := clOlive;          // Fill background with olive.
    Bmp.Canvas.FloodFill(0, 0, clWhite, fsSurface);
    Bmp.Canvas.TextOut(0, 0, Txt);              // Write the string on the bitmap.

    FDragImages := TDragImageList.Create(nil);
    FDragImages.Width  := Bmp.Width;
    FDragImages.Height := Bmp.Height;
    BmpIdx := FDragImages.AddMasked(Bmp, clOlive);   // Make olive pixels transparent, whilst adding bmp to list.
    FDragImages.SetDragImage(BmpIdx, -10, 15);
  finally
    Bmp.Free;
  end;
end;

destructor TCompleteTermDragObjectEx.Destroy;
begin
  FDragImages.Free;
  inherited;
end;

function TCompleteTermDragObjectEx.GetDragImages: TDragImageList;
begin
  Result := FDragImages;
end;

{code}
No guarantees though.
--
C-H
0
Carl
3/14/2012 12:29:38 AM
Right.

When I activated EurekaLog memory leak detection it confirmed the leak, so I modified the code as 
follows:

(Note there is no change in GetDragImages nor was it necessary to free the DragObject -- that is 
done automatically, as the Delphi help says).

{code:delphi}
type
  TCompleteTermDragObjectEx = class(TDragControlObjectEx)
  private
    FDragImages:        TDragImageList;

    FDragged_Term:      string;
  protected
    function GetDragImages: TDragImageList; override;
  public
    constructor Create (Control: TControl; ADragged_Term: string); reintroduce;
    destructor  Destroy; override;

    property Dragged_Term: string read FDragged_Term;
  end;

destructor TCompleteTermDragObjectEx.Destroy;
begin
  if (Assigned(FDragImages)) then
    FDragImages.Free;
  inherited;
end;

{code}

Thanks a lot,

--
JF
0
Jim
3/14/2012 7:56:31 AM
Carl,

I have just posted the complete program again to attachments. It has no memory leaks now, and has 
some minor changes to OnDragOver and OnDragDrop to permit dropping beyond the last displayed record.

But without hot-spot functionality. If anyone manages to add it, please advise how to do so.

Thanks againd,

-- 
JF
0
Jim
3/14/2012 8:23:39 AM
> {quote:title=Jim Fleming wrote:}{quote}
> But without hot-spot functionality. If anyone manages to add it, please advise how to do so.
Err.., as Angus Johnson points out in the attachments thread - the second and third parameters of SetDragImage
set the coordinates of the hotspot for the drag bitmap relative to the cursor. Are you talking about something else?
--
C-H
0
Carl
3/14/2012 9:07:47 AM
I tried calculating the appropriate offsets using X and Y in the MouseDown event combined with 
CellRect. Calculated reasonable values, and put them in the SetDragImage call. The text attached to 
the cursor disappeared !! It was late, and other issues were more pressing, so I abandoned it at 
that point.

I'll try it again tomorrow and see what I manage to achieve.

--
JF
0
Jim
3/14/2012 8:27:39 PM
> {quote:title=Jim Fleming wrote:}{quote}
> I tried calculating the appropriate offsets using X and Y in the MouseDown event combined with 
> CellRect. Calculated reasonable values, and put them in the SetDragImage call. The text attached to 
> the cursor disappeared !! It was late, and other issues were more pressing, so I abandoned it at 
> that point.
> 
> I'll try it again tomorrow and see what I manage to achieve.
> 
> --
> JF
I see.
I suggest you do it in OnStartDrag.
Something like:
{code}
var
  HotSpotX, HotSpotY: Integer;
  P: TPoint;
  Cell: TGridCoord;
  RCell: TRect;
begin
  GetCursorPos(P);
  P := MyGrid.ScreenToClient(P);
  Cell := MyGrid.MouseCoord(P.X, P.Y);
  if (Cell.X >= 0) and (Cell.Y >= 0) then
  begin
    RCell := MyGrid.CellRect(Cell.X, Cell.Y);
    HotSpotX := P.X - RCell.Left;
    HotSpotY := P.Y - RCell.Top;
    <snip>
{code}
That should give the correct position of the cell, and then you have to adjust the position of the text relative to the upper left corner of the cell.
--
C-H

Edited by: Carl-Henrik Nilsson on Mar 14, 2012 2:28 PM

Edited by: Carl-Henrik Nilsson on Mar 14, 2012 3:11 PM
0
Carl
3/14/2012 10:12:01 PM
> {quote:title=Carl-Henrik Nilsson wrote:}{quote}
> I see.
> I suggest you do it in OnStartDrag.
> Something like:
> {code}
> var
>   HotSpotX, HotSpotY: Integer;
>   P: TPoint;
>   Cell: TGridCoord;
>   RCell: TRect;
> begin
>   GetCursorPos(P);
>   P := MyGrid.ScreenToClient(P);
>   Cell := MyGrid.MouseCoord(P.X, P.Y);
>   if (Cell.X >= 0) and (Cell.Y >= 0) then
>   begin
>     RCell := MyGrid.CellRect(Cell.X, Cell.Y);
>     HotSpotX := P.X - RCell.Left;
>     HotSpotY := P.Y - RCell.Top;
>     <snip>
> {code}
> That should give the correct position of the cell, and then you have to adjust the position of the text relative to the upper left corner of the cell.

Jim,
It was late when I posted (even had to edit twice - sorry), so here's a more thorough example of
how you can do it.

The hotspot example by Brian Long I think you are referring to -
http://www.blong.com/Conferences/BorCon2001/DragAndDrop/4114.htm
- is dragging a button around, and you're not doing that with the grid.
So I strongly suggest that you test the principle with the CreateWithDragImages constructor I posted earlier.

The code below is supposed to demonstrate what I was talking about last night.
It can be improved and I hope there aren't too many Notepad typos (and I'm really struggling with those underscores :-) ).
Note that you should keep the Drag_Object field reference so you can log Dragged_Term.

{code}
type
  TCompleteTermDragObjectEx = class(TDragControlObjectEx)
  private
    FDragImages:        TDragImageList;
    FDragged_Term:      string;
  protected
    function GetDragImages: TDragImageList; override;
  public
    //constructor Create(Control: TControl; ADragged_Term: string); reintroduce; //skip this line
    constructor CreateWithDragImages(Control: TControl;
      HotspotX, HotSpotY: Integer; CellRect: TRect; const ADragged_Term: string);
    destructor Destroy; override;
    property Dragged_Term: string read FDragged_Term;
  end;
 
constructor TCompleteTermDragObjectEx.CreateWithDragImages(Control: TControl;
  HotspotX, HotSpotY: Integer; CellRect: TRect; const ADragged_Term: string);
const
  OffsX = 0; //Hardcoded offset for the text - change it
  OffsY = 0; //Hardcoded offset for the text - change it
var
  Bmp: TBitmap;
  BmpIdx: Integer;
  R: TRect;
begin
  Create(Control);
  FDragged_Term := ADragged_Term;
  Bmp := TBitmap.Create;
  try
    Bmp.Canvas.Font.Name  := 'Arial';
    Bmp.Canvas.Font.Style := Bmp.Canvas.Font.Style + [fsItalic];
    Bmp.Height := CellRect.Bottom - CellRect.Top;
    Bmp.Width  := CellRect.Right - CellRect.Left;
    R := Bmp.Canvas.ClipRect;
    //Bmp.Canvas.Brush.Color := clOlive;
    Bmp.Canvas.Brush.Color := clSilver; //clSilver just to demo where the cell is
    Bmp.Canvas.FillRect(R);
    Bmp.Canvas.TextOut(OffsX, OffsY, FDragged_Term);

    FDragImages := TDragImageList.Create(nil);
    FDragImages.Width  := Bmp.Width;
    FDragImages.Height := Bmp.Height;
    BmpIdx := FDragImages.Add(Bmp, nil); //no transparency just to demo where the cell is
    //BmpIdx := FDragImages.AddMasked(Bmp, clOlive); // Make olive pixels transparent, whilst adding bmp to list.
    FDragImages.SetDragImage(BmpIdx, HotspotX, HotspotY);
  finally
    Bmp.Free;
  end;
end;
 
destructor TCompleteTermDragObjectEx.Destroy;
begin
  FDragImages.Free;
  inherited;
end;

function TCompleteTermDragObjectEx.GetDragImages: TDragImageList;
begin
  Result := FDragImages;
end;

//And in StartDrag:

procedure TDragDropWithTextAtCursor.Table1GridStartDrag (Sender: TObject; var DragObject: TDragObject);
var
  Name_Dragged: string;
  HotSpotX, HotSpotY: Integer;
  P: TPoint;
  Cell: TGridCoord;
  RCell: TRect;
begin
  Name_Dragged := 'Dragging';
  GetCursorPos(P);
  P := Table1Grid.ScreenToClient(P);
  Cell := Table1Grid.MouseCoord(P.X, P.Y);
  if (Cell.X > 0) and (Cell.Y > 0) then
  begin
    RCell := Table1Grid.CellRect(Cell.X, Cell.Y);
    HotSpotX := P.X - RCell.Left;
    HotSpotY := P.Y - RCell.Top;
    DragObject := TCompleteTermDragObjectEx.CreateWithDragImages(Table1Grid,
      HotSpotX, HotSpotY, RCell, Name_Dragged);
    Drag_Object := DragObject; //Keep the Drag_Object field reference so you can log Dragged_Term 
  end
  else
    CancelDrag;
end; 
{code}

Dang, had to edit!
--
C-H

Edited by: Carl-Henrik Nilsson on Mar 15, 2012 12:53 AM
0
Carl
3/15/2012 7:54:10 AM
Carl,

This code works perfectly, with an offset of +10 on the HotSpot Y axis to get what I want exactly.

Looked back at my previous code, to find it is identical, except it is in the MouseDown event and so 
goes stright to "Cell := MyGrid.MouseCoord" as the necessary X and Y come in the event.

Why did it not work before, then ???   I had (another) Senior Moment !!!!

My program has 3 OnMouseDown events. I put the code in one of them and did the test from one of the 
other two !!!  No way would that have worked !!!

Thanks,

Jim Fleming
0
Jim
3/15/2012 6:11:26 PM
Carl,

> The hotspot example by Brian Long I think you are referring to -
> http://www.blong.com/Conferences/BorCon2001/DragAndDrop/4114.htm
> - is dragging a button around, and you're not doing that with the grid.
> So I strongly suggest that you test the principle with the CreateWithDragImages constructor I 
> posted earlier.

Yes, the hotspot example I was referring to is the one you reference.

> Note that you should keep the Drag_Object field reference so you can log Dragged_Term.

Yes, in my final application's code I have kept this field, as I need it to create/modify the drop 
grid and its dataset.

The additional example you included takes the full dragged rectangle and attaches it to the cursor. 
Could be very useful if the field contained some graphic content, as is possible in Infopower grids. 
However, that is not my case, so will run with your earlier code. I have this code, however, 
squirreled away in GExperts Code Librarian for future reference.

I'll post a fresh Zip of the completed sample program, with your latest code in comments at the end, 
in the attachments group in a new thread for reference by others. I'll add your name, and that of 
Brian Long also, to make clear the origin of the code and to thank you for your assistance.

Thanks a million,

--
Jim Fleming
0
Jim
3/15/2012 6:19:42 PM
Jim,

| Why did it not work before, then ???   I had (another) Senior Moment
| !!!!
| 
| My program has 3 OnMouseDown events. I put the code in one of them
| and did the test from one of the other two !!!  No way would that
| have worked !!!

Don't you just LOVE those moments?  ;-)  


-- 

   Q

03/15/2012 16:16:46

XanaNews Version 1.19.1.278  [Q'sBrokenToolBar]
0
Quentin
3/15/2012 6:34:02 PM
> {quote:title=Jim Fleming wrote:}{quote}
> This code works perfectly, with an offset of +10 on the HotSpot Y axis to get what I want exactly.

> Why did it not work before, then ???   I had (another) Senior Moment !!!!

Glad it works, but the code is hardly state of the art. What bugs me the most is that the grid doesn't respect
the Mouse.DragThreshold - OnStartDrag fires on MouseDown and the Image shows when you click a cell.

Senior Moments? - Tell me about it! - I'm hammered with senior moments.

How about a last edit:
--
C-H

Edited by: Carl-Henrik Nilsson on Mar 15, 2012 12:05 PM
0
Carl
3/15/2012 7:06:31 PM
Yep. They hit you when you least expect them !!!

The other day I couldn't remember the name of a neighbour whom I have known and been friendly with 
for 30 years. Name came to me 10 minutes too late !!!

Just got to live with it, I suppose. No point it letting it get you down !!!!

--
JF
0
Jim
3/15/2012 7:40:39 PM
Carl,

I hadn't spotted that, but you are right -- the OnStartDrag occurs immediately following 
OnMouseDown. I'll get onto Infopower about that and see what they say.

Regards,

--
JF
0
Jim
3/15/2012 7:45:00 PM
Jim,

| Just got to live with it, I suppose. No point it letting it get you
down !!!!

You might want to investigate a couple of products from Life Extension
Foundation:  Acetyl-L-Carnitine Arginate and Cognitex.

I've been an LEF member, and using those two products, for eight years
now.  My mother had severe Alzheimers.  She was "gone" by the time she
was 70 but spent the next 13 years in a non-functional "vegetative"
state.  So I went looking for some "insurance" and discovered the Life
Extension products.  They are not cheap.  But I take about one-half the
recommended dosage so my cost is not onerous to me.

Here's a link to their promo:


http://www.lef.org/membership/benefits.htm?source=INFEML_CVB200E&key=info_CVB200E


-- 

   Q

03/16/2012 10:24:05

XanaNews Version 1.19.1.278  [Q'sBrokenToolBar]
0
Quentin
3/16/2012 11:37:40 AM
Carl,

| Senior Moments? - Tell me about it! - I'm hammered with senior
| moments.

You might look for something in your part of the world like I mentioned
in my reply to Jim.


-- 

   Q

03/16/2012 10:38:49

XanaNews Version 1.19.1.278  [Q'sBrokenToolBar]
0
Quentin
3/16/2012 11:39:40 AM
Jim,

| I'll get onto Infopower about that and see what they say.

See you there. <g>

-- 

   Q

03/16/2012 10:40:10

XanaNews Version 1.19.1.278  [Q'sBrokenToolBar]
0
Quentin
3/16/2012 11:40:33 AM
> {quote:title=Quentin Correll wrote:}{quote}

> You might look for something in your part of the world like I mentioned
> in my reply to Jim.
Quentin,
That's very considerate of you, but don't worry (I hope) -  hadn't read your post when I posted that comment,
which was just meant as something cheerful. You know, we who have gathered a little bit of life experience
tend to say "I must have had a senior moment" when the young guns just say "Duh".

Anyway, I know a lot about Alzheimers because my dear mother's fate was nearly identical to that of yours.
It was gruesome but I'm more fortunate this far.
Cheers!
--
C-H
0
Carl
3/16/2012 2:18:07 PM
Carl,

| It was gruesome but I'm more fortunate this far.

So am I!  It seems the gene(s) predominately responsible for the
Alzheimers syndrome skips (becomes recessive) generations.  <knocking
on wood>

-- 

   Q

03/16/2012 13:47:50

XanaNews Version 1.19.1.278  [Q'sBrokenToolBar]
0
Quentin
3/16/2012 2:49:44 PM
> {quote:title=Quentin Correll wrote:}{quote} 
> So am I!
We have noticed that.
Hm... I wonder if I got the english right when I wrote  "my dear mother's fate was nearly identical to that of yours"
Should I have written  "my dear mother's fate was nearly identical to that of your mother(s)" ?
--
C-H
0
Carl
3/16/2012 3:06:32 PM
Carl,

> Hm... I wonder if I got the english right when I wrote  "my dear mother's fate was nearly 
> identical to that of yours"
> Should I have written  "my dear mother's fate was nearly identical to that of your mother(s)" ?

The first above is correct, as "that" refers to "fate" and "of yours" refers to "your dear mother". 
For it to refer to Quentin, the ending should read "identical to yours". The "yours" would obviously 
be referring to "fate".

The second is also correct if you remove the final s in parenthesis, and the parenthesis.

--
Jim Fleming
0
Jim
3/16/2012 5:07:27 PM
> {quote:title=Jim Fleming wrote:}{quote}
> The first above is correct, as "that" refers to "fate" and "of yours" refers to "your dear mother". 
> For it to refer to Quentin, the ending should read "identical to yours". The "yours" would obviously 
> be referring to "fate".
> 
> The second is also correct if you remove the final s in parenthesis, and the parenthesis.
Jim,
Thank you for a splendid explanation, and I wish you good luck with your project!
--
C-H
0
Carl
3/16/2012 7:26:42 PM
Thanks, and thanks for your assistance.

--
Jim Fleming
0
Jim
3/17/2012 5:27:17 AM
Carl,

| Hm... I wonder if I got the english right when I wrote  "my dear
| mother's fate was nearly identical to that of yours" Should I have
| written  "my dear mother's fate was nearly identical to that of your
| mother(s)" ?

I understood what you meant. <g>  


-- 

   Q

03/17/2012 15:01:00

XanaNews Version 1.19.1.278  [Q'sBrokenToolBar]
0
Quentin
3/17/2012 4:01:36 PM
> {quote:title=Jim Fleming wrote:}{quote}
> I am trying to drag and drop a text field between two grids, but with a twist: I want the dragged 
> text to appear attached to the cursor as it is dragged across the screen.
> Any assistance would be appreciated.
Jim,
This is a followup to the Mouse.DragThreshold problem we ran into.
Couldn't just drop it, and I might have come up with a solution.
It's only tested on a standard TDBGrid of course (using D2010), and not every angle
is covered - there are simply too many possible combinations of options and settings for that.
Don't know what your grid is like, nor if you have recieved assistance from Infopower,
but you could always try this workaround.

The solution is to subclass the grid in the form. Set DragMode to dmAutomatic and use
the latest TCompleteTermDragObjectEx I posted. The OnStartDrag code is slightly modified.

{code}
//Declaration placed in the inteface section of the form
type
  //TDBGrid = class(DBGrids.TDBGrid)
  TwwDBGrid = class(wwDBGrid.TwwDBGrid) //I assume
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
    procedure WndProc(var Message: TMessage); override;
    procedure CellClick(Column: TColumn); override;
  private
    FDraggedCell: TGridCoord;
    FDragStartRect: TRect;
    FIsDraggingCell: Boolean;
    FMouseDownOnCell: Boolean;
    property DraggedCell: TGridCoord read FDraggedCell;
  end;


implementation

{ TwwDBGrid }//TDBGrid

procedure TwwDBGrid.CellClick(Column: TColumn);
begin
  if not FIsDraggingCell then
    inherited;
end;

procedure TwwDBGrid.DoEndDrag(Target: TObject; X, Y: Integer);
begin
  FMouseDownOnCell := False;
  inherited;
end;

procedure TwwDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  MDT: Integer;
begin
  if (DragKind = dkDrag) and (DragMode = dmAutomatic) then
  begin
    FMouseDownOnCell := False;
    FIsDraggingCell := False;
    FDraggedCell := MouseCoord(X, Y);
    if (FDraggedCell.X > 0) and (FDraggedCell.Y > 0) then
    begin
      FMouseDownOnCell := True;
      MDT := Mouse.DragThreshold;
      FDragStartRect := Bounds(X - MDT, Y - MDT, 2 * MDT, 2 * MDT);
    end;
  end;
  inherited;
end;

procedure TwwDBGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  Pt: TPoint;
begin
  if FMouseDownOnCell then
  begin
    Pt.X := X;
    Pt.Y := Y;
    if not PtInRect(FDragStartRect, Pt) then
    begin
      FIsDraggingCell := True;
      BeginDrag(True);
    end;
  end;
  inherited;
end;

procedure TwwDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if not FIsDraggingCell then
    inherited;
  FMouseDownOnCell := False;
end;

procedure TwwDBGrid.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
      begin
        //Override TControl BeginDrag
        if (DragKind = dkDrag) and (DragMode = dmAutomatic) then
        begin
          Dispatch(Message);
          Exit;
        end;
        ControlState := ControlState + [csLButtonDown];
      end;
  end;
  inherited;
end;

//And in StartDrag:
 
procedure TDragDropWithTextAtCursor.Table1GridStartDrag(Sender: TObject; var DragObject: TDragObject);
var
  Name_Dragged: string;
  HotSpotX, HotSpotY: Integer;
  P: TPoint;
  RCell: TRect;
begin
  Name_Dragged := 'Dragging';
  GetCursorPos(P);
  P := Table1Grid.ScreenToClient(P);
  RCell := Table1Grid.CellRect(Table1Grid.DraggedCell.X, Table1Grid.DraggedCell.Y);
  HotSpotX := P.X - RCell.Left;
  HotSpotY := P.Y - RCell.Top;
  DragObject := TDBGridDragObjectEx.CreateWithDragImages(Table1Grid,
    HotSpotX, HotSpotY, RCell, Name_Dragged);
end;
 
{code}

It works over here, and it might work for you. :-) 

--
C-H
0
Carl
3/19/2012 7:04:50 PM
Carl,
I have, as yet, had no response from Roy Woll at Woll2Woll.

Seeing as you have investigated this matter, I'd like to pass on your code to Roy and see what he 
thinks might need fixing. Would that be alright with you ?? I wouldn't like to pass the code without 
your permission.

Regards,

Jim Fleming

<Carl-Henrik Nilsson> escribió en el mensaje news:454702@forums.embarcadero.com...
>> {quote:title=Jim Fleming wrote:}{quote}
>> I am trying to drag and drop a text field between two grids, but with a twist: I want the dragged
>> text to appear attached to the cursor as it is dragged across the screen.
>> Any assistance would be appreciated.
> Jim,
> This is a followup to the Mouse.DragThreshold problem we ran into.
> Couldn't just drop it, and I might have come up with a solution.
> It's only tested on a standard TDBGrid of course (using D2010), and not every angle
> is covered - there are simply too many possible combinations of options and settings for that.
> Don't know what your grid is like, nor if you have recieved assistance from Infopower,
> but you could always try this workaround.
>
> The solution is to subclass the grid in the form. Set DragMode to dmAutomatic and use
> the latest TCompleteTermDragObjectEx I posted. The OnStartDrag code is slightly modified.
>
> {code}
> //Declaration placed in the inteface section of the form
> type
>  //TDBGrid = class(DBGrids.TDBGrid)
>  TwwDBGrid = class(wwDBGrid.TwwDBGrid) //I assume
>  protected
>    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
>      X, Y: Integer); override;
>    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
>    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
>      X, Y: Integer); override;
>    procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
>    procedure WndProc(var Message: TMessage); override;
>    procedure CellClick(Column: TColumn); override;
>  private
>    FDraggedCell: TGridCoord;
>    FDragStartRect: TRect;
>    FIsDraggingCell: Boolean;
>    FMouseDownOnCell: Boolean;
>    property DraggedCell: TGridCoord read FDraggedCell;
>  end;
>
>
> implementation
>
> { TwwDBGrid }//TDBGrid
>
> procedure TwwDBGrid.CellClick(Column: TColumn);
> begin
>  if not FIsDraggingCell then
>    inherited;
> end;
>
> procedure TwwDBGrid.DoEndDrag(Target: TObject; X, Y: Integer);
> begin
>  FMouseDownOnCell := False;
>  inherited;
> end;
>
> procedure TwwDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
>  Y: Integer);
> var
>  MDT: Integer;
> begin
>  if (DragKind = dkDrag) and (DragMode = dmAutomatic) then
>  begin
>    FMouseDownOnCell := False;
>    FIsDraggingCell := False;
>    FDraggedCell := MouseCoord(X, Y);
>    if (FDraggedCell.X > 0) and (FDraggedCell.Y > 0) then
>    begin
>      FMouseDownOnCell := True;
>      MDT := Mouse.DragThreshold;
>      FDragStartRect := Bounds(X - MDT, Y - MDT, 2 * MDT, 2 * MDT);
>    end;
>  end;
>  inherited;
> end;
>
> procedure TwwDBGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
> var
>  Pt: TPoint;
> begin
>  if FMouseDownOnCell then
>  begin
>    Pt.X := X;
>    Pt.Y := Y;
>    if not PtInRect(FDragStartRect, Pt) then
>    begin
>      FIsDraggingCell := True;
>      BeginDrag(True);
>    end;
>  end;
>  inherited;
> end;
>
> procedure TwwDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
>  Y: Integer);
> begin
>  if not FIsDraggingCell then
>    inherited;
>  FMouseDownOnCell := False;
> end;
>
> procedure TwwDBGrid.WndProc(var Message: TMessage);
> begin
>  case Message.Msg of
>    WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
>      begin
>        //Override TControl BeginDrag
>        if (DragKind = dkDrag) and (DragMode = dmAutomatic) then
>        begin
>          Dispatch(Message);
>          Exit;
>        end;
>        ControlState := ControlState + [csLButtonDown];
>      end;
>  end;
>  inherited;
> end;
>
> //And in StartDrag:
>
> procedure TDragDropWithTextAtCursor.Table1GridStartDrag(Sender: TObject; var DragObject: 
> TDragObject);
> var
>  Name_Dragged: string;
>  HotSpotX, HotSpotY: Integer;
>  P: TPoint;
>  RCell: TRect;
> begin
>  Name_Dragged := 'Dragging';
>  GetCursorPos(P);
>  P := Table1Grid.ScreenToClient(P);
>  RCell := Table1Grid.CellRect(Table1Grid.DraggedCell.X, Table1Grid.DraggedCell.Y);
>  HotSpotX := P.X - RCell.Left;
>  HotSpotY := P.Y - RCell.Top;
>  DragObject := TDBGridDragObjectEx.CreateWithDragImages(Table1Grid,
>    HotSpotX, HotSpotY, RCell, Name_Dragged);
> end;
>
> {code}
>
> It works over here, and it might work for you. :-)
>
> --
> C-H
0
Jim
3/20/2012 9:55:48 AM
> {quote:title=Jim Fleming wrote:}{quote}
> Seeing as you have investigated this matter, I'd like to pass on your code to Roy and see what he 
> thinks might need fixing. Would that be alright with you ?? I wouldn't like to pass the code without 
> your permission.
That would be alright of course. Tracking mouse handling in the VCL is challenging to say the least,
and if you think the code may be of use then it needs to be reviewed. What I struggled the most with was
preventing extra mouse clicks - assigned click events firing here and there.
--
C-H
0
Carl
3/20/2012 4:57:27 PM
> {quote:title=Jim Fleming wrote:}{quote}
> Seeing as you have investigated this matter, I'd like to pass on your code to Roy and see what he 
> thinks might need fixing. Would that be alright with you ?? I wouldn't like to pass the code without 
> your permission.
Jim,
It hit me that DblClick needs to be overridden as well:
{code}
procedure DblClick; override;

procedure TwwDBGrid.DblClick;
begin
  FMouseDownOnCell := False;
  inherited;
end;
{code}
--
C-H
0
Carl
3/21/2012 5:42:20 PM
> {quote:title=Carl-Henrik Nilsson wrote:}{quote}
><snip>
It's been bugging me for a whole week that I didn't use dmManual as DragMode
in the subclassing code I posted. That would be the natural and also simpler
and better choice. So here's an updated version without an overridden WndProc
(which, BTW, had a misplaced ControlState statement).

Set DragMode to dmManual.

{code}

//Declaration placed in the inteface section of the form
type
  //TDBGrid = class(DBGrids.TDBGrid)
  TwwDBGrid = class(wwDBGrid.TwwDBGrid) //I assume
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
    procedure CellClick(Column: TColumn); override;
    procedure DblClick; override;
  strict private
    FDraggedCell: TGridCoord;
    FThresholdRect: TRect;
    FIsDraggingCell: Boolean;
    FMouseDownOnCell: Boolean;
  private
    property DraggedCell: TGridCoord read FDraggedCell;
  end;
 
 
implementation
 
{ TwwDBGrid }//TDBGrid
 
procedure TwwDBGrid.CellClick(Column: TColumn);
begin
  if not FIsDraggingCell then
    inherited;
end;
 
procedure TwwDBGrid.DblClick;
begin
  FMouseDownOnCell := False;
  inherited;
end;
 
procedure TwwDBGrid.DoEndDrag(Target: TObject; X, Y: Integer);
begin
  FMouseDownOnCell := False;
  inherited;
end;
 
procedure TwwDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  MDT: Integer;
begin
  FMouseDownOnCell := False;
  FIsDraggingCell := False;
  FDraggedCell := MouseCoord(X, Y);
  if (FDraggedCell.X > 0) and (FDraggedCell.Y > 0) then
  begin
    FMouseDownOnCell := True;
    MDT := Mouse.DragThreshold;
    FThresholdRect := Bounds(X - MDT, Y - MDT, 2 * MDT, 2 * MDT);
  end;
  inherited;
end;
 
procedure TwwDBGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  Pt: TPoint;
begin
  if FMouseDownOnCell then
  begin
    Pt.X := X;
    Pt.Y := Y;
    if not PtInRect(FThresholdRect, Pt) then
    begin
      FIsDraggingCell := True;
      BeginDrag(True);
    end;
  end;
  inherited;
end;
 
procedure TwwDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if not FIsDraggingCell then
    inherited;
  FMouseDownOnCell := False;
end;

 
//And in StartDrag:
 
procedure TDragDropWithTextAtCursor.Table1GridStartDrag(Sender: TObject; var DragObject: TDragObject);
var
  Name_Dragged: string;
  HotSpotX, HotSpotY: Integer;
  P: TPoint;
  RCell: TRect;
begin
  Name_Dragged := 'Dragging';
  GetCursorPos(P);
  P := Table1Grid.ScreenToClient(P);
  RCell := Table1Grid.CellRect(Table1Grid.DraggedCell.X, Table1Grid.DraggedCell.Y);
  HotSpotX := P.X - RCell.Left;
  HotSpotY := P.Y - RCell.Top;
  DragObject := TDBGridDragObjectEx.CreateWithDragImages(Table1Grid,
    HotSpotX, HotSpotY, RCell, Name_Dragged);
end;

{code}
--
C-H
0
Carl
4/1/2012 8:40:54 PM
Carl,

I have not had a chance to return to this topic for the last week or so, having moved on to the task 
"Add 0, 1 or more images associated with each database entry". (See long thread in 
embarcadero.public.delphi.vcl.components.using titled "Suggestions for managing files . . .").

However, I did contact Woll2Woll (InfoPower) about this topic but have not had any response. Maybe 
time to send another message and see what happens.

Jim Fleming
0
Jim
4/2/2012 11:14:23 PM
Reply: