Drag and Drop в TTreeView

Drag and Drop в TTreeView

unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 ComCtrls;
type
 TForm1 = class(TForm)
  TreeView1: TTreeView;
  procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
  procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
 private
  procedure MoveNode(TargetNode, SourceNode: TTreeNode);
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.MoveNode(TargetNode, SourceNode: TTreeNode);
var
 NodeTmp: TTreeNode;
 I: Integer;
begin
 with TreeView1 do
 begin
  // проверяем, является ли целевой элемент предком перетаскиваемого
  NodeTmp := TargetNode.Parent;
  while Assigned(NodeTmp) do
  if NodeTmp = SourceNode then
  Abort
  else
  NodeTmp := NodeTmp.Parent;
  // копируем перетаскиваемый элемент в новосозданный
  NodeTmp := Items.AddChild(TargetNode, SourceNode.Text);
  NodeTmp.Data := SourceNode.Data;
  for I := 0 to SourceNode.Count - 1 do
  MoveNode(NodeTmp, SourceNode.Item[I]);
  Selected := NodeTmp;
  Item := NodeTmp.getPrev;
  TargetNode.Expand(True);
 end;
end;
procedure TForm1.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
 TargetNode, SourceNode: TTreeNode;
begin
 with TreeView1 do
 begin
  TargetNode := GetNodeAt(X, Y);
  SourceNode := Selected;
  if (TargetNode = SourceNode) or (TargetNode = nil) then
  begin
  EndDrag(False);
  Exit;
  end;
  MoveNode(TargetNode, SourceNode);
  SourceNode.Free;
 end;
end;
procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
var
 SourceNode, TargetNode, NodeTmp: TTreeNode;
begin
 if Sender = TreeView1 then
 try
  // скроллинг дерева при перетаскивании
  if Y > TreeView1.Height - 10 then
  begin
  TreeView1.Item := TreeView1.Item.get;
  Sleep(100); // пауза
  end else
  if Y < 10 then
  begin
  TreeView1.Item := TreeView1.Item.getPrev;
  Sleep(100); // пауза
  end;
  TargetNode := TreeView1.GetNodeAt(X, Y);
  SourceNode := TreeView1.Selected;
  if (TargetNode = nil) or (TargetNode = SourceNode) then Abort;
  Accept := True;
  // проверяем, является ли целевой элемент предком перетаскиваемого
  NodeTmp := TargetNode.Parent;
  while Assigned(NodeTmp) do
  if NodeTmp = SourceNode then
  Abort
  else
  NodeTmp := NodeTmp.Parent;
 except
  Accept := False;
 end;
end;
end.
Автор: Smike Взято из http://forum.sources.ru

unit Unit1;
 interface
 uses
  Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;
 type
  TForm1 = class(TForm)
  TreeView1: TTreeView;
  Label1: TLabel;
  procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
  procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
  private
  { Private declarations }
  Procedure MoveNode(TargetNode, SourceNode : TTreeNode);
  public
  { Public declarations }
  end;
 var
  Form1: TForm1;
 implementation
 {$R *.dfm}
 //
// Procedure which will move node and its subnodes
//
Procedure TForm1.MoveNode(TargetNode, SourceNode : TTreeNode);
 var
  nodeTmp : TTreeNode;
  i : Integer;
 begin
  with TreeView1 do
  begin
  nodeTmp := Items.AddChild(TargetNode,SourceNode.Text);
  for i := 0 to SourceNode.Count -1 do
  begin
  MoveNode(nodeTmp,SourceNode.Item[i]);
  end;
  end;
 end;

 procedure TForm1.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
 var
  TargetNode, SourceNode : TTreeNode;
 begin
  with TreeView1 do
  begin
  TargetNode := GetNodeAt(X,Y); // Get target node
  SourceNode := Selected;
  if (TargetNode = nil) then
  begin
  EndDrag(False);
  Exit;
  end;
  MoveNode(TargetNode,SourceNode);
  SourceNode.Free;
  end;
 end;
 procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
 begin
  if (Sender = TreeView1) then // If TRUE than accept the draged item
 begin
  Accept := True;
  end;
 end;
 end.

Взято с сайта: http://www.swissdelphicenter.ch

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...