属性：
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 的 Rig
htclickSelect 为 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;
