virtualtree 的使用(Delphi)

VirtualTreeview的强大，毋庸置疑，不过，你能给演示演示，也不错，就是刚下来，只有一个可执行程序，感觉像病毒。

最近比较忙，没有上网，现在把我研究的结果和大家通报下，方便新手学习，避免走弯路和浪费时间。

我用到的功能粗略的研究了下，以下是我测试的结果，可能和高手的结果不同，请不要鄙视。

首先说一下速度问题，只有一列数字分组或者不分组，都很快，但是，我用的是十几个字段，并且好几个字段是很多汉字的，一共有 5 万多条记录。如果用 OnIniNode 事件，不分组大约 5 秒左右加载完成，分组要 50 秒，我怀疑是我分组的问题。但我都是一次把所有数据都取出来，再分的组，不知道什么原因，因为时间原因，我没有仔细分析。用传统方法分组，大约 15 秒左右加载完成。我自己觉得可以忍受了，没有再改，下面是我用到的功能的代码，点击列头排序我没有用到，但是感觉有用，也贴上了，代码比较乱，有问题可以问我，等几天再结贴。有不正确的或者补充的功能，请帖出来。

1、数据加载，没有分组的，需要分组，可以自己加条件，这个主要是为了说明怎么用传统方法加载数据，为了明晰清楚，所以，只有一个字段。
（1）、设集合指针
PFAName_Rec = ^TFAName_re;

TFAName_re = record
FAName: string; //方案名称
（2）、开始加载
p_tree.Clear;
p_tree.NodeDataSize := SizeOf(TFAName_re);

p_tree.BeginUpdate;
RootNode := p_tree.AddChild(nil);
Data := p_tree.GetNodeData(RootNode);

while not Form_main.ADOQTest.Eof do
begin
if stop_thread then
exit;

Data.FAName := Form_main.ADOQTest.FieldByName('FAName').AsString;
Form_main.ADOQTest.Next;
end;
p_tree.EndUpdate;

2、显示事件，加载数据后，要显示必须在这个事件中加入显示的代码
procedure TForm_485.FA_TreeGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
Data : PFAName_Rec;
begin
Data := Sender.GetNodeData(Node);

case Column of
0:
begin
if Data^.FAName <> '' then
CellText := Data^.FAName;
end;
end;
end;

3、显示图标，虽然没什么大用，但是很美观
procedure TForm_485.Wait_Send_TreeGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer);
var
wait_send_rec : P_wait_send_Rec;
begin
if Column <> 2 then
exit;
wait_send_rec := Sender.GetNodeData(Node);

ImageIndex := wait_send_rec.is_send - 1;
end;

4、相邻行不同颜色
procedure TForm_485.Wait_Send_TreeBeforeItemErase(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
var ItemColor: TColor; var EraseAction: TItemEraseAction);
begin
if Odd(Node.Index) then
begin
// ItemColor := $FFEEEE;

ItemColor := $00F7F7F7;
EraseAction := eaColor;
end;
end;

5、拖放，没什么大用的功能，某些地方很有用，用按钮或菜单实现一样。
拖放需要加载 ActiveX 单元才行,否则会报错
（1）、 源控件事件
procedure TForm_485.All_item_TreeMouseDown(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
if All_item_Tree.FocusedNode = nil then
exit;
if All_item_Tree.FocusedNode.ChildCount > 0 then
exit;
All_item_Tree.BeginDrag(False);
end;
end;
（2）、目标事件1
procedure TForm_485.Wait_Send_TreeDragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
if (Source = All_item_Tree) or (Source = Wait_Send_Tree) or (Source =
Often_item_Tree) or (Source = FA_Tree) then
begin
Accept := true;
end;
end;
（3）、目标事件2
procedure TForm_485.Wait_Send_TreeDragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
Data : PFAName_Rec;
begin
cur_send_Meter_addr := trim(Edit8.Text);
cur_send_Meter_count := 1;

if (Source = All_item_Tree) then
begin
r(All_item_Tree);
end;

if (Source = Often_item_Tree) then
begin
r(Often_item_Tree);
end;

if (Source = Wait_Send_Tree) then
begin
move_item(Shift, Effect, Mode);
end;

if (Source = FA_Tree) then
begin
if FA_Tree.FocusedNode = nil then
exit;

Data := FA_Tree.GetNodeData(FA_Tree.FocusedNode);

get_FA_item(Data.FAName, Wait_Send_Tree);
end;
end;

6、编辑数据，这个我感觉很实用
（1）、事件1
procedure TForm_485.Wait_Send_TreeEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
if Column in [4..8] then
Allowed := true;
end;
（2）、事件2
procedure TForm_485.Wait_Send_TreeDragAllowed(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
Allowed := Odd(Node.Index);
end;
（3）、事件3
procedure TForm_485.Wait_Send_TreeNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; NewText: WideString);
var
wait_send_rec : P_wait_send_Rec;
str_meter_addr : string;
begin
wait_send_rec := Sender.GetNodeData(Node);

case Column of
4:
begin
if trim(wait_send_rec.str_czy) = trim(NewText) then
exit;
if length(trim(NewText)) <> 12 then
exit;

wait_send_rec.metter_addr := NewText;

if CheckBox3.Checked then
begin
//保存到数据库
post_item_mrz('BiaoDZ', wait_send_rec.GuiYBS, NewText);
end;

end;
end;
end;

7、显示提示，作用不大，有胜于无的功能
procedure TForm_485.Wait_Send_TreeGetHint(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: WideString);
begin
case Column of
0: HintText := '第一列提示';
2: HintText := '第三列提示';
3: HintText := '第四列提示';
end;
end;

8、点击列头排序，个人感觉非常有用的功能，但是我的程序中没有用到，所以，把我找到的代码贴上了，供大家参考。
procedure TfrmMain.vCustomerTreeHeaderClick(Sender: TVTHeader;
Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
if Button = mbLeft then
with Sender do
begin
if SortColumn <> Column then
SortColumn := Column;
if SortDirection = sdAscending then
SortDirection := sdDescending
else SortDirection := sdAscending;
vCustomerTree.SortTree(Column,SortDirection,true);
// BIG NOTE ! ... the "DoInit" variable MUST be set to true,
// otherwise you are ONLY sorting on nodes that have already
// been initialised - this can cause some interesting sorts !
end;
end;

9、查找数据，我的代码比较多，看着可能不清晰，这是别人写的例子，应该容易理解点，我在前面调用了2个方法，第一个是取消原来的选择，第二个是收起节点，主要为了找到节点后展开找到的节点。这个例子中没有对找到的节点进行处理的代码，例如，选择找到的节点，展开找到的节点等。自己加吧，不难的。
（1）、之前的方法
All_item_Tree.ClearSelection;
All_item_Tree.FullCollapse();

（2）、调用方式
PNode := FindChild(Controltree,Controltree.RootNode,EMPID);
（3）、递归的查找方法
function FindChild(Sender: TBaseVirtualTree; hParent: PVirtualNode; EMPID: integer): PVirtualNode;
var
llhChild: PVirtualNode;
Data: PEntry;
begin
Result := nil;

llhChild := hParent.FirstChild; //获取hParent的第一个子节点
while Assigned(llhChild) do begin
Data := Sender.GetNodeData(llhChild);
if (Data.Kind = nkEmployee) and (Data.ID = EMPID) then begin
Result := llhChild;
Exit;
end;

{对llhChild节点进行处理}
Result := FindChild(Sender, llhChild, EMPID);
if Result <> nil then Exit;
llhChild := llhChild.NextSibling;
end;

end;

10、MoveTo 使用方法，可以在不同的两个树中拖动，好像必须两棵树的结构一致，我只使用了在同一颗树中移动的功能。这个方法在拖动(DragDrop)事件中调用，按 Ctrl 是复制，其他是移动

procedure TForm.move_item(Shift: TShiftState; var Effect: Integer; var Mode:
TDropMode);
procedure DetermineEffect;
begin
if Shift <> [] then
begin

if (Shift = [ssAlt]) or (Shift = [ssCtrl, ssAlt]) then
Effect := DROPEFFECT_LINK
else if Shift = [ssCtrl] then
Effect := DROPEFFECT_COPY
else
Effect := DROPEFFECT_MOVE;
end;
end;

var
Attachmode : TVTNodeAttachMode;
Nodes : TNodeArray;
i : integer;
begin

case Mode of
dmAbove:
AttachMode := amInsertBefore;
// dmOnNode:
// AttachMode := amAddChildLast;
dmOnNode:
AttachMode := amInsertAfter;
dmBelow:
AttachMode := amInsertAfter;
else
AttachMode := amNowhere;
end;

DetermineEffect;
Nodes := Wait_Send_Tree.GetSortedSelection(True);
if Effect = DROPEFFECT_COPY then
begin
for I := 0 to High(Nodes) do
Wait_Send_Tree.CopyTo(Nodes[I], Wait_Send_Tree.DropTargetNode,
AttachMode, False);
end
else
for I := 0 to High(Nodes) do
Wait_Send_Tree.MoveTo(Nodes[I], Wait_Send_Tree.DropTargetNode,
AttachMode, False);

// Wait_Send_Tree.mo
end;