How to handle Drag&Drop events for controls with TLayout as parent

Question

I have some problems implementing drag&drop functionality.

I'm using Delphi XE7 Update 1, Win32.

Here is the sample code in order to demonstrate my case.

unit Drag_Drop;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Memo, FMX.Layouts, FMX.ListBox,
  FMX.StdCtrls, FMX.Objects;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ListBox1: TListBox;
    ListBox2: TListBox;
    Layout1: TLayout;
    Memo1: TMemo;
    procedure ListBoxDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF;
      var Operation: TDragOperation);
    procedure ListBoxDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.ListBoxDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
begin
  Memo1.Lines.Add(Format('%s has dropped on %s', [(Data.Source as TControl).Name, (Sender as TControl).Name]));
end;

procedure TForm1.ListBoxDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF;
  var Operation: TDragOperation);
begin
  Memo1.Lines.Add(Format('%s is over on %s', [(Data.Source as TControl).Name, (Sender as TControl).Name]));
end;

end.

I run FMX project with only form (Form1).

I put a TLabel control (Label1), two TListBox controls (ListBox1, ListBox2), TLayout control (Layout1) and TMemo (Memo1) control on the form.

Label1's property 'HitTest' is set to True and 'DragMode' is set to dmAutomatic.

Memo1 is used as the logging tool.

ListBox1 has Form1 as parent control

ListBox2 has Layout1 as a parent control. ListBox2 has value 'Client' for Align property.

Both ListBox1 and ListBox2 controls have event handling procedures:

(a) ListBoxDragDrop for OnDragDrop event;

(b) ListBoxDragOver for OnDragOver event.

With the running program the Label1 is dragged and dropped on ListBox1 successfully which can be checked by Memo1 output.

But trying to drag and drop the Label1 on ListBox2 has nothing as a result. No any of two drag&drop events is triggered.

I found out that having TLayout control as one of parent control makes dragging and dropping impossible for its children.

If I use TPanel control as the only parent for the ListBox2 everything is going well, both drag&drop events are triggered. But in case if I use the chain of Tlayout -> TPanel -> TListBox controls the TListBox control is not able "to listen" drag&drop events.

Why does it happen with TLayout and what can I do to handle drag&drop events for controls which have TLayout as a parent control?

Answer 1

They changed the events for Drag and Drop via FMX (Fire Monkey). I recently was searching for the information on how to drag and drop in Fire Monkey (FMX) and everyone was suggesting using Accept in the DragOver event, but I couldn't find the variable accept.

Here is what I found that works:

I had setup Dragmode for TLabel to dmAutomatic and created this code below. It should work for all other objects.

procedure TForm1.Memo1DragDrop(Sender: TObject; const Data: TDragObject;
  const Point: TPointF);
begin
  if Data.Source is TLabel then
    begin
      memo1.Lines.Add(TLabel(Data.Source).Text);
    end;
end;

procedure TForm1.Memo1DragOver(Sender: TObject; const Data: TDragObject;
  const Point: TPointF; var Operation: TDragOperation);
begin
  Operation := TDragOperation.Move;
end;

Source: https://forums.embarcadero.com/message.jspa?messageID=901914

Answer 2

just add hitTest := true for the first layout parent from the form

exemple 1:

        layout1.parent := Form 
        ListBox1.parent := layout1

-> here layout1 must have hitTest := True

exemple 2:

        layout1.parent := form
        Layout2.parent := layout1
        listBox.parent := Layout2 

-> here, only layout1 must have hitTest = true but not the layout2

Answer 3

I had the same problem, and I don't know, why it's not working, but on XE6 I fixed it with following code, which i found somewhere here, but don't remember where.

unit Drag_Drop;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Memo, FMX.Layouts, FMX.ListBox,
  FMX.StdCtrls, FMX.Objects;

type
  TForm = class(FMX.Forms.TForm)
    protected
      function FindTarget(P: TPointF; const Data: TDragObject): IControl; override;
  end;

  TForm1 = class(TForm)
    Label1: TLabel;
    ListBox1: TListBox;
    ListBox2: TListBox;
    Layout1: TLayout;
    Memo1: TMemo;
    procedure ListBoxDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF;
      var Operation: TDragOperation);
    procedure ListBoxDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

function TForm.FindTarget(P: TPointF; const Data: TDragObject): IControl;
var
  i : Integer;
  NewObj : IControl;
begin
  Result := nil;
  for i := 0 to ChildrenCount - 1 do
  begin
    if Supports(Children[i], IControl, NewObj) and NewObj.Visible and (NewObj.HitTest or (NewObj is TLayout)) then
    begin
      NewObj := NewObj.FindTarget(P, Data);
      if Assigned(NewObj) then
        Exit(NewObj);
    end
  end;
end;

procedure TForm1.ListBoxDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
begin
  Memo1.Lines.Add(Format('%s has dropped on %s', [(Data.Source as TControl).Name, (Sender as TControl).Name]));
end;

procedure TForm1.ListBoxDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF;
  var Operation: TDragOperation);
begin
  Memo1.Lines.Add(Format('%s is over on %s', [(Data.Source as TControl).Name, (Sender as TControl).Name]));
end;

end.