DragDrop mit TTreeViewItem als Ziel

[Harry Stahl]

Letztlich willst Du ja ein Event auf das TreeviewItem verwenden, also musst Du denen zunächst auch die Events (am besten zur Laufzeit) zuordnen. Das habe ich im Create-Event gemacht. Da gibt es wohl einen Bug (?), da die Zuordnung nur funktioniert, wenn das TTreeView einmal expandiert wurde.

In der Anlage findest Du die lauffähige Demo, wo somit das Drag & Drop auf die Items auch funktioniert.

Hier der angepasste Source:

Delphi-Quellcode:

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base,
  FMX.ListView, FMX.TreeView, FMX.Layouts,FMX.Platform, FMX.Objects;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    TreeViewItem1: TTreeViewItem;
    TreeViewItem2: TTreeViewItem;
    TreeViewItem3: TTreeViewItem;
    TreeViewItem4: TTreeViewItem;
    TreeViewItem5: TTreeViewItem;
    TreeViewItem6: TTreeViewItem;
    TreeViewItem7: TTreeViewItem;
    TreeViewItem8: TTreeViewItem;
    TreeViewItem9: TTreeViewItem;
    TreeViewItem10: TTreeViewItem;
    ListView1: TListView;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure ListView1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);
    procedure TreeView1DragOver(Sender: TObject; const Data: TDragObject;
      const Point: TPointF; var Operation: TDragOperation);
    procedure TreeView1DragDrop(Sender: TObject; const Data: TDragObject;
      const Point: TPointF);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
var
  Item: TListViewItem;
  i: integer;
begin
  for i := 1 to 10 do
    begin
      Item:= ListView1.Items.Add;
      Item.Text:= 'Item' + i.ToString
    end;

  TreeView1.ExpandAll; // Ohne das funktioniert die Zuweisung nicht für untergeordnete Elemente! (Bug?)

  for i := 0 to TreeView1.GlobalCount-1 do begin
    TreeView1.ItemByGlobalIndex(i).OnDragDrop := TreeView1DragDrop;
    TreeView1.ItemByGlobalIndex(i).OnDragOver := TreeView1DragOver;
  end;

  TreeView1.CollapseAll;
end;

procedure TForm1.ListView1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
var
  Svc: IFMXDragDropService;
  DragData: TDragObject;
  Item: TListViewItem;
  List: TListView;
begin
  if (SsLeft in Shift) then
  begin
    List:= Sender as TListView;
    Item:= TListViewItem(List.Selected);
    if Assigned(Item) and TPlatformServices.Current.SupportsPlatformService(IFMXDragDropService, Svc) then
    begin
      DragData.Source:= Item;
//      DragData.Data:= Item.TagObject;
      Svc.BeginDragDrop(Self, DragData, Image1.Bitmap);
    end;
  end;
end;

procedure TForm1.TreeView1DragDrop(Sender: TObject; const Data: TDragObject;
  const Point: TPointF);
begin
  if Assigned(TreeView1.Selected) then begin
    Treeview1.Selected.Text:= TListViewItem(Data.Source).Text
  end;
end;

procedure TForm1.TreeView1DragOver(Sender: TObject; const Data: TDragObject;
  const Point: TPointF; var Operation: TDragOperation);
begin
  Operation:= TDragOperation.copy;

  TTreeView(Sender).Selected:= TTreeView(Sender).ItemByPoint(Point.X, Point.y); 
end;

end.