添加链接
link之家
链接快照平台
  • 输入网页链接,自动生成快照
  • 标签化管理网页链接

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;