在你的程序里为文件弹出系统右键菜单

moonight 发表于 2008-07-24 15:08:59

很久没贴过代码了，今天贴一篇，自己原创的。感觉工作了一年，的确代码水平比原来提高了不少。

代码: [复制到剪贴板]
unit ShellContextMenu;

interface

uses
  Windows, Controls;

procedure PopupShellContextMenu(Owner: TWinControl; FileOrFolder: WideString; MousePos: TPoint);

implementation

uses
  TntWideStrUtils, TntSysUtils, ShlObj, ComObj;

//一般的List类型的控件都会有像OnContextPopup的事件，弹出系统菜单就可以在这个时候做。
//Owner控件就是弹出菜单的父控件；
//FileOrFolder就是要弹出菜单的文件或者文件夹全路径；
//MousePos是相对于本控件的，就是Owner参数这个控件的坐标系的。
procedure PopupShellContextMenu(Owner: TWinControl; FileOrFolder: WideString; MousePos: TPoint);
var
  DesktopFldr, ParentFldr: IShellFolder;
  chEaten, attrib: Cardinal;
  ppidl: PItemIDList;
  CM: IContextMenu;
  Menu: HMENU;
  ICI: TCMInvokeCommandInfo;
  ICmd: integer;
  Command: LongBool;
  ZVerb: array[0..255] of WideChar;
  Verb: WideString;
  Folder: WideString;
  IsFile: Boolean;
begin
  //拿到“桌面”（并不是我们看到的Windows桌面，它这是整个Windows目录结构的树根。）
  OleCheck(SHGetDesktopFolder(DesktopFldr));

  IsFile := WideFileExists(FileOrFolder);

  //先取得FileOrFolder的父文件夹，如果是根目录，则取“我的电脑”
  attrib := 0;
  if IsFile then
    Folder := WideExtractFilePath(FileOrFolder)
  else begin
    Folder := WideExtractFilePath(WideExcludeTrailingPathDelimiter(FileOrFolder));
    if Folder = WideExtractFileDrive(FileOrFolder) then
    begin
      Folder := '::{20d04fe0-3aea-1069-a2d8-08002b30309d}';  // 我的电脑
    end;
  end;
  chEaten := Length(Folder);
  OleCheck(DesktopFldr.ParseDisplayName(Owner.Handle, nil, StringToOleStr(Folder), chEaten, ppidl, attrib));
  OleCheck(DesktopFldr.BindToObject(ppidl, nil, IID_IShellFolder, ParentFldr));

  //然后用父文件夹来取当前文件或文件夹
  attrib := 0;
  if IsFile then
    FileOrFolder := WideExtractFileName(FileOrFolder)
  else begin
    if Pos(Folder, FileOrFolder) > 0 then
      FileOrFolder := WideExtractFileName(WideExcludeTrailingPathDelimiter(FileOrFolder));
  end;
  chEaten := Length(FileOrFolder);
  OleCheck(ParentFldr.ParseDisplayName(Owner.Handle, nil, StringToOleStr(FileOrFolder), chEaten, ppidl, attrib));
  OleCheck(ParentFldr.GetUIObjectOf(Owner.Handle, 1, ppidl, IID_IContextMenu, nil, CM));

  //创建菜单句柄
  Menu := CreatePopupMenu;
  try
    OleCheck(CM.QueryContextMenu(Menu, 0, 1, FFF, CMF_NORMAL));
    Windows.ClientToScreen(Owner.Handle, MousePos);
    Command := TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or
        TPM_RETURNCMD, MousePos.X, MousePos.Y, 0, Owner.Handle, nil);

    if Command then
    begin
      //拿到用户点击的菜单项ID
      ICmd := LongInt(Command) - 1;
      //根据菜单项ID取菜单项的信息
      //GetCommandString这个函数很变态，pszName声明为pchar,但实际上要传入 PWideChar
      CM.GetCommandString(ICmd, GCS_VERBW, nil, PChar(@ZVerb[0]), SizeOf(ZVerb));
      Verb := WStrPas(ZVerb);
      //填充结构体
      ZeroMemory(@ICI, SizeOf(ICI));
      ICI.cbSize := SizeOf(ICI);
      ICI.hwnd := Owner.Handle;
      ICI.lpVerb := MakeIntResource(ICmd);
      ICI.nShow := SW_SHOWNORMAL;
      //执行菜单项的命令
      CM.InvokeCommand(ICI);
    end;
  finally
    //销毁菜单句柄
    DestroyMenu(Menu);
  end;
end;

end.

关键词(Tag): 右键 文件 系统 菜单

阅读234次 评论2条 个人主页 扔小纸条 文件夹: 单元文件(*.pas)
收藏: QQ书签 del.icio.us 订阅: Google 抓虾

最新评论


  • 云在笑
    2008-07-25 15:50:11 匿名 124.162.*.*

    抢个沙发坐坐。看不懂

  • 二姨
    2008-07-30 14:43:08 匿名 218.70.*.*

    啷个用呢？

发表评论

* 昵称

已经注册过? 请登录

新用户请先注册 以便能显示头像及追踪评论回复
Email
网址
* 评论
表情
 
 

分类小组论坛
杂谈, 娱乐、八卦, 文学、艺术, 体育, 旅游、同城, 象牙塔, 情感, 时尚、生活, 星座, 科技

请注意遵守中华人民共和国法律法规, 如威胁到本站生存, 将依法向有关部门报告, 同时本站的相关记录可能成为对您不利的证据.

相关法律法规
全国人大常委会关于维护互联网安全的决定
中华人民共和国计算机信息系统安全保护条例
中华人民共和国计算机信息网络国际联网管理暂行规定
计算机信息网络国际联网安全保护管理办法
计算机信息系统国际联网保密管理规定