Delphi类和组件 - TreeView 智能拖拽

属性：
  TreeView：需要实现拖拽功能的 TreeView，当把一个 TreeView
  指定给该属性后，这个 TreeView 的节点就具有智能拖拽功能了。
  DragMode = dmHotKeyDrag   // 通过快捷键才能拖拽
  HotKeyMoveNode = hkCtrl;  // 拖拽节点： Ctrl
  HotKeyCopyNode = hkShift; // 拖拽并复制节点：Shift
  HotKeyChildNode = hkAlt;  // 拖拽到子节点：Alt
  EnableRButtonDrag = True; // 允许右键拖拽，会弹出菜单
  Public 方法：
  AddNode：添加节点，根据 AddMode 决定添加的位置
  DeleteNode：删除节点，返回被删除节点临近的节点
  MoveNode：移动或复制节点，根据 MoveMode 决定移动方式
******************************************************* }
unit TreeViewManage;
interface
uses
  SysUtils, Windows, Classes, Controls, ComCtrls, Menus;
type
  TAttachMode = (amLast, amFirst, amChildLast, amChildFirst, amPrev,
    amNext, amAuto);
  { 控制拖拽方式的热键：禁止，Ctrl，Shift，Alt }
  THotKey = (hkNone, hkCtrl, hkShift, hkAlt);
  { 节点拖动方式：自动拖拽，热键拖拽，禁止拖拽 }
  TDragMode = (dmAutoDrag, dmHotKeyDrag, dmDisableDrag);
  TTreeViewDrager = class(TComponent)
  private
    FTreeView: TTreeView;
    FOldOnMouseDown: TMouseEvent;
    FOldOnMouseUp: TMouseEvent;
    FOldOnDragOver: TDragOverEvent;
    FOldOnDragDrop: TDragDropEvent;
    FDragMode: TDragMode; { 节点拖动方式 }
    FDragButton: TMouseButton; { 拖动节点的按钮 }
    FDropMenu: TPopupMenu; { 右键拖拽后的弹出菜单 }
    FMoveSourceNode: TTreeNode; { 移动的源节点 }
    FMoveTargetNode: TTreeNode; { 移动的目标节点 }
    FHotKeyMoveNode: Integer; { 拖动节点的热键 }
    FHotKeyCopyNode: Integer; { 复制节点的热键 }
    FHotKeyChildNode: Integer; { 拖动到子节点的热键 }
    FEnableRButtonDrag: Boolean; { 是否允许右键拖拽，右键拖拽会弹出菜单 }
    function GetTreeView: TCustomTreeView;
    procedure SetTreeView(Value: TCustomTreeView);
    function GetHotKeyMoveNode: THotKey;
    procedure SetHotKeyMoveNode(Key: THotKey);
    function GetHotKeyCopyNode: THotKey;
    procedure SetHotKeyCopyNode(Key: THotKey);
    function GetHotKeyChildNode: THotKey;
    procedure SetHotKeyChildNode(Key: THotKey);
    procedure MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
    procedure DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure DragDrop(Sender, Source: TObject; X, Y: Integer);
  protected
    function CreateDropMenu: TPopupMenu; virtual;
    procedure DragMenuEvent(Sender: TObject); virtual;
    function GetNewNode(RelativeNode: TTreeNode = nil; NodeName: string = '';
      AddMode: TAttachMode = amAuto): TTreeNode;
    function CloneNode(FromNode, ToNode: TTreeNode;
      MoveMode: TAttachMode = amAuto): TTreeNode;
    procedure CopyChildNodes(FromNode, ToNode: TTreeNode); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function AddNode(RelativeNode: TTreeNode = nil; NodeName: string = '';
      AddMode: TAttachMode = amAuto): TTreeNode; virtual;
    function DeleteNode(RelativeNode: TTreeNode): TTreeNode; virtual;
    function MoveNode(FromNode, ToNode: TTreeNode;
      MoveMode: TAttachMode = amAuto; bCopy: Boolean = False)
      : TTreeNode; virtual;
  published
    property TreeView: TCustomTreeView read GetTreeView Write SetTreeView;
    property DragMode: TDragMode read FDragMode Write FDragMode
      default dmHotKeyDrag;
    property HotKeyMoveNode: THotKey read GetHotKeyMoveNode
      write SetHotKeyMoveNode default hkCtrl;
    property HotKeyCopyNode: THotKey read GetHotKeyCopyNode
      write SetHotKeyCopyNode default hkShift;
    property HotKeyChildNode: THotKey read GetHotKeyChildNode
      write SetHotKeyChildNode default hkAlt;
    property EnableRButtonDrag: Boolean read FEnableRButtonDrag
      write FEnableRButtonDrag default True;
  end;
const
  { 由于 delphi 的 TreeView 所能管理的最大节点数为 65535，所以这里给出范围限制 }
  MaxNodeCount = 65535;
resourcestring
  Error_NodeOutOfRange = '警告：TreeView 节点数达到最大限制：%d，无法继续添加节点';
procedure Register;
implementation
procedure Register;
begin
  RegisterComponents('Samples', [TTreeViewDrager]);
end;
{ 判断按键是否被按下 }
function IsKeyDown(VK: Integer): Boolean;
begin
  Result := GetKeyState(VK) < 0;
end;
constructor TTreeViewDrager.Create(AOwner: TComponent);
begin
  inherited;
  FDragMode := dmHotKeyDrag;
  HotKeyMoveNode := hkCtrl;
  HotKeyCopyNode := hkShift;
  HotKeyChildNode := hkAlt;
  FDropMenu := CreateDropMenu;
  FEnableRButtonDrag := True;
end;
destructor TTreeViewDrager.Destroy;
begin
  FDropMenu.Free;
  inherited;
end;
{ ------------------------------------------------------------ }
{ 拖放后的弹出菜单 }
{ ------------------------------------------------------------ }
function TTreeViewDrager.CreateDropMenu: TPopupMenu;
const
  DropMenuName: array [1 .. 9] of PChar = ('移动到之前(;1)', '移动到之后(;2)',
    '移动到子节点最前(;5)', '移动到子节点最后(;6)', '-', '复制到之前(;A)', '复制到之后(;B)',
    '复制到子节点最前(;E)', '复制到子节点最后(;F)');
var
  I: Integer;
  NewItem: TMenuItem;
begin
  Result := TPopupMenu.Create(FTreeView);
  for I := Low(DropMenuName) to High(DropMenuName) do
  begin
    NewItem := TMenuItem.Create(FTreeView);
    NewItem.Tag := I;
    NewItem.OnClick := DragMenuEvent;
    NewItem.Caption := DropMenuName[I];
    Result.Items.Add(NewItem);
  end;
end;
procedure TTreeViewDrager.DragMenuEvent(Sender: TObject);
const
  MoveMode: array [1 .. 4] of TAttachMode = (amPrev, amNext, amChildFirst,
    amChildLast);
var
  bCopy: Boolean;
  Index: Integer;
  TargetNode: TTreeNode;
begin
  if FMoveSourceNode = nil then
    Exit;
  Index := (Sender as TMenuItem).Tag;
  if Index > (FDropMenu.Items.Count div 2 + 1) then
  begin
    Index := Index - (FDropMenu.Items.Count div 2 + 1);
    bCopy := True;
  end
  else
    bCopy := False;
  if (FMoveSourceNode = FMoveTargetNode) and (Index in [3, 4]) then
    Exit;
  TargetNode := MoveNode(FMoveSourceNode, FMoveTargetNode,
    MoveMode[Index], bCopy);
  if TargetNode <> nil then
    TargetNode.Selected := True
end;
{ ------------------------------------------------------------ }
{ 属性相关 }
{ ------------------------------------------------------------ }
function TTreeViewDrager.GetTreeView: TCustomTreeView;
begin
  Result := TCustomTreeView(FTreeView);
end;
procedure TTreeViewDrager.SetTreeView(Value: TCustomTreeView);
begin
  if FTreeView <> Value then
  begin
    FTreeView := TTreeView(Value);
    { 不能设置 TCustomTreeVIew 的 RightclickSelect 为 True
      否则右键单击会错误触发拖拽操作 }
    FTreeView.RightClickSelect := False;
    FTreeView.DragMode := dmManual;
    FOldOnMouseDown := FTreeView.OnMouseDown;
    FOldOnMouseUp := FTreeView.OnMouseUp;
    FOldOnDragOver := FTreeView.OnDragOver;
    FOldOnDragDrop := FTreeView.OnDragDrop;
    FTreeView.OnMouseDown := MouseDown;
    FTreeView.OnMouseUp := MouseUp;
    FTreeView.OnDragOver := DragOver;
    FTreeView.OnDragDrop := DragDrop;
  end;
end;
function GetCtrlKey(VirtualKey: Integer): THotKey;
begin
  case VirtualKey of
    VK_CONTROL:
      Result := hkCtrl;
    VK_MENU:
      Result := hkAlt;
    VK_SHIFT:
      Result := hkShift;
  else
    Result := hkNone;
  end;
end;
function GetVirtualKey(CtrlKey: THotKey): Integer;
begin
  case CtrlKey of
    hkCtrl:
      Result := VK_CONTROL;
    hkAlt:
      Result := VK_MENU;
    hkShift:
      Result := VK_SHIFT;
  else
    Result := 0;
  end;
end;
function TTreeViewDrager.GetHotKeyMoveNode: THotKey;
begin
  Result := GetCtrlKey(FHotKeyMoveNode);
end;
procedure TTreeViewDrager.SetHotKeyMoveNode(Key: THotKey);
begin
  FHotKeyMoveNode := GetVirtualKey(Key);
end;
function TTreeViewDrager.GetHotKeyCopyNode: THotKey;
begin
  Result := GetCtrlKey(FHotKeyCopyNode);
end;
procedure TTreeViewDrager.SetHotKeyCopyNode(Key: THotKey);
begin
  FHotKeyCopyNode := GetVirtualKey(Key);
end;
function TTreeViewDrager.GetHotKeyChildNode: THotKey;
begin
  Result := GetCtrlKey(FHotKeyChildNode);
end;
procedure TTreeViewDrager.SetHotKeyChildNode(Key: THotKey);
begin
  FHotKeyChildNode := GetVirtualKey(Key);
end;
{ ------------------------------------------------------------ }
{ 非公开方法 }
{ ------------------------------------------------------------ }
{ 添加新节点：供 AddNode 和 MoveNode 调用，避免各个 Pbulic 方法之间相互调用 }
function TTreeViewDrager.GetNewNode(RelativeNode: TTreeNode = nil;
  NodeName: string = ''; AddMode: TAttachMode = amAuto): TTreeNode;
var
  NextNode: TTreeNode;
  NodeAddMode: TNodeAttachMode;
begin
  if FTreeView.Items.Count = MaxNodeCount then
  begin
    MessageBox(FTreeView.Handle, PChar(Format(Error_NodeOutOfRange,
      [MaxNodeCount])), '', MB_OK + MB_ICONERROR);
    Result := nil;
    Exit;
  end
  else
  begin
    { 这里 amAuto 当 amNext 处理 }
    if AddMode = amAuto then
      AddMode := amNext;
    { 转换 AddMode 为 NodeAddMode }
    case AddMode of
      amLast .. amPrev:
        NodeAddMode := TNodeAttachMode(AddMode);
      amNext:
        begin
          if RelativeNode = nil then
            NodeAddMode := naAdd
          else
          begin
            NextNode := RelativeNode.GetNextSibling;
            if NextNode <> nil then
            begin
              RelativeNode := NextNode;
              NodeAddMode := naInsert;
            end
            else
              NodeAddMode := naAdd;
          end
        end;
    else
      NodeAddMode := naAdd;
    end;
    Result := FTreeView.Items.AddNode(nil, RelativeNode, NodeName, nil,
      NodeAddMode);
  end;
end;
{ 克隆节点，供 MoveNode 调用 }
function TTreeViewDrager.CloneNode(FromNode, ToNode: TTreeNode;
  MoveMode: TAttachMode = amAuto): TTreeNode;
begin
  if FromNode = ToNode then
    MoveMode := amNext;
  { 这里 amAuto 根据上移下移来决定移动方式 }
  if MoveMode = amAuto then
  begin
    if ToNode = nil then
      MoveMode := amFirst
    else if FromNode.Parent = ToNode.Parent then
    begin
      { 同级节点，根据移动的方向决定是移到前面还是移到后面 }
      if FromNode.Index > ToNode.Index then
        MoveMode := amPrev
      else
        MoveMode := amNext;
    end
    else
      { 不同级节点，移到后面 }
      MoveMode := amNext;
  end;
  Result := GetNewNode(ToNode, FromNode.Text, MoveMode);
  // Result.Data := FromNode.Data;
end;
{ 复制子节点，供 MoveNode 调用 }
procedure TTreeViewDrager.CopyChildNodes(FromNode, ToNode: TTreeNode);
var
  I: Integer;
  NewNode: TTreeNode;
begin
  if (FromNode = nil) or (ToNode = nil) then
    Exit;
  for I := 0 to FromNode.Count - 1 do
  begin
    NewNode := GetNewNode(ToNode, FromNode[I].Text, amChildLast);
    // NewNode.Data := FromNode[I].Data;
    if NewNode = nil then
      Exit;
    if FromNode[I].Count > 0 then
      CopyChildNodes(FromNode[I], NewNode);
  end;
end;
{ ------------------------------------------------------------ }
{ 公开方法 }
{ ------------------------------------------------------------ }
{ 添加新节点 }
function TTreeViewDrager.AddNode(RelativeNode: TTreeNode = nil;
  NodeName: string = ''; AddMode: TAttachMode = amAuto): TTreeNode;
begin
  Result := GetNewNode(RelativeNode, NodeName, AddMode);
end;
{ 删除节点 }
function TTreeViewDrager.DeleteNode(RelativeNode: TTreeNode): TTreeNode;
begin
  if RelativeNode = nil then
  begin
    Result := nil;
    Exit;
  end;
  Result := RelativeNode.GetNextSibling;
  if Result = nil then
    Result := RelativeNode.GetPrevSibling;
  if Result = nil then
    Result := RelativeNode.Parent;
  RelativeNode.Delete;
end;
{ 移动节点 }
function TTreeViewDrager.MoveNode(FromNode, ToNode: TTreeNode;
  MoveMode: TAttachMode = amAuto; bCopy: Boolean = False): TTreeNode;
var
  NextNode: TTreeNode;
  NodeAddMode: TNodeAttachMode;
begin
  Result := FromNode;
  { 不能移动到自身的子节点中 }
  if (FromNode = ToNode) and (MoveMode in [amChildFirst, amChildLast]) then
    Exit;
  FTreeView.Items.BeginUpdate;
  try
    { 这里 amAuto 根据上移下移来决定移动方式 }
    if MoveMode = amAuto then
    begin
      if ToNode = nil then
        MoveMode := amFirst
      else if FromNode.Parent = ToNode.Parent then
      begin
        { 同级节点，根据移动的方向决定是移到前面还是移到后面 }
        if FromNode.Index > ToNode.Index then
          MoveMode := amPrev
        else
          MoveMode := amNext;
      end
      else
        { 不同级节点，移到后面 }
        MoveMode := amNext;
    end;
    if bCopy then
    begin
      Result := GetNewNode(ToNode, FromNode.Text, MoveMode);
      if Result <> nil then
        CopyChildNodes(FromNode, Result);
    end
    else
    begin
      case MoveMode of
        amLast .. amPrev:
          NodeAddMode := TNodeAttachMode(MoveMode);
        amNext:
          begin
            NextNode := ToNode.GetNextSibling;
            if NextNode <> nil then
            begin
              ToNode := NextNode;
              NodeAddMode := naInsert;
            end
            else
              NodeAddMode := naAdd;
          end;
      else
        NodeAddMode := naAdd;
      end;
      Result := FromNode;
      FromNode.MoveTo(ToNode, NodeAddMode);
    end;
  finally
    FTreeView.Items.EndUpdate;
  end;
end;
{ ------------------------------------------------------------ }
{ 实现拖拽 }
{ ------------------------------------------------------------ }
{ 准备拖拽 }
procedure TTreeViewDrager.MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOldOnMouseDown) then
    FOldOnMouseDown(Sender, Button, Shift, X, Y);
  if FDragMode = dmDisableDrag then
    Exit;
  { 判断鼠标是否点击在节点上 }
  if (htOnItem in FTreeView.GetHitTestInfoAt(X, Y)) then
  begin
    { 强行许右键选择节点，忽略 RightClickSelect 属性 }
    if (Button = mbRight) then
      FTreeView.GetNodeAt(X, Y).Selected := True;
    { 判断是否满足拖拽条件 }
    if (FDragMode = dmAutoDrag) or IsKeyDown(FHotKeyMoveNode) or
      IsKeyDown(FHotKeyCopyNode) or IsKeyDown(FHotKeyChildNode) then
    begin
      FDragButton := Button;
      { 左右键均可拖拽 }
      if (Button = mbLeft) or (Button = mbRight) then
        { Immediate = True 则拖拽操作会立刻开始
          Immediate = False 当达到 Threshold 设定的值时，才会产生拖拽操作 }
        FTreeView.BeginDrag(False); { 启用拖拽 }
    end;
  end;
end;
{ 取消拖拽：如果不取消拖拽，则鼠标右键单击后，会进入拖拽状态，再次单击才退出 }
procedure TTreeViewDrager.MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOldOnMouseUp) then
    FOldOnMouseUp(Sender, Button, Shift, X, Y);
  if FTreeView.Dragging then
    FTreeView.EndDrag(False);
end;
{ 接受拖拽 }
procedure TTreeViewDrager.DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := False;
  if Assigned(FOldOnDragOver) then
    FOldOnDragOver(Sender, Source, X, Y, State, Accept);
  if FDragMode = dmDisableDrag then
    Exit;
  FMoveSourceNode := FTreeView.Selected;
  FMoveTargetNode := FTreeView.GetNodeAt(X, Y);
  { 必须在同一个 TreeView 内部拖拽，目标不能为 nil }
  if (Source = FTreeView) and (FMoveTargetNode <> nil) then
  begin
    { 源节点不能为目标节点的父节点 }
    if not FMoveTargetNode.HasAsParent(FMoveSourceNode) then
      Accept := True;
  end;
end;
{ 完成拖拽 }
procedure TTreeViewDrager.DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  CurPos: TPoint;
  bCopy: Boolean;
  MoveMode: TAttachMode;
begin
  if Assigned(FOldOnDragDrop) then
    FOldOnDragDrop(Sender, Source, X, Y);
  if FDragMode = dmDisableDrag then
    Exit;
  if FDropMenu <> nil then
    if FDragButton = mbRight then
    begin
      CurPos.X := X;
      CurPos.Y := Y;
      CurPos := FTreeView.ClientToScreen(CurPos);
      FDropMenu.Popup(CurPos.X, CurPos.Y);
    end
    else
    begin
      if IsKeyDown(FHotKeyChildNode) then
        MoveMode := amChildLast
      else
        MoveMode := amAuto;
      bCopy := IsKeyDown(FHotKeyCopyNode);
      MoveNode(FMoveSourceNode, FMoveTargetNode, MoveMode, bCopy)
        .Selected := True;
    end;
end;
end.

{ *******************************************************
  使用举例：创建一个空白窗体程序，双击窗体，使用如下代码
******************************************************* }
procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
  tv1: TTreeView;
  tvd1: TTreeViewDrager;
begin
  { 创建 TreeView，也可以在窗体设计器中创建 }
  tv1 := TTreeView.Create(Self);
  tv1.Parent := Self;
  tv1.Align := alClient;
  for I := 1 to 10 do
    tv1.Items.Add(nil, IntToStr(I));
  { 创建 TreeViewDrager，也可以将 TreeViewDrager 安装为 delphi 组件 }
  { 然后在窗体设计器中创建 }
  tvd1 := TTreeViewDrager.Create(Self);
  tvd1.TreeView := tv1;
  // { 将 HotKeyCopyNode 设置为 hkNone 表示禁止通过拖拽方式复制节点 }
  // tvd1.HotKeyCopyNode := hkNone;
end;