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

Question

我想编写以下过程/函数:

procedure ShowSysPopup(aFile: string; x, y: integer);

它将构建并显示(在坐标 x 和 y 处)右键单击 shell 菜单，该菜单可以在 Windows 资源管理器中看到给定文件。我对“显示”部分不太感兴趣，但更感兴趣的是如何构建这样一个菜单。

Answer 1

我已经为您制定了一个快速解决方案。将这些单位添加到“使用”部分:

... 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, nil, IShellFolder,
  ShellParentFolder)); // Get the IShellFolder Interface  of the Parent Folder

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

  ShellParentFolder.GetUIObjectOf(HND, 1, FilePIDL, IID_IContextMenu, nil, 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, 0, 1, $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, 0, 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