加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 (https://www.lidatong.com.cn/)- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置: 首页 > 大数据 > 正文

如何使用Delphi弹出给定文件的Windows上下文菜单?

发布时间:2020-12-15 04:15:59 所属栏目:大数据 来源:网络整理
导读:我想写下面的过程/函数: procedure ShowSysPopup(aFile: string; x,y: integer); 这将构建并显示(在坐标x和y处)右键单击的shell菜单,在Windows资源管理器中可以看到给定文件.我对’显示’部分不是那么感兴趣,而是更多关于如何构建这样的菜单. 解决方法 我为
我想写下面的过程/函数:
procedure ShowSysPopup(aFile: string; x,y: integer);

这将构建并显示(在坐标x和y处)右键单击的shell菜单,在Windows资源管理器中可以看到给定文件.我对’显示’部分不是那么感兴趣,而是更多关于如何构建这样的菜单.

解决方法

我为你做了一个快速的解决方案.
将这些单位添加到“使用”部分:
... ShlObj,ActiveX,ComObj

这是你的程序,我只需添加新参数“HND”来携带TWinControl的句柄,你将用它来显示上下文菜单.

procedure ShowSysPopup(aFile: string; x,y: integer; HND: HWND);
var
  Root: IShellFolder;
  ShellParentFolder: IShellFolder;
  chEaten,dwAttributes: ULONG;
  FilePIDL,ParentFolderPIDL: PItemIDList;
  CM: IContextMenu;
  Menu: HMenu;
  Command: LongBool;
  ICM2: IContextMenu2;

  ICI: TCMInvokeCommandInfo;
  ICmd: integer;
  P: TPoint;
Begin
  OleCheck(SHGetDesktopFolder(Root));//Get the Desktop IShellFolder interface

  OleCheck(Root.ParseDisplayName(HND,nil,PWideChar(WideString(ExtractFilePath(aFile))),chEaten,ParentFolderPIDL,dwAttributes)); // Get the PItemIDList of the parent folder

  OleCheck(Root.BindToObject(ParentFolderPIDL,IShellFolder,ShellParentFolder)); // Get the IShellFolder Interface  of the Parent Folder

  OleCheck(ShellParentFolder.ParseDisplayName(HND,PWideChar(WideString(ExtractFileName(aFile))),FilePIDL,dwAttributes)); // Get the relative  PItemIDList of the File

  ShellParentFolder.GetUIObjectOf(HND,1,IID_IContextMenu,CM); // get the IContextMenu Interace for the file

  if CM = nil then Exit;
  P.X := X;
  P.Y := Y;

  Windows.ClientToScreen(HND,P);

  Menu := CreatePopupMenu;

  try
    CM.QueryContextMenu(Menu,$7FFF,CMF_EXPLORE or CMF_CANRENAME);
    CM.QueryInterface(IID_IContextMenu2,ICM2); //To handle submenus.
    try
      Command := TrackPopupMenu(Menu,TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or
        TPM_RETURNCMD,p.X,p.Y,HND,nil);
    finally
      ICM2 := nil;
    end;

    if Command then
    begin
      ICmd := LongInt(Command) - 1;
      FillChar(ICI,SizeOf(ICI),#0);
      with ICI do
      begin
        cbSize := SizeOf(ICI);
        hWND := 0;
        lpVerb := MakeIntResourceA(ICmd);
        nShow := SW_SHOWNORMAL;
      end;
      CM.InvokeCommand(ICI);
    end;
  finally
     DestroyMenu(Menu)
  end;
End;

像这样修改/添加初始化,终结部分

initialization
  OleInitialize(nil);
finalization
  OleUninitialize;

在这里你可以使用这个程序:

procedure TForm2.Button1Click(Sender: TObject);
begin
  ShowSysPopup(Edit1.Text,Edit1.Left,Edit1.Top,Handle);
end;

我希望这对你有用.

问候,

编辑:
如果要显示多个文件的上下文菜单,请检查this article in my blog

(编辑:李大同)

【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!

    推荐文章
      热点阅读