枚举某个文件夹下的所有文件及了文件夹到菜单

当前位置：网学 > 编程文档 > DELPHI > 正文

作者：用户投稿来源：网络发布时间： 12/11/26

分　　类：其他
语　　种：简体中文
编辑器：Delphi7
平　　台：Win9x,Win2k/NT,WinXP
作品源代码： -
软件或演示： -
代码大小： -
软件大小： -

无图片

枚举某个文件夹下的所有文件及了文件夹到菜单上：

一、创建菜单：

怎样把某个文件夹下的所有文件及子文件夹添加到菜单上呢，这不是很简单吗，直接用递归不就可以了吗，这当然可以了。如果某个磁盘或者某个文件夹中的子文件夹很多的情况下，可想而知速度肯定非常的慢。我在这里介绍另外一种方法，就是当你的鼠标移动到文件夹菜单时才创建菜单项，而不是一次把它创建好。代码如下：

//枚举某个文件夹下的所有文件及了文件夹到菜单上

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

(责任编辑：admin)

点击进入论坛和大家一起交流设计,分享设计素材,结交设计朋友

上一篇资讯：简易文件分割器(纯PASCAL编写)_Delphi实例

下一篇资讯： MD5变换的dll代码_Delphi实例