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;

时间： 2024-10-13 09:47:59

virtualtree 的使用(Delphi)的相关文章

我任重而道远的Delphi之路

Delphi 要学的东西1. RTL,修改RTL,<Delphi源代码分析>2. COM编程3. Python+Delphi4. FreePascal,Lex/Yacc, GNU Pascal,PaxCompiler5. 网络编程6. WebService编程,三层7. GDI以及界面控件开发8. FireMonkey9. 多媒体编程10. WebBrowser11. BCB12. Lazarus 要学会使用的控件:DevExpressVirtualTreeOpenWireUniGui 要研究

Delphi常用系统函数总结

字符串处理函数 Unit System 函数原型 function Concat(s1 [, s2,..., sn]: string): string; 说明 与 S := S1 + S2 + S3 ...; 相同. 将字符串相加. 函数原型 function Copy(S: string; Index, Count: Integer): string;说明 S : 字符串. Indexd : 从第几位开始拷贝. Count : 总共要拷贝几位. 从母字符串拷贝至另一个字符串. 函数原型 pro

最新的Delphi版本号对照

The CompilerVersion constant identifies the internal version number of the Delphi compiler. It is defined in the System unit and may be referenced either in code just as any other constant: if CompilerVersion = 20 then sCompilerName := 'Delphi 2009';

Delphi XE10 dxLayoutControl 控件应用指南

http://www.cnblogs.com/Bonny.Wong/p/7440288.html DevExpress VCL套件是一套非常强大的界面控件,可惜关于Delphi开发方面的说明太少,有些控件使用起来一头雾水,不知从何下手.本节详细介绍在Delphi Xe10 Seattle中如何利用dxLayoutControl 控件来做界面布局. 1.  首先从工具箱面板中将dxLayoutControl放在Form上,设置2个关键属性如下: 属性 属性值 说明 Align alClient 一

delphi 移动开发博客地址收集

这个是各位博主学习整理的笔记,很值得大家学习. XE2011的博客: http://www.cnblogs.com/xe2011/ 万一的博客:http://www.cnblogs.com/del/ 武稀松的博客:http://www.raysoftware.cn/ delphiteacher的博客:http://blog.csdn.net/DelphiTeacher 我一路走来的博客:http://blog.csdn.net/tingsking18/article/details/477210

Delphi使用android的NDK是通过JNI接口，封装好了，不用自己写本地代码，直接调用

一.Android平台编程方式:      1.基于Android SDK进行开发的第三方应用都必须使用Java语言(Android的SDK基于Java实现)      2.自从ndk r5发布以后,已经允许完全用C/C++ 来开发应用或者游戏,而不再需要编写任何Java 的代码   Android程序运行在Dalvik虚拟机中,NDK允许用户使用类似C / C++之类的原生代码语言执行部分程序. 二.跨平台移动开发   Delphi使用android的NDK是通过JNI接口,封装好了,不用自己

TStringBuilder类 - Delphi

摘自万一老师的博客,略作整理. //TStringBuilder.Create 可以无参数 procedure TForm1.Button1Click(Sender: TObject); var sb: TStringBuilder; begin sb := TStringBuilder.Create; sb.Append('Embarcadero'); sb.Append(' CodeGear'); sb.Append(' Delphi'); sb.Append(' 2009'); ShowM

delphi 属性 参数 新注释

delphi 属性 参数 新注释,在写代码的时候,可以自动看到属性.参数的的备注说明,太方便了. Tmyclass=class /// <summary> /// 姓名 /// </summary> name:string; /// <summary> /// 性别 /// </summary> sex:string; end; var aclass: Tmyclass; begin aclass.name; aclass.sex; 鼠标放上去的时候提示 写

[转]delphi的procedure of object

delphi的procedure of object(一个特殊的指针类型) 理论:     //适用于实现不是某一特定过程或函数          type                TNotifyEvent = procedure(Sender: TObject) of object;       首先:procedure 也是类型,可以理解为过程类型,定义过程的参数结构,而具体的实现可以动态赋值  onclick那样例子:      声明:  onclick= procedure(Sen