Recent

Author Topic: DragDrop - changing cursor  (Read 4594 times)

Birger52

  • Sr. Member
  • ****
  • Posts: 309
Re: DragDrop - changing cursor
« Reply #15 on: May 17, 2020, 08:04:38 pm »
Is there documentation somewhere, that documents the behavior of TDragObject or TDragControlObject?

I have created my own - see attachment.
It doesn't always drag, and it doesn't make the cursor - dragged .. well .. the not dragged image - transparent like it should, but makes the whole image stationary and semi-transparent, and when it drags, it doesn't change cursor to reflect Acceptance of drop or the difference in move or copy.

Documentation says to write your own and to create it in OnStartDrag.

http://www.blong.com/Conferences/BorCon2001/DragAndDrop/4114.htm closest I can find, but it is for Delphi - and it doesn't behave like described - while Lazarus descriptions of Drag/Drop doesn't mention the option to manipulate cursors at all, tho examining help files, suggests it should be possible - lie the above site explains it...

Created a small test to drag a text from an editbox to a label.
But dragging works as expexted - even Copies with [Ctrl] and Moves without it.
But it doesn't call the StartDrag at all, thogh it is assigned... so only standard cursors.
Go figure...
Lazarus 2.0.8 FPC 3.0.4
Win7 64bit
Playing and learning - strictly for my own pleasure.

winni

  • Hero Member
  • *****
  • Posts: 3197
Re: DragDrop - changing cursor
« Reply #16 on: May 17, 2020, 09:34:22 pm »
Hi!

I think there are only outdated docs from 2011 an earlier that say "work in progress".
I hope that it is now finished.

The definition of TDragObject can be found in the unit controls, line 420 ff.

Winni

Jurassic Pork

  • Hero Member
  • *****
  • Posts: 1228
Re: DragDrop - changing cursor
« Reply #17 on: May 18, 2020, 12:36:03 am »
hello,
Quote
Quote from: Birger52 on May 17, 2020, 08:04:38 pm
But dragging works as expexted - even Copies with [Ctrl] and Moves without it.
But it doesn't call the StartDrag at all, thogh it is assigned... so only standard cursors.
Go figure...
your code on mousemove  event is a drag killer . Put it on the mousedown event.  :
Code: Pascal  [Select][+][-]
  1. procedure TForm1.Edit1MouseMove(Sender:TObject; Shift:TShiftState; X,Y:Integer);
  2. begin
  3.   //if (ssLeft in Shift) and (ssSHift in Shift) then BeginDrag(true)
  4.   // else inherited;
  5. end;
  6.  
  7. procedure TForm1.Edit1StartDrag(Sender: TObject; var DragObject: TDragObject);
  8. begin
  9.     DragObject := TTextDragObject.Create(Edit1, Edit1.Text);
  10. end;
  11.  
  12. procedure TForm1.Edit1MouseDown(Sender: TObject; Button: TMouseButton;
  13.     Shift: TShiftState; X, Y: Integer);
  14. begin
  15.     if (ssLeft in Shift) and (ssSHift in Shift) then BeginDrag(true)
  16.     else inherited;
  17. end;  
  18.  

Friendly, J.P
Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

Birger52

  • Sr. Member
  • ****
  • Posts: 309
Re: DragDrop - changing cursor
« Reply #18 on: May 18, 2020, 02:40:11 am »
Can you explain why you think starting a drag in mouse move is a drag killer?

Tried moving it to Mouse Down.
It makes no difference at all.

Drag and functionality is the same, the StartDrag event is not called, and the customized DragObject is not used.
Lazarus 2.0.8 FPC 3.0.4
Win7 64bit
Playing and learning - strictly for my own pleasure.

Jurassic Pork

  • Hero Member
  • *****
  • Posts: 1228
Re: DragDrop - changing cursor
« Reply #19 on: May 18, 2020, 06:25:16 am »
Birge52,
sorry   mousemove is not a drag killer   :-X but  what is wrong in your code is the begindrag. Try  this :
Code: Pascal  [Select][+][-]
  1. procedure TForm1.Edit1MouseMove(Sender:TObject; Shift:TShiftState; X,Y:Integer);
  2. begin
  3.     if (ssLeft in Shift) and (ssSHift in Shift) then Edit1.BeginDrag(true)
  4. //    if (ssLeft in Shift) and (ssSHift in Shift) then BeginDrag(true)
  5.   else inherited;
  6. end;  

in your zip files , the bsstrings package is missing.

Friendly, J.P
« Last Edit: May 18, 2020, 06:28:54 am by Jurassic Pork »
Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

Birger52

  • Sr. Member
  • ****
  • Posts: 309
Re: DragDrop - changing cursor
« Reply #20 on: May 18, 2020, 11:56:59 am »
Doh.
Its the Edit1 control thats "being dragged" - not the form.  %)
Thx.

Changed that.
Had to implement [csDisplayDragImage] in all controls -
Code: Pascal  [Select][+][-]
  1. procedure TForm1.FormCreate(Sender:TObject);
  2. var
  3.   I: Integer;
  4. begin
  5.   ControlStyle := ControlStyle + [csDisplayDragImage];
  6.   for I := 0 to ControlCount - 1 do
  7.     with Controls[I] do
  8.       ControlStyle := ControlStyle + [csDisplayDragImage];
  9. end;
  10.  
- and dragging images are still not shown correctly


bsstrings is a collection of functions I find myself using frequently.
Attached here..
Lazarus 2.0.8 FPC 3.0.4
Win7 64bit
Playing and learning - strictly for my own pleasure.

Jurassic Pork

  • Hero Member
  • *****
  • Posts: 1228
Re: DragDrop - changing cursor
« Reply #21 on: May 19, 2020, 05:33:43 am »
hello,
if you want something like animated gif attachment, i can show you what i have changed in your code, but there are  some things I do not understand :
  • you have three bmp resources : one is BMP 32 bits color (crno) and the others (crcopy, crmove) 4 bits color. (it's why in my attachment the crno isn't OK).

  • Why do you use crno when accepted ?
Friendly, J.P
« Last Edit: May 19, 2020, 06:02:20 am by Jurassic Pork »
Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

Birger52

  • Sr. Member
  • ****
  • Posts: 309
Re: DragDrop - changing cursor
« Reply #22 on: May 19, 2020, 12:06:44 pm »
Well - bmps are created in paintdotnet - not sure why it saves them differently...

Second - there's a not missing in the if - thought I'd put it back; had removed it to see the NoDrop cursor.

Atm not really interested in animations.
I just need to have a visual feedback, that distinguishes move of data or copy of data when drag/dropping.
Lazarus 2.0.8 FPC 3.0.4
Win7 64bit
Playing and learning - strictly for my own pleasure.

Birger52

  • Sr. Member
  • ****
  • Posts: 309
Re: DragDrop - changing cursor
« Reply #23 on: May 19, 2020, 01:07:58 pm »
So - solved my problem.
Discarded the DragObject way - no documentation, and the intuitive way is definitely not getting the expected results.

So I used the way @winni pointed to:
Created cursor files rather than bmp or png.
Using glazres, rolled them all in one resource.

Defined cr... constants for the drag images, and overwrites the crNoDrag image.

The functionality uses the DragCursor property of TControl - dragging operation uses the image pointed to by this property, when a drop is accepted.
For simplicity, the DragCursor is published in a derived TDragControl - and sources in dragging operation are typecasted to this, so it is not necessary to publish them in other user derived controls.

Code: Pascal  [Select][+][-]
  1. unit TestDragForm;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, LResources;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Edit1:TEdit;
  16.     Label1:TLabel;
  17.     procedure FormCreate(Sender:TObject);
  18.     procedure Edit1MouseMove(Sender:TObject; Shift:TShiftState; X,Y:Integer);
  19.     procedure Label1DragDrop(Sender,Source:TObject; X,Y:Integer);
  20.     procedure Label1DragOver(Sender,Source:TObject; X,Y:Integer; State:TDragState; var Accept:Boolean);
  21.   private
  22.   const
  23.     crMove = TCursor(1);
  24.     crCopy = TCursor(2);
  25.   public
  26.   end;
  27.  
  28.   TDragControl = class(TControl)
  29.   published
  30.     property DragCursor;
  31.   end;
  32.  
  33. var
  34.   Form1: TForm1;
  35.  
  36. implementation
  37.  
  38. {$R *.lfm}
  39.  
  40. { TForm1 }
  41.  
  42. procedure TForm1.FormCreate(Sender:TObject);
  43. var
  44.   cur : TCursorImage;
  45. begin
  46.   cur := TCursorImage.Create;
  47.   cur.LoadFromLazarusResource('CRDRAGMove32');
  48.   cur.HotSpot := Point(0,0);
  49.   Screen.Cursors[crMove] := cur.ReleaseHandle;  // Move image
  50.   cur.LoadFromLazarusResource('CRDRAGCopy32');
  51.   cur.HotSpot := Point(0,0);
  52.   Screen.Cursors[crCopy] := cur.ReleaseHandle;  // Copy image
  53.   cur.LoadFromLazarusResource('CRDRAGNO32');
  54.   cur.HotSpot := Point(0,0);
  55.   Screen.Cursors[crNoDrop] := cur.ReleaseHandle; // Overwrite default NoDrop image
  56. end;
  57.  
  58. procedure TForm1.Edit1MouseMove(Sender:TObject; Shift:TShiftState; X,Y:Integer);
  59. begin
  60.   if (ssLeft in Shift) and (ssShift in Shift) then Edit1.BeginDrag(true)
  61.     // dragging starts with leftmousebutton and shift pressed
  62.   else inherited;
  63. end;
  64.  
  65. procedure TForm1.Label1DragDrop(Sender,Source:TObject; X,Y:Integer);
  66. var
  67.   aStr : string;
  68. begin
  69.   aStr := Label1.Caption+SLineBreak+Edit1.Text;
  70.   Label1.Caption := aStr;
  71.   if not (ssCtrl in GetKeyShiftState) then Edit1.Text := '';
  72.     // Original text removed if CTRL pressed when mousebutton is released -
  73.     // Move opertaion if Ctrl not pressed, Copy if pressed
  74. end;
  75.  
  76. procedure TForm1.Label1DragOver(Sender,Source:TObject; X,Y:Integer; State:TDragState; var Accept:Boolean);
  77. var
  78.   crNr : TCursor;
  79. begin
  80.   Accept := true;
  81.     // Room for other criteria for drop allowed
  82.     // can be separated so move or copy can be evaluated individually - not implemented here
  83.   if Accept then begin
  84.     if ssCtrl in GetKeyShiftState then crNr := crCopy
  85.     else crNr := crMove;
  86.   end else crNr := crNo;
  87.   TDragControl(Source).DragCursor := crNr;
  88. end;
  89.  
  90. initialization
  91.   {$I DragCursors32.lrs}
  92.  
  93. end.
  94.  

I'm not sure, how to share a project.
Tried zipping it all in one - and it comes to 5MB (most of which is debug info) - or around 20 times what's acceptable to upload here.
So here's the code, and resource attached.
Zipped - .lrs files are not allowed?
 :D
Lazarus 2.0.8 FPC 3.0.4
Win7 64bit
Playing and learning - strictly for my own pleasure.

lucamar

  • Hero Member
  • *****
  • Posts: 4219
Re: DragDrop - changing cursor
« Reply #24 on: May 19, 2020, 05:39:16 pm »
I'm not sure, how to share a project.
Tried zipping it all in one - and it comes to 5MB (most of which is debug info)

You can find how in the wiki: Forum: Sharing large pieces of code. Basically, in Lazarus's main menu select "Project->Publish project..."
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus/FPC 2.0.8/3.0.4 & 2.0.12/3.2.0 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

Birger52

  • Sr. Member
  • ****
  • Posts: 309
Re: DragDrop - changing cursor
« Reply #25 on: May 19, 2020, 07:31:14 pm »
Thx for info - can see that makes a difference
 8)
Lazarus 2.0.8 FPC 3.0.4
Win7 64bit
Playing and learning - strictly for my own pleasure.

 

TinyPortal © 2005-2018