枚举某个文件夹下的所有文件及了文件夹到菜单上
一、 创建菜单：
怎样把某个文件夹下的所有文件及子文件夹添加到菜单上呢，这不是很简单吗，直接用递归不就可以了吗，这当然可以了。如果某个磁盘或者某个文件夹中的子文件夹很多的情况下，可想而知速度肯定非常的慢。我在这里介绍另外一种方法，就是当你的鼠标移动到文件夹菜单时才创建菜单项，而不是一次把它创建好。代码如下：
|
//枚举某个文件夹下的所有文件及了文件夹到菜单上 procedure TForm3.ShowPMFileIcon(Pm: TPopupMenu; aPath: String; aParent: TMenuItem=nil; aFirst: Boolean = True); var sr: TSearchRec; i: integer; aMenuItem: TMenuItem; mnuEmpty: TmenuItem; aTempPath: String; {* 得到文件图标索引} function MenuImageIndex: integer; begin Result := GetFileIconIndex(aTempPath+sr.name); end; {* 添加空菜单项} procedure EmptyMenuItem; begin if (sr.attr and faDirectory)= faDirectory then begin aMenuItem.Tag := 1; //标记该菜单为文件夹 mnuEmpty := TMenuItem.Create(Pm); mnuEmpty.Caption := '(空)'; mnuEmpty.Enabled := False; aMenuItem.Add(mnuEmpty); end; end; begin aTempPath := IncludeTrailingBackslash(aPath); i := FindFirst(aTempPath+'*.*', faAnyFile, sr); while i=0 do begin if sr.Name[1] <> '.' then //如果文件名不为"."或".." begin aMenuItem := TMenuItem.Create(aParent); aMenuItem.Hint := aTempPath; aMenuItem.ImageIndex := MenuImageIndex; aMenuItem.Caption := sr.Name; aMenuItem.OnClick := MenuItemClick; if aParent = nil then Pm.Items.Add(aMenuItem) else aParent.Add(aMenuItem); {* 添加空菜单项} EmptyMenuItem; end; {* 查找下一个文件} i := FindNext(sr); end; FindClose(sr); end; |
当鼠标移动到文件夹菜单上显示文件夹下的所有文件及文件夹，代码如下：
|
//如果当创建的菜单有子菜单时则移动鼠标则会触法下面的事件，反之则单击菜单项才触法下面的事件。 procedure TForm3.MenuItemClick(Sender: TObject); var aFileName: String; iIndex: integer; begin aFileName := Folder+GetMenuFileName(TMenuItem(Sender)); //如果是文件则单击打开 if TMenuItem(Sender).Tag = 0 then ShellExecute(0, 'Open', PChar(aFileName), nil, nil, SW_SHOWNORMAL) else begin if TMenuItem(Sender).Count = 1 then begin ShowPMFileIcon(PopupMenu1, aFileName, TMenuItem(Sender)); iIndex := TotalFileCount(aFileName); if iIndex <> -1 then TMenuItem(Sender).Delete(0); end; end; end; |
二、 加载图标：
怎样在菜单上显示文件所对应的图标呢？可通过使用ShellAPI.pas单元中的SHGetFileInfo()函数来获得其图标句柄HICON，说明如下：
function SHGetFileInfo(pszPath: PAnsiChar; dwFileAttributes: DWORD;var psfi: TSHFileInfo; cbFileInfo,uFlags: UINT): DWORDl;
pszPath 参数：指定的文件名。当uFlags的取值中不包含 SHGFI_PIDL时，可直接指定；否则pszPath要通过计算获得，不能直接指定；
dwFileAttributes参数：文件属性，仅当uFlags的取值中包含SHGFI_USEFILEATTRIBUTES时有效，一般不用此参数；
psfi 参数：返回获得的文件信息，是一个记录类型，有以下字段：
hIcon: HICON; //文件的图标句柄
iIcon: Integer; //图标的系统索引号
dwAttributes: DWORD; //文件的属性值
szDisplayName: array [0..MAX_PATH－1] of AnsiChar; //文件的显示名
szTypeName: array [0..79] of AnsiChar; //文件的类型名
cbFileInfo 参数：psfi的比特值；
uFlags 参数：指明需要返回的文件信息标识符，常用的有以下常数：
SHGFI_ICON; //获得图标
SHGFI_DISPLAYNAME; //获得显示名
SHGFI_TYPENAME; //获得类型名
SHGFI_ATTRIBUTES; //获得属性
SHGFI_LARGEICON; //获得大图标
SHGFI_SMALLICON; //获得小图标
SHGFI_PIDL; //pszPath是一个标识符
函数SHGetFileInfo()的返回值也随uFlags的取值变化而有所不同。通过调用SHGetFileInfo()可以由psfi参数得到文件的图标句柄，但要注意在uFlags参数中不使用SHGFI_PIDL时，SHGetFileInfo()不能获得”我的电脑”等虚似文件夹的信息。实现代码如下：
|
//把系统图标添加到ImageList中。 Procedure GetSysImageList(aImageList: TImageList); Const aFlags = SHGFI_SMALLICON OR SHGFI_SYSICONINDEX; Var SFileinfo: TShFileInfo; begin FillChar(SFileinfo, Sizeof(SFileinfo), #0); aImageList.ShareImages := True; //共享图标，一定设置为True。 aImageList.DrawingStyle := dsTransParent; //设置图标的背景色透明 aImageList.Handle := ShGetFileInfo('', 0, SFileInfo, SiZeof(SFileInfo), aFlags); end; //得到文件的图标索引 Function GetFileIconIndex(aExt: String): Integer; Const aFlags = SHGFI_SMALLICON OR SHGFI_SYSICONINDEX; Var SFileinfo: TShFileInfo; begin FillChar(SFileinfo, Sizeof(SFileinfo), #0); ShGetFileInfo(Pchar(aExt), 0, SFileinfo, SizeOf(SFileinfo), aFlags); Result := SFileinfo.iIcon; end; |
先用GetSysImageList函数实现ImageList跟系统图标共享，然后跟据文件名获得文件在系统中图标的索引值。
完整代码如下：
|
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ImgList, Menus, StdCtrls; type TForm1 = class(TForm) Label1: TLabel; Edit1: TEdit; Button1: TButton; PopupMenu1: TPopupMenu; ImageList1: TImageList; procedure Button1Click(Sender: TObject); procedure PopupMenu1Popup(Sender: TObject); procedure Edit1Change(Sender: TObject); private { Private declarations } procedure ShowPopupMenu(Sender: TObject; Pm: TPopupMenu); {* 弹出菜单} procedure MenuItemClick(Sender: TObject); {* //如果当创建的菜单有子菜单时则移动鼠标则会触法下面的事件，反之则单击菜单项才触法下面的事件。} procedure ShowPMFileIcon(Pm: TPopupMenu; aPath: String; aParent: TMenuItem=nil; aFirst: Boolean = True); {* 枚举某个文件夹下的所有文件及了文件夹到菜单上} public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} uses ShellApi; var Folder: String; First: Boolean = True; //得到文件的图标索引 function GetFileIconIndex(aExt: String): Integer; Const aFlags = SHGFI_SMALLICON OR SHGFI_SYSICONINDEX; Var SFileinfo: TShFileInfo; begin FillChar(SFileinfo, Sizeof(SFileinfo), #0); ShGetFileInfo(Pchar(aExt), 0, SFileinfo, SizeOf(SFileinfo), aFlags); Result := SFileinfo.iIcon; end; //把系统图标添加到ImageList中 procedure GetSysImageList(aImageList: TImageList); Const aFlags = SHGFI_SMALLICON OR SHGFI_SYSICONINDEX; Var SFileinfo: TShFileInfo; begin FillChar(SFileinfo, Sizeof(SFileinfo), #0); aImageList.ShareImages := True; aImageList.DrawingStyle := dsTransParent; aImageList.Handle := ShGetFileInfo('', 0, SFileInfo, SiZeof(SFileInfo), aFlags); end; //统计某个文件夹下的文件个数 function TotalFileCount(aPath: String): Integer; var sr: TSearchRec; i: integer; aTempPath: String; begin i:= -1; aTempPath := IncludeTrailingBackslash(aPath)+'*.*'; //修正文件夹名称 if FindFirst(aTempPath, faAnyFile, sr)=0 then begin while FindNext(sr) = 0 do if sr.name[1]<>'.' then inc(i); FindClose(sr); end; Result := i; end; //得到当前菜单项的完整文件名 function GetMenuFileName(aChild: TMenuItem): String; begin Result := aChild.Caption+'\'+Result; if Assigned(aChild.Parent) then Result := GetMenuFileName(aChild.Parent) else Result := Copy(Result, 2, Max_Path); end; //如果当创建的菜单有子菜单时则移动鼠标则会触法下面的事件，反之则单击菜单项才触法下面的事件。 procedure TForm1.MenuItemClick(Sender: TObject); var aFileName: String; iIndex: integer; begin aFileName := Folder+GetMenuFileName(TMenuItem(Sender)); //如果是文件则单击打开 if TMenuItem(Sender).Tag = 0 then ShellExecute(0, 'Open', PChar(aFileName), nil, nil, SW_SHOWNORMAL) else begin if TMenuItem(Sender).Count = 1 then begin ShowPMFileIcon(PopupMenu1, aFileName, TMenuItem(Sender)); iIndex := TotalFileCount(aFileName); if iIndex <> -1 then TMenuItem(Sender).Delete(0); end; end; end; //枚举某个文件夹下的所有文件及了文件夹到菜单上 procedure TForm1.ShowPMFileIcon(Pm: TPopupMenu; aPath: String; aParent: TMenuItem=nil; aFirst: Boolean = True); var sr: TSearchRec; i: integer; aMenuItem: TMenuItem; mnuEmpty: TmenuItem; aTempPath: String; {* 得到文件图标索引} function MenuImageIndex: integer; begin Result := GetFileIconIndex(aTempPath+sr.name); end; {* 添加空菜单项} procedure EmptyMenuItem; begin if (sr.attr and faDirectory)= faDirectory then begin aMenuItem.Tag := 1; //标记该菜单为文件夹 mnuEmpty := TMenuItem.Create(Pm); mnuEmpty.Caption := '(空)'; mnuEmpty.Enabled := False; aMenuItem.Add(mnuEmpty); end; end; begin aTempPath := IncludeTrailingBackslash(aPath); i := FindFirst(aTempPath+'*.*', faAnyFile, sr); while i=0 do begin if sr.Name[1] <> '.' then //如果文件名不为"."或".." begin aMenuItem := TMenuItem.Create(aParent); aMenuItem.Hint := aTempPath; aMenuItem.ImageIndex := MenuImageIndex; aMenuItem.Caption := sr.Name; aMenuItem.OnClick := MenuItemClick; if aParent = nil then Pm.Items.Add(aMenuItem) else aParent.Add(aMenuItem); {* 添加空菜单项} EmptyMenuItem; end; {* 查找下一个文件} i := FindNext(sr); end; FindClose(sr); end; //弹出菜单 procedure TForm1.ShowPopupMenu(Sender: TObject; Pm: TPopupMenu); var aPoint: TPoint; begin aPoint := TControl(Sender).ClientOrigin; aPoint.X := aPoint.X + TControl(Sender).Width; Pm.Popup(aPoint.X, aPoint.Y); end; procedure TForm1.Button1Click(Sender: TObject); begin Folder := IncludeTrailingBackslash(Edit1.Text); ShowPopupMenu(Sender, PopupMenu1); end; procedure TForm1.PopupMenu1Popup(Sender: TObject); begin if First then begin GetSysImageList(ImageList1); PopupMenu1.Items.Clear; ShowPMFileIcon(PopupMenu1, Folder); First := False; end; end; procedure TForm1.Edit1Change(Sender: TObject); begin First := True; end; end. |
版权所有 2004 cjsh 保留所有权利。欢迎转载，请注明出处：http://www.cnblogs.com/cjsh
