文档章节

virtualtree 的使用(Delphi)

vga
 vga
发布于 2014/08/23 14:30
字数 1523
阅读 744
收藏 1

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;

本文转载自:http://bbs.csdn.net/topics/380178937

vga

vga

粉丝 23
博文 366
码字总数 26645
作品 0
佳木斯
私信 提问
HeidiSQL 8.2 已发布(支持64位)

HeidiSQL 是一款卓越的 mysql,sqlserver 图形化客户端 恺哥一直使用它来维护、操作mysql数据库,目前 8.2 版本已经发布,强烈推荐使用 v8.2 changes and new features: * 64 bit version a...

恺哥
2013/12/27
5.6K
38
集成开发环境--Delphi

Delphi,是美国Borland(宝兰)公司於1995年开发在Windows平台下的快速应用程式开发工具(Rapid Application Development,简称RAD),它的前身是在DOS下的产品Borland Turbo Pascal。(非开源...

匿名
2009/03/11
21K
1
Delphi的网友评论

Delphi,是美国Borland(宝兰)公司於1995年开发在Windows平台下的快速应用程式开发工具(Rapid Application Development,简称RAD),它的前身是在DOS下的产品Borland Turbo Pascal。(非开源...

红薯
2009/12/11
552
7
老牌集成开发环境 Delphi 发布免费社区版

Delphi® - 社区版 Delphi Community Edition与我们的自由开发人员,初创公司,学生和非营利组织免费共享,是一个全功能的IDE,用于从单个Delphi代码库(有限的商业使用许可证)构建iOS,And...

vga
2018/07/23
10K
93
Delphi惹谁了?

Delphi惹谁了? 最早的时候就有C++程序员做Win23的产品没有Delphi程序员快,不服气地说Delphi的不好,理由是Delphi只能拖拉控件,不能OOP。几年以前,当Java刚刚火起来的时候,Java程序员说D...

vga
2016/08/09
35
6

没有更多内容

加载失败,请刷新页面

加载更多

分布式架构 实现分布式锁的常见方式

一、我们为什么需要分布式锁? 在单机时代,虽然不需要分布式锁,但也面临过类似的问题,只不过在单机的情况下,如果有多个线程要同时访问某个共享资源的时候,我们可以采用线程间加锁的机制...

太猪-YJ
49分钟前
3
0
GitLab Docker 安装记录

安装环境 环境Centos7.4 64 1.拉取镜像文件 docker pull gitlab/gitlab-ce:latest 2.docker 安装 git.zddts.com 为访问域名或换成可以访问的IP docker run -d --hostname git.***.com -p ......

侠者圣
今天
0
0
部署kubernates dashboard

参考官方文档: https://github.com/kubernetes/dashboard 直接部署官方默认的dashboard: kubectl apply -f https://raw.githubusercontent.com/kubernetes/dashboard/v1.10.1/src/deploy/r......

猫海豚
今天
0
0
Docker中Redis的安装

一、下载镜像 docker pull redis 二、创建外挂目录及配置 mkdir /opt/docker/redismkdir /opt/docker/redis/confmkdir /opt/docker/redis/data 三、安装 docker run -d --name compose_r......

闊苡訆涐囍醣
今天
0
0
JNI内存泄露处理方法汇总

在c++中new的对象,如果不返回java,必须用release掉,否则内存泄露。包括NewStringUTF,NewObject。如果返回java不必release,java会自己回收。   jstring jstr = env->NewStringUTF((*p)....

shzwork
今天
4
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部