cjsh
Delphi、Java学习笔记
枚举某个文件夹下的所有文件及了文件夹到菜单上

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

 

一、           创建菜单：

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

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

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

posted on 2004-09-09 13:56  cjsh  阅读(1523)  评论(1)  编辑  收藏  举报

Copyright © 2025 cjsh
Powered by .NET 9.0 on Kubernetes Powered By博客园