Virtual TreeView のドラッグ & ドロップ

便利な Virtual Treeview(以下 VT)ですが、なんどかドラッグ & ドロップのプログラムは書いたことがあるけど、いまいち理解していなかったので、今後のためにも勉強がてらに整理してみました。

まず VT でドラッグ&ドロップさせるためにはプロパティで以下の設定が必要になります。これを設定しないとうんともすんとも言いません。
[delphi]
DragMode = dmAutomatic
DragType = dtVCL
[/delphi]

主要なイベントハンドラは OnDragDrop と OnDragOver で、
OnDragDrop は、ドロップされた後に呼び出され、ここでノードの移動等を処理をします(自答ではやってくれません)。

処理としてはたぶんこれでいいと思うんですが、
不明(dmNowhere) な場合は処理させない(amNoWhere)。
ドロップ先がノード(dmOnNode) の場合は子ツリーの最後へ(amAddChildLast)。
横棒の上ノード(dmBelow)のすぐ下へ(amInsertAfter)。
横棒の下ノード(dmAbove)のすぐ上へ(amInsertBefore)。
としています。

OnDragOver は、ドラッグ中にマウスが移動するごとに呼び出され、ここでドロップ可能かの正否を判断して返します。

サンプルでは、単純に同じコントロール、自分自身ではない、不明な場所ではない、の条件で判断しています。

メソッドしては、BuildTree と RestructItem があります。
BuildTree は、TItem から VT のツリーを構築します。

RestructItem は逆に VT のツリーから TItem を再構築します。

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ActiveX,
  VirtualTrees;


type
  TItem = class
    public
    fID: integer;
    fChild: TList;
    constructor Create(aID: INTEGER);
  end;

  TForm3 = class(TForm)
    VT: TVirtualStringTree;
    BuildBtn: TButton;
    RestructBtn: TButton;

    /// 

    ///  ドロップ処理。
    /// 
    procedure VTDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; Formats:
                         TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: INTEGER; Mode: TDropMode);

    /// 

    ///  ドロップ可能かの判断を行う。 以下の条件の場合にのみドロップ可能。
    ///  
    ///  
    ///  同じコントロール。
    ///  
    ///  
    ///  ドラッグ先がドロップ元でない。
    ///  
    ///  
    ///  ドラッグ先が不明でない。
    ///  
    ///  
    /// 
    procedure VTDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; Pt:
                         TPoint; Mode: TDropMode; var Effect: INTEGER; var Accept: BOOLEAN);

    /// 

    ///  ノードのテキストを返す。
    /// 
    procedure VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType:
                        TVSTTextType; var CellText: STRING);

    /// 

    ///  VT のツリーをクリアして、fRootItem のツリーを VT に構築させるコマンド。
    /// 
    procedure BuildBtnClick(Sender: TObject);

    /// 

    ///  VT のツリーから TItem のツリーを再構築して VT のツリーをクリアさせるコマンド。
    /// 
    procedure RestructBtnClick(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    protected
    fRootItem: TItem; // 何らかのツリーリスト

    /// 

    ///  ツリーの構築。
    /// 
    procedure BuildTree(aRootItem: TItem);
    procedure RestructItem(aRootItem: TItem);
  end;


var Form3: TForm3;


implementation


{$R *.dfm}


constructor TItem.Create(aID: INTEGER);
begin
  fID := aID;
  fChild := TList.Create;
end;

constructor TForm3.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  VT.NodeDataSize := SizeOf(TObject);
  BuildBtnClick(Self);
end;

procedure TForm3.VTDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; Formats:
                            TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: INTEGER; Mode: TDropMode);
var am: TVTNodeAttachMode;
begin
  inherited;
  case Mode of
    dmNowhere: am := amNoWhere; // ターゲットが不明。
    dmAbove: am := amInsertBefore; // ターゲットは横棒(下向き)の下のノード。
    dmOnNode: am := amAddChildLast; // ターゲットがノード。
    dmBelow: am := amInsertAfter; // ターゲットは横棒(上向き)の上のノード
  end;
  Sender.MoveTo(Sender.FocusedNode, Sender.DropTargetNode, am, false);
end;

procedure TForm3.VTDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState;
                            Pt: TPoint; Mode: TDropMode; var Effect: INTEGER; var Accept: BOOLEAN);
begin
  Accept := (Sender = Source) and (Sender.FocusedNode <> Sender.DropTargetNode) and (Mode <> dmNowhere);
end;

procedure TForm3.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType:
                           TVSTTextType; var CellText: STRING);
var item: TItem;
begin
  item := TItem(VT.GetNodeData(Node)^);
  CellText := IntToStr(item.fID);
end;

procedure TForm3.BuildTree(aRootItem: TItem);

  procedure SetItem(aItem: TItem; aNode: PVirtualNode);
  var a: INTEGER;
  n: PVirtualNode;
  begin
    for a := 0 to aItem.fChild.Count - 1 do begin
      n := VT.AddChild(aNode, aItem.fChild[a]);
      Include(n^.States, vsExpanded);
      SetItem(aItem.fChild[a], n);
    end;
  end;

begin
  SetItem(aRootItem, VT.RootNode);
end;

procedure TForm3.RestructItem(aRootItem: TItem);

  procedure GetItem(aItem: TItem; aNode: PVirtualNode);
  var item: TItem;
  begin
    aItem.fChild.Clear;
    aNode := aNode^.FirstChild;
    while aNode <> nil do begin
      item := TItem(VT.GetNodeData(aNode)^);
      aItem.fChild.Add(item);
      GetItem(item, aNode);
      aNode := aNode^.NextSibling;
    end;
  end;

begin
  GetItem(aRootItem, VT.RootNode);
end;

procedure TForm3.BuildBtnClick(Sender: TObject);
var i1: TItem;
    i2: TItem;
begin
  if fRootItem = nil then begin
    // サンプルツリーの構築
    fRootItem := TItem.Create(0);
    i1 := TItem.Create(1);
    fRootItem.fChild.Add(i1);
    i2 := TItem.Create(2);
    i1.fChild.Add(i2);
    i2.fChild.Add(TItem.Create(3));
    i1.fChild.Add(TItem.Create(4));
    i1.fChild.Add(TItem.Create(5));
    fRootItem.fChild.Add(TItem.Create(6));
  end;

  VT.Clear;
  BuildTree(fRootItem);
end;

procedure TForm3.RestructBtnClick(Sender: TObject);
begin
  RestructItem(fRootItem);
  VT.Clear;
end;


end.

サンプルプロジェクト: ダウンロード