程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> Delphi類和組件 - TreeView 智能拖拽

Delphi類和組件 - TreeView 智能拖拽

編輯：Delphi

屬性：
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;