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.
unit TestDragForm;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, LResources;
type
{ TForm1 }
TForm1 = class(TForm)
Edit1:TEdit;
Label1:TLabel;
procedure FormCreate(Sender:TObject);
procedure Edit1MouseMove(Sender:TObject; Shift:TShiftState; X,Y:Integer);
procedure Label1DragDrop(Sender,Source:TObject; X,Y:Integer);
procedure Label1DragOver(Sender,Source:TObject; X,Y:Integer; State:TDragState; var Accept:Boolean);
private
const
crMove = TCursor(1);
crCopy = TCursor(2);
public
end;
TDragControl = class(TControl)
published
property DragCursor;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender:TObject);
var
cur : TCursorImage;
begin
cur := TCursorImage.Create;
cur.LoadFromLazarusResource('CRDRAGMove32');
cur.HotSpot := Point(0,0);
Screen.Cursors[crMove] := cur.ReleaseHandle; // Move image
cur.LoadFromLazarusResource('CRDRAGCopy32');
cur.HotSpot := Point(0,0);
Screen.Cursors[crCopy] := cur.ReleaseHandle; // Copy image
cur.LoadFromLazarusResource('CRDRAGNO32');
cur.HotSpot := Point(0,0);
Screen.Cursors[crNoDrop] := cur.ReleaseHandle; // Overwrite default NoDrop image
end;
procedure TForm1.Edit1MouseMove(Sender:TObject; Shift:TShiftState; X,Y:Integer);
begin
if (ssLeft in Shift) and (ssShift in Shift) then Edit1.BeginDrag(true)
// dragging starts with leftmousebutton and shift pressed
else inherited;
end;
procedure TForm1.Label1DragDrop(Sender,Source:TObject; X,Y:Integer);
var
aStr : string;
begin
aStr := Label1.Caption+SLineBreak+Edit1.Text;
Label1.Caption := aStr;
if not (ssCtrl in GetKeyShiftState) then Edit1.Text := '';
// Original text removed if CTRL pressed when mousebutton is released -
// Move opertaion if Ctrl not pressed, Copy if pressed
end;
procedure TForm1.Label1DragOver(Sender,Source:TObject; X,Y:Integer; State:TDragState; var Accept:Boolean);
var
crNr : TCursor;
begin
Accept := true;
// Room for other criteria for drop allowed
// can be separated so move or copy can be evaluated individually - not implemented here
if Accept then begin
if ssCtrl in GetKeyShiftState then crNr := crCopy
else crNr := crMove;
end else crNr := crNo;
TDragControl(Source).DragCursor := crNr;
end;
initialization
{$I DragCursors32.lrs}
end.
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?