Как обрабатывать события перетаскивания для элементов управления с TLayout как родительские

Question

У меня есть некоторые проблемы с реализацией drag & функция удаления.

Я использую Delphi XE7 Update 1, Win32.

Вот пример кода, чтобы продемонстрировать мой случай.

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. 

Я запускаю проект FMX только с формой (Form1).

Я установил элемент управления TLabel (Label1), два элемента управления TListBox (ListBox1, ListBox2), элемент управления TLayout (Layout1) и TMemo (Memo1) в форме.

Свойство Label1 'HitTest' имеет значение True, а 'DragMode' - dmAutomatic.

Memo1 используется как инструмент каротажа.

ListBox1 имеет Form1, как родительский контроль

ListBox2 имеет Layout1 в качестве родительского контроля. ListBox2 имеет значение «Клиент» для свойства Align.

Оба ListBox1 и ListBox2 управления имеют обработку событий процедуры:

(а) ListBoxDragDrop для OnDragDrop события;

(b) ListBoxDragOver для события OnDragOver.

С запущенной программой Label1 успешно перетаскивается и выпадает на ListBox1, который может быть проверен выходом Memo1.

Но попытка перетащить Label1 в ListBox2 не имеет ничего общего. Ни одно из двух перетаскиваний не срабатывает. & срабатывает событие drop.

Я узнал, что наличие контроля TLayout как одного из родительских элементов управления делает невозможным его перетаскивание и удаление.

Если я использую управление TPanel в качестве единственного родителя для ListBox2, все идет хорошо, и перетаскиваются & события капли. Но в случае, если я использую цепочку Tlayout -> TPanel -> TListBox, элемент управления TListBox не может «прослушивать» перетаскивание событий &.

Почему это происходит с TLayout и что я могу сделать для обработки перетаскивания & события отбрасывания для элементов управления, которые имеют TLayout в качестве родительского элемента управления?

Answer 1

У меня была такая же проблема, и я не знаю, почему она не работает, но на XE6 я исправил ее следующим кодом, который я нашел где-то здесь, но не помню, где.

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. 

Answer 2

просто добавить Трассировка: = верно для первого родителя макета из формы

Exemple 1:

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

-> здесь Layout1 должны Трассировка: = True

Exemple 2:

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

-> здесь только макет1 должен иметь hitTest = true, но не макет2