Hello, I've made a quick solution for you.
add these units to the "Uses" section:
... ShlObj, ActiveX, ComObj, shellapi
add this declration to the "Type" section:
IShellCommandVerb = interface
['{7D2A7245-2376-4D33-8008-A130935A2E8B}']
procedure ExecuteCommand(Verb: string; var Handled: boolean);
procedure CommandCompleted(Verb: string; Succeeded: boolean);
end;
and here is your procedure, I just add new parameter "HND" to carry the handle of the TWinControl that you will use to display the context Menu.
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;
ZVerb: array[0..255] of AnsiChar;
Verb: string;
Handled: boolean;
SCV: IShellCommandVerb;
HR: HResult;
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;
HR := CM.GetCommandString(ICmd, GCS_VERBA, nil, ZVerb, SizeOf(ZVerb));
Verb := StrPas(ZVerb);
Handled := False;
if Supports(nil, IShellCommandVerb, SCV) then
begin
HR := 0;
SCV.ExecuteCommand(Verb, Handled);
end;
if not Handled then
begin
FillChar(ICI, SizeOf(ICI), #0);
with ICI do
begin
cbSize := SizeOf(ICI);
hWND := 0;
lpVerb := MakeIntResourceA(ICmd);
nShow := SW_SHOWNORMAL;
end;
HR := CM.InvokeCommand(ICI);
end;
if Assigned(SCV) then
SCV.CommandCompleted(Verb, HR = S_OK);
end;
finally
DestroyMenu(Menu)
end;
End;
modify/add the initialization, finalization section like this
initialization
OleInitialize(nil);
finalization
OleUninitialize;
and here how you can use this procedure:
procedure TForm2.Button1Click(Sender: TObject);
begin
ShowSysPopup(Edit1.Text,Edit1.Left,Edit1.Top, Handle);
end;
I hope this will work for you.
Regards,