把你的问题再说得详细一点。我不知道你是要做一个类似于ACDSEE的图片管理工具,还是要做一个类似于WINDOWS的资源管理器那样的东东。OK??

解决方案 »

  1.   

    摘自<電腦編程技巧與維護>用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. 
      

  2.   


    Delphi6的Samples页面有这样的控件,也有源码,但是你得搜索一下Delphi的安装目录。
      

  3.   

    我学VB一个月时做了一个,很烂很烂,动态生成picturebox显示图片。delphi也一样。如果你要
    自己做解码,得累s.
      

  4.   

    To Judas:
      当然,我要的是ACDSee 的缩略图浏览
    To Musicwind:
      我装 Delphi 6.0 了,我要的不是那个,那个我早就作出来了
    To lance:
      我学VB时,也做过,和你一样,但我……
      

  5.   

    >>但我…… 
    ????????????
      

  6.   

    To lance
      我的电脑已经不装VB了……
      

  7.   

    我本来自已做了,但占用资源太大,后来就改用控件了。
    那个控件好象outlook什么的,等我回去查查。
      

  8.   

    装入image的控件数组是不是可以呢?!