procedure TMain.InvokeContextMenu(
const Owner: TWinControl;
const Path:
String;
const X, Y: Integer);
var
Item: Integer;
DeskFolder, Folder: IShellFolder;
Eaten, Attributes: ULONG;
pIdl, FolderpIdl: PItemIDList;
ContextMenu: IContextMenu;
ContextMenu2: IContextMenu2;
Menu: HMENU;
Pos: TPoint;
Cmd: DWORD;
CommandInfo: TCMInvokeCommandInfo;
begin
OleCheck(SHGetDesktopFolder(DeskFolder));
Attributes := 0;
OleCheck(DeskFolder.ParseDisplayName(
Handle,
nil,
PWideChar(WideString(ExtractFilePath(Path))),
Eaten, FolderpIdl, Attributes));
OleCheck(DeskFolder.BindToObject(FolderpIdl,
nil, IID_IShellFolder, Folder));
CoTaskMemFree(FolderpIdl);
Attributes := 0;
(*
An dieser Stelle kommt Windows mit meiner Anfrage für Wurzelpfade nicht mehr weiter.
ExtractFileName(Path) hab ich mit 'C', 'C:', 'C:\' ausgetauscht um halt das Wurzelverzeichniss zu erhalten.
Das mag der so gar nicht als Wert haben wollen.
Entweder kommt ein Fehlerfenster mit Inhalt: "Falscher Parameter" oder "Das System kann die angegebene Datei nicht finden.
*)
OleCheck(Folder.ParseDisplayName(INVALID_HANDLE_VALUE,
nil,
PWideChar(WideString(ExtractFileName(Path))), Eaten, PIDL, Attributes));
OleCheck(Folder.GetUIObjectOf(
Handle, 1, pIdl, IID_IContextMenu,
nil, ContextMenu));
CoTaskMemFree(pIdl);
Menu := CreatePopupMenu;
try
OleCheck(ContextMenu.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE));
ContextMenu.QueryInterface(IID_IContextMenu2, ContextMenu2);
try
Pos.X := X;
Pos.Y := Y;
Winapi.Windows.ClientToScreen(Owner.Handle, Pos);
Bool(Cmd) := TrackPopupMenu(Menu,
TPM_LEFTBUTTON
or TPM_RIGHTBUTTON
or TPM_RETURNCMD,
Pos.X, Pos.Y, 0,
Handle,
nil);
finally
ContextMenu2 :=
nil;
end;
if Bool(Cmd)
then begin
FillChar(CommandInfo, SizeOf(CommandInfo), 0);
CommandInfo.cbSize := SizeOf(CommandInfo);
CommandInfo.hwnd :=
Handle;
CommandInfo.lpVerb := PAnsiChar(MakeIntResource(Cmd - 1));
CommandInfo.nShow := SW_SHOWNORMAL;
OleCheck(ContextMenu.InvokeCommand(CommandInfo));
end;
finally
DestroyMenu(Menu);
end;
end;