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


    一、 引言:
        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

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

    好的代码像粥一样,都是用时间熬出来的
  • 相关阅读:
    RadGrid Expand/Collapse on Row click
    AutoComplete Textbox with Additional Parameters From Database
    Combobox.Items中添加项Items
    JavaScript 处理字符串(操作字符串)
    用nettiers + svn + resharper + rad + ccNet开发前的准备工作
    Document.location.href和.replace的区别
    .net remoting的事务传播以及wcf分布式事务
    IDA反汇编/反编译静态分析iOS模拟器程序(三)函数表示与搜索函数
    [置顶] 一道有趣的逻辑题
    mini2440uboot移植基本操作指令
  • 原文地址:https://www.cnblogs.com/jijm123/p/13364042.html
Copyright © 2020-2023  润新知