Delphi中根据分类数据生成树形结构的最优方法

Posted 2020-09-02 癫狂编程

一、 引言：
    TreeView控件适合于表示具有多层次关系的数据。它以简洁的界面，表现形式清晰、形象，操作简单而深受用户喜爱。而且用它可以实现ListView、ListBox所无法实现的很多功能，因而受到广大程序员的青睐。
    树形结构在Windows环境中被普遍应用，但在数据库开发中面对层次多、结构复杂的数据，如何快速构造树形目录并实现导航呢？
    二、 实现关键技术：
    在Delphi提供的控件中包含了TreeView控件，但树的具体形成还需要用户编写代码。即它的列表项要在程序中动态添加，而这些列表数据通常由用户已录入在数据库表中，并作为数据库维护的一项内容。
    许多人用TreeView构造树形目录时，通常都使用多个嵌套循环，或递归算法，将代码“编织”成树。这样不但算法复杂，且运行效率低下，不是最佳选择。这里介绍的是基于编码结构的高效算法。该算法的主要优点是：程序短小精悍，运行效率高，能快速实现数据库的树形结构，可以适应任何复杂的层次数据，实现方法简单，且树的内容有变动时，无需更改程序行。
    算法的关键在于代码字典表中的代码字段的设计上一定要符合一定的代码设计要求，数据类型使用字符型。用户新增和修改代码时，必须有严格的约束，否则会导致程序出错。编码表的基本字段包括编码和编码名称，其编码规则是以数字、字母的位数来区分不同层次，同一层编码位数相同，层次按位数递增，程序通过判断编码位数来决定所在层数。
    本例程中编码结构是“222”，编码格式为 “XX XX XX”。例如：第一层为10~99两位，第二层为1001~1099四位，用户需要做的是先要设计树的结构和对应编码，并录入相应名称，然后程序在读取这些数据时形成树。本例程不需要用户自己进行编码，程序中自动实现各层编码，保证了代码格式的正确性。
    用TreeView导航表时，采用弹出式菜单，通过对话框操作数据表，同步更新树形控件和数据库。在所有操作中，树形控件不用重构，从而避免了重构时TreeView控件出现的闪动，也提高了程序的运行速度。
    本示例程序为了使大家看清楚数据表中记录是否同步更新，用TDBGrid控件显示当前数据库表中所有记录。下面给出范例程序和主要代码分析。
    三、 范例程序和主要代码分析：
    我们以建立一个城市名称的树形结构为例来说明如何快速生成树形并实现导航数据表。
    1． 先建立编码表：city_tree(bianma,cityname)。
    2． 新建一个项目，按默认保存。
    3． 新建一公共单元pubvar，在其中定义以下常量：
    Const
    cTreeCodeFormat = ‘222’;//编码格式为 XX XX XX
    cTreeMaxLevel = 3;//最大编码层次
    cTreeRootTxt = ‘城市’;//树根结点名称
    这样做为了提高程序的通用性，以后用于其他代码字典的维护时，只需要更改这些特征常量。
    4． 程序源代码：
    unit Unit1;
    interface
    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, DB, DBTables, ImgList, ComCtrls , PubVar, Grids, DBGrids, Menus , StrUtils, StdCtrls;

    type
    TForm1 = class(TForm)
    Tree: TTreeView;
    ImageList1: TImageList;
    Table1: TTable;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    PopupMenu1: TPopupMenu;
    AddMenu: TMenuItem;
    DeleteMenu: TMenuItem;
    RenameMenu: TMenuItem;
    Query1: TQuery;
    DataSource2: TDataSource;
    procedure AddMenuClick(Sender: TObject);//点击增加子项菜单
    procedure RenameMenuClick(Sender: TObject);//点击重命名菜单
    procedure DeleteMenuClick(Sender: TObject); //点击删除该项菜单
    procedure FormCreate(Sender: TObject);
    procedure TreeClick(Sender: TObject);
    private
    { Private declarations }
    public
    { Public declarations }
    procedure LoadTree(treeDB:TDBDataSet);//初始化树
    procedure UpdateTree(curNode:TTreenode; nodeTxt:string; state:string);//更新树
    function GetNodeLevel(sFormat,sCode:string):integer;//获得节点层数
    function GetCurrChildNodeMaxMa(curNode:TTreenode):string;
    //获得当前节点子节点的最大编码
    function GetCurrentNodeBianma(curNode:TTreenode):string;//获得当前节点的编码
    procedure UpdateTable(bianma:string; cityname:string ;state:string); //更新数据库
    end;

    var
    Form1: TForm1;
    CurrentTreeNode: TTreeNode;
    // AddChildeTreeNode: TTreeNode;
    // flag:boolean; //用于标识是否需要在重命名树结点时更新数据

    implementation
    uses AddChildUnit,RenameItemUnit;
    {$R *.dfm}

    procedure TForm1.LoadTree(treeDB:TDBDataSet);//初始化树
    var
    curID,nodeTxt:string;
    level:integer;
    mynode:array[0..3] of TTreenode;
    begin //初始化变量
    Screen.Cursor:=crHourGlass;
    tree.Enabled:=True;
    tree.Items.Clear;
    level:=0 ;
    //设置根节点
    mynode[level]:=tree.items.add(Tree.Topitem,cTreeRootTxt);
    mynode[level].ImageIndex:=1;
    //遍历数据表，利用编码字段记录排序规律，依次添加树节点
    with treeDB do
    begin
    try
    if not Active then open;
    first;
    while not Eof do
    begin
    curID:=trim(FieldByName(’bianma’).AsString);
    nodeTxt:=curID+’-’+trim(FieldByName(’cityname’).AsString);
    level:=GetNodeLevel(cTreeCodeFormat,curID);
    //这里返回代码的层次数
    if level〉0 then
    begin
    //增加下一节点时，用添加子节点的方法可轻松实现节点间的层次关系
    //注意：这里的父节点是用当前节点的上一级节点mynode[level-1]
    mynode[level]:= tree.items.addchild(mynode[level-1],nodeTxt);
    mynode[level].ImageIndex:=2;
    end;
    next;//下一条记录
    end;
    finally
    close;
    End;
    mynode[0].expand(False);
    Screen.Cursor:=crDefault;
    end;
    end;

    function TForm1.GetNodeLevel(sFormat,sCode:string):integer;//获得节点层数
    var i,level,iLen:integer;
    begin
    level:=-1 ;
    iLen:=0;
    if (sFormat〈〉’’) and (sCode〈〉’’) then
    for i:=1 to Length(sFormat) do //分析编码格式，找出当前代码层次
    begin
    iLen:=iLen+StrToInt(sFormat[i]);
    if Length(sCode)=iLen then
    begin level:=i; break; end;
    end;
    result:=level;
    end;

    //以下过程在新增、删除、修改记录时，同步更新树形结构
    procedure TForm1.UpdateTree(curNode:TTreenode; nodeTxt:string; state:string);
    Begin
    if UpperCase(state)=’ADD’ then
    begin
    curNode:=tree.items.addchild(curNode,nodeTxt);
    curNode.ImageIndex:=2;
    end;
    if UpperCase(state)=’DEL’ then
    begin
    curNode.DeleteChildren;
    curNode.delete;
    end;
    if UpperCase(state)=’EDI’ then curNode.Text:=nodeTxt;
    end;

    procedure TForm1.AddMenuClick(Sender: TObject);//点击增加子项菜单
    var AddChildText, AddTableText,maxbianma : string;
    begin
    AddChildForm.Label1.Caption:=’为“’+CurrentTreeNode.Text+’“增加子项 ’;
    if AddChildForm.ShowModal=mrOk then
    begin
    AddChildText:=AddChildForm.Edit1.Text;
    maxbianma:=GetCurrChildNodeMaxMa(CurrentTreeNode);
    if (CurrentTreeNode.Text=’城市’) and (maxbianma=’1000’) then
    maxbianma:=’11’//如果当前节点为根节点，且只有一个子节点，使增加节点编码为11
    else if CurrentTreeNode.Text=’城市’ then
    maxbianma:=IntToStr(StrToInt(LeftStr(maxbianma,2))+1)
    else
    maxbianma:=IntToStr(StrToInt(maxbianma)+1); //使子项编码自动增1
    if maxbianma〈〉’0’ then
    begin
    //增加树子层
    AddTableText:=maxbianma+’-’+AddChildText;
    UpdateTree(CurrentTreeNode,AddTableText,’add’); //更新树
    UpdateTable(maxbianma,AddChildText,’add’); //更新表
    ShowMessage(’添加成功!’);
    end
    else ShowMessage(’此层为最低子层，不能在该层增加子层’);
    AddChildForm.Edit1.Text:=’’;
    end;
    end;

    function TForm1.GetCurrChildNodeMaxMa(curNode:TTreenode):string;
    //获得当前节点子节点的最大编码
    var
    aSQL,maxbianma:string;
    li_pos:integer;
    begin
    li_pos:=pos(’-’,curNode.Text);
    if li_pos=7 then
    begin result:=’-1’; exit; end;
    if (li_pos=0) and (not(curNode.HasChildren)) then // 如果当前节点为根节点并且没有子节点
    begin
    result:=’9’; //使根节点第一个节点编码为10
    exit;
    end
    else begin
    aSQL:=’select bianma from city_tree where bianma like “’ + MidStr(curNode.Text, 1, li_pos-1) + ’%“’;
    Query1.UnPrepare;
    Query1.Close;
    Query1.SQL.Clear;
    Query1.SQL.Text:=aSQL;
    Query1.Prepare;
    Query1.ExecSQL;
    Query1.Active:=true;
    Query1.Last;
    maxbianma:=Query1.fieldbyname(’bianma’).AsString;
    if Query1.RecordCount=1 then//如果当前项没有子项
    maxbianma:=maxbianma+’00’;
    Query1.Active:=false;
    end;
    result:=maxbianma;
    end;

    procedure TForm1.RenameMenuClick(Sender: TObject);//点击重命名菜单
    var
    bianma:string;
    itemtext:string; //用于重命名时保存输入的Edit.text
    begin
    RenameItemForm.Label1.Caption:=’将“’+CurrentTreeNode.Text+’“命名为 ’;
    if RenameItemForm.ShowModal=mrOk then
    begin
    itemtext:=RenameItemForm.Edit1.Text;
    bianma:=GetCurrentNodeBianma(CurrentTreeNode);
    Table1.Locate(’bianma’,bianma,[]);
    UpdateTable(’’,itemtext,’edi’);
    itemtext:=bianma+’-’+itemtext;
    UpdateTree(CurrentTreeNode,itemtext,’edi’);
    ShowMessage(’重命名成功!’);
    end;
    end;
    //以下过程在新增、删除、修改记录时，同步更新数据库表
    procedure TForm1.UpdateTable(bianma:string; cityname:string ;state:string); //更新数据库
    begin
    if state=’add’ then
    begin
    Table1.Active:=True;
    Table1.Insert;
    Table1.SetFields([bianma,cityname]);
    Table1.Post;
    end;
    if state=’del’ then
    begin
    Table1.Active:=True;
    Table1.Locate(’bianma’,bianma,[]);
    Table1.Delete;
    end;
    if state=’edi’ then
    begin
    Table1.Edit;
    Table1.FieldByName(’cityname’).AsString:=cityname;
    Table1.Post;
    end;
    end;

    procedure TForm1.DeleteMenuClick(Sender: TObject); //点击删除该项菜单
    var
    bianma:string;
    begin
    CurrentTreeNode.expand(False);
    if CurrentTreeNode.Text=’城市’ then //如果当前节点为根节点
    begin
    ShowMessage(’不能删除根节点’);
    exit;//退出该过程
    end;
    if CurrentTreeNode.HasChildren then //如果当前节点具有子项
    begin
    ShowMessage(’请先删除其子项’);
    exit;//退出该过程
    end;
    if Application.MessageBox(PChar(’真的要删除“’+CurrentTreeNode.Text+’“这项吗?’),’警告’,MB_YESNO)=mrYES then
    begin
    bianma:=GetCurrentNodeBianma(CurrentTreeNode);
    UpdateTree(CurrentTreeNode,’’,’del’);
    UpdateTable(bianma,’’,’del’);
    ShowMessage(’删除成功!’);
    Table1.Refresh;//更新TBGrid控件中的显示
    Table1.Active:=true;
    CurrentTreeNode:=Form1.tree.selected;
    end;
    end;

    function TForm1.GetCurrentNodeBianma(curNode:TTreeNode):string;//获得当前节点的编码
    var
    li_pos:integer;
    bianma:string;
    begin
    li_pos:=pos(’-’,curNode.Text);
    bianma:=MidStr(curNode.Text,1,li_pos-1);
    result:=bianma;
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    begin
    LoadTree(Table1);
    Table1.Active:=true;
    end;

    procedure TForm1.TreeClick(Sender: TObject);
    begin
    CurrentTreeNode:=Form1.tree.selected; //获得当前节点
    end;

    end.

    unit PubVar;
    interface
    uses
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, DbTables, StdCtrls, ExtCtrls, Buttons, Dialogs,Registry,Db, ComCtrls;

    const
    cTreeCodeFormat=’222’; //编码格式:xx xx xx
    cTreeMaxLevel=3; //最大编码(树节点)层次
    cTreeRootTxt=’城市’; //树的根节点名称
    implementation
    end.
    5． 编译运行结果图：(附后)


    四、 小结：
    本程序与编码法快速生成树形结构，通过TreeView控件直接操作数据表，实现了对表的数据导航。如果你想通过点击TreeView控件某项直接显示该项的相关信息，可在该程序的基础上进行修改。

    原文载于《电脑编程技巧与维护》2003年第一期P27

    以上源码在http://www.comprg.com.cn/tit1_rjxz.htm 可以下载得到！需要的各位可以去下载！

    程序运行结果图(稍后传上)

    2004-6-18 8:20:32
    查看评语???

    2004-6-18 8:22:34 续篇
    用Delphi实现Windows文件夹管理树
    李鹏 薛志东

    摘要：本文利用Windows名空间所提供的IShellFolder接口，用Delphi实现了文件夹管理树的生成。
    关键字：文件夹 接口 Delphi

    一、概述
    Windows95/98视觉感观上区别Windows3.1的一个重要方面就是大量采用了树形视图控件，资源管理器左侧的文件夹管理树便是如此，它将本地和网络上的文件夹和文件等资源以层次树的方式罗列出来，为用户集中管理计算机提供了极大便利，同时在外貌上也焕然一新。Delphi为我们提供了大量Windows标准控件，但遗憾的是在目录浏览方面却只提供了一个Windows3.1样式的DirectoryListBox（Delphi5的测试版也是如此），因此，在Delphi中实现Windows文件夹管理树对开发更“地道”的Windows程序有着重大意义。
    二、实现原理
    Windows文件夹管理树的实现实质上是对Windows名空间（Namespace）的遍历。名空间中每个文件夹都提供了一个IShellFolder接口，遍历名空间的方法是：
    1）调用SHGetDesktopFolder函数获得桌面文件夹的IShellFolder接口，桌面文件夹是文件夹管理树的根节点。
    2）再调用所获得的IShellFolder接口的EnumObjects成员函数列举出子文件夹。
    3）调用IShellFolder的BindToObject成员函数获得子文件夹的IShellFolder接口。
    4）重复步骤2）、3）列举出某文件夹下的所有子文件夹，只至所获得的IShellFolder接口为nil为止。
    下面解释将要用到的几个主要函数，它们在ShlObj单元中定义：
    1）function SHGetDesktopFolder(var ppshf: IShellFolder): HResult;
    该函数通过ppshf获得桌面文件夹的IShellFolder接口。
    2）function IShellFolder.EnumObjects(hwndOwner: HWND; grfFlags: DWORD;
    out EnumIDList: IEnumIDList): HResult;
    该函数获得一个IEnumIDList接口，通过调用该接口的Next等函数可以列举出IShellFolder接口所对应的文件夹的内容，内容的类型由grfFlags来指定。我们需要列举出子文件夹来，因此grfFlags的值指定为SHCONTF_FOLDERS。HwndOwner是属主窗口的句柄。
    3）function IShellFolder.BindToObject(pidl: PItemIDList; pbcReserved: Pointer;
    const riid: TIID; out ppvOut: Pointer): HResult;
    该函数获得某个子文件夹的IShellFolder接口，该接口由ppvOut返回。pidl是一个指向元素标识符列表的指针，Windows95/98中用元素标识符和元素标识符列表来标识名空间中的对象，它们分别类似于文件名和路径。需要特别指出的是：pidl作为参数传递给Shell API函数时，必须是相对于桌面文件夹的绝对路径，而传递给IShellFolder接口的成员函数时，则应是相对于该接口所对应文件夹的相对路径。pbcReserved应指定为nil，riid则应指定为IID_IShellFolder。
    其它函数可以查阅Delphi提供的《Win32 Programmer’s Reference》。
    三、程序清单
    下面的源代码在Windows98中实现，并在Windows2000测试版中测试无误(程序运行结果如图1所示)，有兴趣的读者可以将其改写成Delphi组件，以备常用。
    unit BrowseTreeView;
    interface
    uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    ShlObj, ComCtrls;
    type
    PTreeViewItem = ^TTreeViewItem;
    TTreeViewItem = record
    ParentFolder: IShellFolder; // 接点对应的文件夹的父文件夹的IShellFolder接口
    Pidl, FullPidl: PItemIDList; // 接点对应的文件夹的相对和绝对项目标识符列表
    HasExpanded: Boolean; // 接点是否展开
    end;

    图1 程序运行结果
    TForm1 = class(TForm)
    TreeView1: TTreeView;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
    var AllowExpansion: Boolean);
    private
    FItemList: TList;
    procedure SetTreeViewImageList;
    procedure FillTreeView(Folder: IShellFolder; FullPIDL: PItemIDList; ParentNode: TTreeNode);
    end;
    var
    Form1: TForm1;
    implementation
    {$R *.DFM}
    uses
    ActiveX, ComObj, ShellAPI, CommCtrl;
    // 以下是几个对项目标识符进行操作的函数
    procedure DisposePIDL(ID: PItemIDList);
    var
    Malloc: IMalloc;
    begin
    if ID = nil then Exit;
    OLECheck(SHGetMalloc(Malloc));
    Malloc.Free(ID);
    end;
    function CopyItemID(ID: PItemIDList): PItemIDList;
    var
    Malloc: IMalloc;
    begin
    Result := nil;
    OLECheck(SHGetMalloc(Malloc));
    if Assigned(ID) then
    begin
    Result := Malloc.Alloc(ID^.mkid.cb + sizeof(ID^.mkid.cb));
    CopyMemory(Result, ID, ID^.mkid.cb + sizeof(ID^.mkid.cb));
    end;
    end;
    function NextPIDL(ID: PItemIDList): PItemIDList;
    begin
    Result := ID;
    Inc(PChar(Result), ID^.mkid.cb);
    end;
    function GetPIDLSize(ID: PItemIDList): Integer;
    begin
    Result := 0;
    if Assigned(ID) then
    begin
    Result := sizeof(ID^.mkid.cb);
    while ID^.mkid.cb 〈〉 0 do
    begin
    Inc(Result, ID^.mkid.cb);
    ID := NextPIDL(ID);
    end;
    end;
    end;
    function CreatePIDL(Size: Integer): PItemIDList;
    var
    Malloc: IMalloc;
    HR: HResult;
    begin
    Result := nil;
    HR := SHGetMalloc(Malloc);
    if Failed(HR) then Exit;
    try
    Result := Malloc.Alloc(Size);
    if Assigned(Result) then
    FillChar(Result^, Size, 0);
    finally
    end;
    end;
    function ConcatPIDLs(ID1, ID2: PItemIDList): PItemIDList;
    var
    cb1, cb2: Integer;
    begin
    if Assigned(ID1) then
    cb1 := GetPIDLSize(ID1) - sizeof(ID1^.mkid.cb)
    else
    cb1 := 0;
    cb2 := GetPIDLSize(ID2);
    Result := CreatePIDL(cb1 + cb2);
    if Assigned(Result) then
    begin
    if Assigned(ID1) then
    CopyMemory(Result, ID1, cb1);

    CopyMemory(PChar(Result) + cb1, ID2, cb2);
    end;
    end;
    // 将二进制表示的项目标识符列表转换成有可识的项目名
    function GetDisplayName(Folder: IShellFolder; PIDL: PItemIDList;
    ForParsing: Boolean): String;
    var
    StrRet: TStrRet;
    P: PChar;
    Flags: Integer;
    begin
    Result := ’’;
    if ForParsing then
    Flags := SHGDN_FORPARSING
    else
    Flags := SHGDN_NORMAL;
    Folder.GetDisplayNameOf(PIDL, Flags, StrRet);
    case StrRet.uType of
    STRRET_CSTR:
    SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
    STRRET_OFFSET:
    begin
    P := @PIDL.mkid.abID[StrRet.uOffset - sizeof(PIDL.mkid.cb)];
    SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);
    end;
    STRRET_WSTR:
    Result := StrRet.pOleStr;
    end;
    end;
    function GetIcon(PIDL: PItemIDList; Open: Boolean): Integer;
    const
    IconFlag = SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_SMALLICON;
    var
    FileInfo: TSHFileInfo;
    Flags: Integer;
    begin
    if Open then
    Flags := IconFlag or SHGFI_OPENICON
    else
    Flags := IconFlag;

    SHGetFileInfo(PChar(PIDL), 0, FileInfo, sizeof(TSHFileInfo), Flags);
    Result := FileInfo.iIcon;
    end;
    // 获得每个文件夹在系统中的图标
    procedure GetItemIcons(FullPIDL: PItemIDList; TreeNode: TTreeNode);
    begin
    with TreeNode do
    begin
    ImageIndex := GetIcon(FullPIDL, False);
    SelectedIndex := GetIcon(FullPIDL, True);
    end;
    end;
    // 获得系统的图标列表
    procedure TForm1.SetTreeViewImageList;
    var
    ImageList: THandle;
    FileInfo: TSHFileInfo;
    begin
    ImageList := SHGetFileInfo(PChar(’C:/’), 0, FileInfo,
    sizeof(TSHFileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
    if ImageList 〈〉 0 then
    TreeView_SetImageList(TreeView1.Handle, ImageList, 0);
    end;
    // 生成文件夹管理树
    procedure TForm1.FillTreeView(Folder: IShellFolder;
    FullPIDL: PItemIDList; ParentNode: TTreeNode);
    var
    TreeViewItem: PTreeViewItem;
    EnumIDList: IEnumIDList;
    PIDLs, FullItemPIDL: PItemIDList;
    NumID: LongWord;
    ChildNode: TTreeNode;
    Attr: Cardinal;
    begin
    try
    OLECheck(Folder.EnumObjects(Handle, SHCONTF_FOLDERS, EnumIDList));
    while EnumIDList.Next(1, PIDLs, NumID) = S_OK do
    begin
    FullItemPIDL := ConcatPIDLs(FullPIDL, PIDLs);
    TreeViewItem := New(PTreeViewItem);
    TreeViewItem.ParentFolder := Folder;
    TreeViewItem.Pidl := CopyItemID(PIDLs);
    TreeViewItem.FullPidl := FullItemPIDL;
    TreeViewItem.HasExpanded := False;
    FItemList.Add(TreeViewItem);
    ChildNode := TreeView1.Items.AddChildObject(ParentNode,
    GetDisplayName(Folder, PIDLs, False), TreeViewItem);
    GetItemIcons(FullItemPIDL, ChildNode);
    Attr := SFGAO_HASSUBFOLDER or SFGAO_FOLDER;
    Folder.GetAttributesOf(1, PIDLs, Attr);
    if Bool(Attr and (SFGAO_HASSUBFOLDER or SFGAO_FOLDER)) then
    if Bool(Attr and SFGAO_FOLDER) then
    if Bool(Attr and SFGAO_HASSUBFOLDER) then
    ChildNode.HasChildren := True;
    end;
    except
    // 你可在此处对异常进行处理
    end;
    end;
    procedure TForm1.FormDestroy(Sender: TObject);
    var
    I: Integer;
    begin
    try
    for I := 0 to FItemList.Count-1 do
    begin
    DisposePIDL(PTreeViewItem(FItemList[i]).PIDL);
    DisposePIDL(PTreeViewItem(FItemList[i]).FullPIDL);
    end;
    FItemList.Clear;
    FItemList.Free;
    except
    end;
    end;
    procedure TForm1.FormCreate(Sender: TObject);
    var
    Folder: IShellFolder;
    begin
    SetTreeViewImageList;
    OLECheck(SHGetDesktopFolder(Folder));
    FItemList := TList.Create;
    FillTreeView(Folder, nil, nil);
    end;
    procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
    var AllowExpansion: Boolean);
    var
    TVItem: PTreeViewItem;
    SHFolder: IShellFolder;
    begin
    TVItem := PTreeViewItem(Node.Data);
    if TVItem.HasExpanded then Exit;
    OLECheck(TVItem.ParentFolder.BindToObject(TVItem^.Pidl,
    nil, IID_IShellFolder, Pointer(SHFolder)));
    FillTreeView(SHFolder, TVItem^.FullPidl, Node);
    Node.AlphaSort;
    TVItem^.HasExpanded := True;
    end;
    end.

    2004-6-18 8:23:37 再续
    仅仅十几行代码实现对TreeView的遍历

    摘　要：对TreeView的遍历
    关键字：TreeView
    类　别：Delphi & IDE
    E-Mail：[email protected]

    function TForm1.AllOverTreeView(node:TTreenode):TTreenode;
    begin
    while node〈〉nil do
    begin
    if node.HasChildren then
    begin
    node:=node.getFirstChild;
    allovertreeview(node);
    node:=node.Parent;
    end;
    if node.getNextSibling〈〉nil then
    node:=node.getNextSibling
    else
    exit;
    end;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    var
    parentnode:TTreenode;
    begin
    parentnode:=Mytreeview.Items.GetFirstNode;
    AllOverTreeView(parentnode);
    end;
    ------------------------------------------------------

    遍历TreeView的方法有很多，我经过反复编程实现，上面是我用最少的代码实现TreeView的遍历。效果还不错。
    利用这个对所有节点的遍历，我们可以很方便的对所有节点进行各种操作。例如：统计每层节点的个数、对满足要求的节点进行操作、等等。

    投稿人：iloveyou9595　投稿日期：2003-3-26 23:51:00

    2004-6-18 8:24:32 再续...
    TreeView用法参考

    unit Main;

    interface

    uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    StdCtrls, ExtCtrls;

    type
    TForm1 = class(TForm)
    SearchBtn: TButton;
    DirectoryEdt: TMemo;
    PathEdt: TEdit;
    Label1: TLabel;
    Image1: TImage;
    procedure SearchBtnClick(Sender: TObject);
    procedure MakeTree;
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    var
    Form1: TForm1;

    implementation

    {$R *.DFM}

    procedure TForm1.MakeTree;
    var
    Sr: TSearchRec;
    Err: Integer;
    FilePath: string;
    begin
    Err := FindFirst(’*.*’,$37,Sr);//$37为除Volumn ID Files外的所有文件
    // 如果找到文件
    while (Err = 0) do
    begin
    if Sr.Name[1] 〈〉 ’.’ then
    begin
    //找到文件
    if (Sr.Attr and faDirectory) = 0 then
    begin

    end;
    //找到子目录
    if (Sr.Attr and faDirectory) = 16 then
    begin
    FilePath := ExpandFileName(Sr.Name);
    DirectoryEdt.Lines.Add(FilePath);
    ChDir(Sr.Name);
    MakeTree;
    ChDir(’..’);
    end;
    end;
    //结束递归
    Err := FindNext(Sr);
    end;
    end;

    procedure TForm1.SearchBtnClick(Sender: TObject);
    begin
    DirectoryEdt.Lines.Clear;
    ChDir(PathEdt.Text);
    MakeTree;
    end;

    end.
    这是个递归搜文件的例子，

    摘　要：将数据表连接到TreeView中
    关键字：数据表 TreeView
    类　别：API
    CoDelphi.com版权所有，未经允许，不得进行任何形式转载

    procedure AddDataToTree(TreeView:TTreeView;DataSet:TDataSet)
    var
    TreeNodes:TTreeNodes
    TreeNode:array[0..100] of TTreeNode;
    i:Integer;
    begin
    DataSet.Close;
    DataSet.Open;
    TreeNodes=TTreeView.Items;
    if DataSet.RecordCount〉0 then
    begin
    DataSet.First;
    while not DataSet.Eof do
    begin
    TreeNode[0]=TreeNodes.Add(Nil,DataSet.Fields[0].AsString);
    for i=1 to DataSet.Fields.Count-1 do
    TreeNode[i]=TreeNodes.AddChild(TreeNode[i-1],DataSet.Fields[i].AsString);
    DataSet.Next;
    end;
    end;
    end;


    unit Unit1;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, ImgList, StdCtrls, FileCtrl, ComCtrls;

    type
    TForm1 = class(TForm)
    DirTreeView: TTreeView;
    DriveComboBox1: TDriveComboBox;
    FileListBox1: TFileListBox;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure DirTreeViewExpanding(Sender: TObject; Node: TTreeNode;
    var AllowExpansion: Boolean);
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    var
    Form1: TForm1;

    implementation

    {$R *.dfm}

    procedure TForm1.FormCreate(Sender: TObject);
    var
    FirstNode,DirNode : TTreeNode;
    ItemCount,Index:integer;
    Itemstr:string;
    begin
    ItemCount:= DriveComboBox1.Items.Count; //所有驅動器的個數
    FirstNode := DirTreeView.Items.GetFirstNode;
    for index := 0 to ItemCount -1 do
    begin
    ItemStr:= DriveComboBox1.Items[index];
    ItemStr:= copy(ItemStr,1,pos(’:’,ItemStr)) ; //?得驅動器的名稱（比如C/D）
    DirNode := DirTreeView.Items.AddChild(FirstNode, ItemStr );
    DirNode.HasChildren := true;
    DirNode.ImageIndex := 0;
    DirNode.SelectedIndex := 1;
    end;
    end;

    procedure TForm1.DirTreeViewExpanding(Sender: TObject; Node: TTreeNode;
    var AllowExpansion: Boolean);
    var
    DirNode : TTreeNode;
    ItemCount,Index,level,icount:integer;
    Itemstr,strPath:string;
    begin
    if node.Count = 0 then
    begin
    icount:=0;
    level:=node.Level ;
    dirnode:=node;
    strPath:=node.Text+’/’ ;
    while level〈〉0 do
    begin
    strPath:=dirnode.Parent.Text+’/’+strpath;
    dirnode:=dirnode.parent;
    level :=level -1;
    end;
    FileListBox1.Clear ;
    FileListBox1.Directory := strpath;
    ItemCount:= FileListBox1.Items.Count;
    for index:=0 to ItemCount -1 do
    begin
    itemstr:=filelistbox1.items[index];
    itemstr:= copy(ItemStr,2,pos(’]’,ItemStr)-2) ;
    if (itemstr〈〉’.’) and (itemstr〈〉’..’) then
    begin
    DirNode := DirTreeView.Items.AddChild(Node,itemstr );
    DirNode.HasChildren :=true;
    DirNode.ImageIndex := 0;
    DirNode.SelectedIndex := 1;
    icount:=icount+1;
    end;
    if icount = 0 then
    Node.HasChildren := false;
    end;
    end;
    end;

    end.

    procedure TMain.CreateTree(QuerySource:TADOQuery;NodeParent:TTreeNode;treeview1:ttreeview);
    var
    pstr1, pstr2 : ^string;
    NodeTemp : TTreeNode;
    begin
    pstr1 := NodeParent.Data;
    with QuerySource do
    begin
    close;
    sql.Clear;
    sql.Text:=’SELECT key,xcode,xname FROM xzdm WHERE parent = ’ + ’’’’ + pstr1^ + ’’’’;
    open;
    if isempty then exit;
    NodeTemp := nil;
    while not eof do
    begin
    new(pstr2);
    pstr2^ := FieldByName(’key’).AsString;
    NodeTemp := TreeView1.Items.AddChildObject(NodeParent,
    trim(FieldByName(’xname’).AsString)+’(’+fieldbyname(’xcode’).AsString+’)’, pstr2);
    Next;
    end;
    end;
    while NodeTemp 〈〉 nil do
    begin
    CreateTree(QuerySource, NodeTemp,treeview1);
    NodeTemp := Nodetemp.getPrevSibling;
    end;
    end;

    procedure TMain.RootTree(treeview1:ttreeview);
    var
    NodeTemp : TTreeNode;
    pstr : ^string;
    Query:TADOQuery;
    begin
    Query:=TADOQuery.Create(self);
    query.Connection:=BgConnection;
    try
    Treeview1.Items.BeginUpdate;
    with query do
    begin
    SQL.Text :=’select top 1 * from xzdm ’;
    open;
    if isempty then exit;
    NodeTemp := nil;
    while not eof do
    begin
    new(pstr);
    pstr^ := FieldByName(’key’).AsString;
    NodeTemp :=treeview1.Items.AddObject(nil,
    trim(FieldByName(’xname’).AsString)+’(’+fieldbyname(’xcode’).AsString+’)’, pstr);
    Next;
    end;
    end;
    while NodeTemp 〈〉 nil do
    begin
    CreateTree(Query, NodeTemp,treeview1);
    NodeTemp:=NodeTemp.getPrevSibling;
    end;
    treeview1.Items.EndUpdate;
    finally
    Query.Free;
    end;
    end;

    var
    node1:Ttreenode;
    begin
    node1:=TreeView1.items.AddChild(node,’收件箱’);//建一个节点
    node1.ImageIndex:=86;//节点图象，要加imagelist控件
    node1.SelectedIndex:=92;
    node1.Data:=pointer(0);//重要，node1.data可以存入你有用ID
    end;

    其实看在线帮助是最好的了！另外就是要多用，Treeview我用的比较多，有什么问题可以问具体点！
    楼上的说的不错，要注意的是Node节点中的.data是一个指针，要小心使用！

    Delphi帮助文件里是这样写的：
    Set ToolTips to True to specify that items in the tree view control have tooltips (Help Hints

    当前的节点为： TreeView1.Selected;
    他的字节点:child,父节点：Parent
    其中的TreeNode的类型下可以保存一个指针类型的值；

    var
    CurItem: TTreeNode;
    begin
    CurItem := TreeView1.Items.GetFirstNode;
    while CurItem 〈〉 nildo
    begin
    ListBox1.Items.Add(CurItem.Text);
    CurItem := CurItem.GetNext;
    end;
    end

    用GetFirstNode,GetNext会比较快

    怎么知道我选中的是几级节点呀？
    procedure TForm1.Button1Click(Sender: TObject);
    begin
    showmessage(vartostr(TreeView1.selected.level));
    end;

    在节点展开的事件中如下：
    var sID:string;
    Node,NewNode;TTreeNode;
    begin
    Node := TreeView1.Selected;
    sID := PCHAR(Node.Data);
    Query1.Close;
    Query1.SQL.Clear;
    Query1.SQL.Add(’select * from mytbl where ParentID=’ + sID);
    Query1.Open;
    Node.Items.Clear; //清除以下所有节点
    While note Query1.Eof do
    begin
    NewNode:= TTreeView1.Items.AddChild(Node,Query1.FieldByName(’mc’).AsString);
    NewNode.ImageIndex := ***;
    Node.Data := PChar(Query1.FieldByName(’ID’).AsString); //注意保留索引值
    Query1.Next;
    end;


    另外在TreeView的节点清除时注意释放内存。

    在节点展开的事件中如下：
    var sID:string;
    NewNode;TTreeNode;
    begin
    sID := PCHAR(Node.Data);
    Query1.Close;
    Query1.SQL.Clear;
    Query1.SQL.Add(’select * from mytbl where ParentID=’ + sID);
    Query1.Open;
    Node.Items.Clear; //清除以下所有节点
    While note Query1.Eof do
    begin
    NewNode:= TTreeView1.Items.AddChild(Node,Query1.FieldByName(’mc’).AsString);
    NewNode.ImageIndex := ***;
    Node.Data := PChar(Query1.FieldByName(’ID’).AsString); //注意保留索引值
    Query1.Next;
    end;

    以上程序仅供叁考，没做测试。

    PNodeRec ＝ 你定义的ｒｅｃｏｒｄ 的变量;

    procedure loadRootNode
    var pID:integer; aNode: TTreeNode;
    Item : PNodeRec;
    begin
    Query1.close; Query1.SQL.clear;
    Query1.SQL.add(’select * from T where parentID=0’);
    Query1.open;

    where not Query1.eof do
    begin
    pID:=Query1.fieldByName(’id’).asInteger;
    //(1)加载一个根节点
    ... ...
    //aNode:=TV.Items.AddObject(nil, Item^.Name, Item);

    //(2)加载此根节点下的所有子节点
    loadChilds(pID,aNode);
    Query1.next;
    end;
    end;

    prodedure loadChilds(pID:integer;pNode:TTreeNode);
    var cpID:integer; aNode: TTreeNode;
    Item : PNodeRec;
    begin
    //(1)加载子节点
    Query2.close; Query2.SQL.clear;
    Query2.SQL.add(’select * from T where parentID=’+intToStr(pID));
    Query2.open;
    where not Query2.eof do
    begin
    //载入子节点
    ... ... //TV.Items.AddChildobject(pNode,Item^.Name,item);
    Query2.next;
    end;
    //(2)递归载入子节点的子节点
    for i:=0 to pNode.Count -1 do
    begin
    LoadChild(PNodeRec(pNode.Item[i].data)^.parentID,pNode.item[i]);
    end;
    end;

    大家是从算法上来说，我来从GUI方面来说。

    TreeList1.Items.BeginUpdate;
    ....执行添加代码
    TreeList1.Items.EndUpdate;

    哎呀，来晚了！
    Eastunfail(恶鱼杀手)对！浪费时间的部分主要实在绘制上，不用BeginUpdate和用BeginUpdate在数据量较大时，差着“十万八千里”呢！算法当然也很重要，但要是从最快的角度将，影响最大的还是BeginUpdate和EndUpdate(就是等数据全部加载完毕再进行绘制)。我有亲身体会...

    //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    //无限层数：数据严格按照（层(在TreeView上)，ParentID，ID，Text，图标序号）顺序排序************
    //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    procedure DataSetToTreeView(DataSet: TDataSet; var TreeView: TTreeView; var TreeList: TStringList); overload;
    var IsAvtive: Boolean;
    TempIndex: integer;
    TempNode: TTreeNode;
    begin
    DataSet.DisableControls;
    IsAvtive := DataSet.Active;
    if not IsAvtive then DataSet.Open;
    //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    TreeList.Clear;
    TreeList.Sorted := true;
    DataSet.First;
    while not DataSet.Eof do
    begin
    //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    if TreeList.Find(DataSet.Fields[1].AsString, TempIndex)
    then TempNode := TreeView.Items.AddChild(TreeList.Objects[TempIndex] as TTreeNode, DataSet.Fields[3].AsString)
    else TempNode := TreeView.Items.AddChild(TreeView.Items[0], DataSet.Fields[3].AsString);
    //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    TempNode.ImageIndex := DataSet.Fields[4].AsInteger;
    TempNode.SelectedIndex := DataSet.Fields[4].AsInteger;
    TempNode.Data := Pointer(TreeList.Strings[TreeList.AddObject(DataSet.Fields[2].AsString, TempNode)]);
    DataSet.Next;
    end;
    //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    DataSet.Active := IsAvtive;
    DataSet.EnableControls;
    end;

    速度奇快，利用了TStringList的AddObject

    如果你的数据量特大，树结构又不经常变化，可以考虑保存为文本文件，第二次加载此文件，速度更快。