一、 引言:
    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:iloveyou9595@sina.com

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 = 你定义的record 的变量;

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

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

Delphi中根据分类数据生成树形结构的最优方法的更多相关文章

  1. EasyUI_tree根据数据库数据生成树形结构JSON格式

    @Entitypublic class PubComp { @Id private String aguid; // 菜单ID private String pguid; // 父菜单 private ...

  2. C#生成树形结构泛型类

    C#生成树形结构泛型类,使用方法: ToTree<ShowMessageUpdatesTableTreeViewModel>.ToDo(models) public class ToTre ...

  3. Java编程:将具有父子关系的数据库表数据转换为树形结构,支持无限层级

    在平时的开发工作中,经常遇到这样一个场景,在数据库中存储了具有父子关系的数据,需要将这些数据以树形结构的形式在界面上进行展示.本文的目的是提供了一个通用的编程模型,解决将具有父子关系的数据转换成树形结 ...

  4. java中实现无限层级的树形结构

    本文展示了两个实现方法的代码.两个代码的实现方法不同,代码2更为简单. 先看一下最后实现的结果: 最后结果-json 代码1: 实现过程: 1.传入一段json字符串 2.将字符串转换成对象存入节点列 ...

  5. delphi中单独编译pas生成dcu文件

    delphi中单独编译pas生成dcu文件 在网上下载了一个带源码的组件,结果碰到提示说缺少xxx.dcu.一看它的目录下确实没有,那能不能生成一个呢? 当然可以! 方法是使用delphi的安装目录\ ...

  6. DELPHI中枚举类型数据的介绍和使用方法

    在看delphi程序的时候看到aa=(a,b,c,d);这样的东西,还以为是数组,同事说是函数,呵呵,当然这两个都不屑一击,原来这样式子是在声明并付值一个枚举类型的数据.下边写下来DELPHI中枚举类 ...

  7. 有一个树形结构,实现一个方法getKeys(data,str),获取字符串str在data中的所有上级节点的名称

    有一个树形结构,实现一个方法getKeys(data,str);获取字符串str在data中的所有上级节点的名称,例如: getKeys(data,'str1') 返回 ‘key1' getKeys( ...

  8. 树形结构JSON的实现方法

    在Web应用程序开发领域,基于Ajax技术的JavaScript树形控件已经被广泛使用,它用来在Html页面上展现具有层次结构的数据项.目前市场上常见的JavaScript框架及组件库中均包含自己的树 ...

  9. java、js中实现无限层级的树形结构(类似递归)

    js中: var zNodes=[ {id:0,pId:-1,name:"Aaaa"}, {id:1,pId:0,name:"A"}, {id:11,pId:1 ...

随机推荐

  1. numpy的shape 和 gt的x、y坐标之间容易引起误会

    用numpy来看shape,比如np.shape(img_data),会得到这样的结果(600,790,3) 注意:600不是横坐标,而是表示多少列,790才是横坐标 用numpy测试就可以看出: & ...

  2. P1006 传纸条-洛谷luogu-dp动态规划

    题目描述 小渊和小轩是好朋友也是同班同学,他们在一起总有谈不完的话题.一次素质拓展活动中,班上同学安排做成一个mm行nn列的矩阵,而小渊和小轩被安排在矩阵对角线的两端,因此,他们就无法直接交谈了.幸运 ...

  3. Percona XtraDB Cluster集群

    官网参考地址: https://www.percona.com/doc/percona-xtradb-cluster/LATEST/configure.html 前期准备: 都用的root权限或使用s ...

  4. kubernetes session回话保持

    1.Nginx 版本 root@ingress-nginx-controller-4b75b:/# /usr/sbin/nginx -vnginx version: nginx/1.13.9 2.in ...

  5. virtualbox - 2台虚拟机之间通过ssh互访

    virtualbox 5.2.12 一台虚拟机是Debian 9,另一台是Ubuntu 18.04. 注意: 2台虚拟机系统里要安装ssh ! sudo apt install ssh 然后在virt ...

  6. sql 语言

    sql 语言 DDL DDL 全称 Data Definition Language,即数据定义语言. DATABASE 创建数据库 CREATE DATABASE 语句用于创建数据库. CREATE ...

  7. .net core 中使用httpclient,HttpClientFactory的问题

    Microsoft 在.Net Framework 4.5中引入了HttpClient,并且是在.NET服务器端代码中使用Web API的最常用方法.但它有一些严重的问题,如释放HttpClient对 ...

  8. webpack笔记

    打包 img src src 必须以 点(.) 开始,才能被打包. 如: ./img/logo.png ../img/logo.png 使用 process a.js window.Base_Url ...

  9. Linux服务器性能压力测试

    对于新采购的服务器,需要进行有必要的性能测试.这里选择UnixBench工具进行性能测试.记录如下: 1)安装使用下面的脚本使用了最新版UnixBench5.1.3来测试,注释了关于graphic的测 ...

  10. linux下配置squid 服务器,最简单使用方式

    https://blog.csdn.net/unixtech/article/details/53185297 squid 查看命中率 https://blog.csdn.net/cnbird2008 ...