He hecho una solución rápida para usted. añadir estas unidades a la sección "Aplicaciones":
... ShlObj, ActiveX, ComObj
y aquí está su procedimiento, acabo de añadir nuevo parámetro "HND" para llevar la manija del TWinControl que va a utilizar para visualizar el menú de contexto.
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;
modificar/añadir la inicialización, sección de finalización como esto
initialization
OleInitialize(nil);
finalization
OleUninitialize;
y aquí cómo se puede utilizar este procedimiento:
procedure TForm2.Button1Click(Sender: TObject);
begin
ShowSysPopup(Edit1.Text,Edit1.Left,Edit1.Top, Handle);
end;
espero que esto va a funcionar para usted.
Saludos,
Editar: si desea mostrar el menú contextual para seleccionar más de un archivo this article in my blog
Esto parece un poco incompleto, los mensajes de IContextMenu2 no se manejan, es decir, no se llama a HandleMenuMsg en respuesta a los mensajes del menú. Como resultado, algunos submenús (como el 'Abrir con') no se completarán. [Aquí] (http://stackoverflow.com/a/5287265) es un ejemplo de lo que estoy hablando. –
Además, sin una clase que implemente la interfaz IShellCommandVerb, su parámetro booleano 'Handled' y la interfaz en sí no sirven para nada. Como puede ver en su código, está consultando * nil * si es compatible con la interfaz, por supuesto, nunca se le da la interfaz, simplemente elimine ese lote de código innecesario y la declaración de tipo innecesario. –
Me tomé la libertad de hacerlo yo mismo. Esta afirmación 'if Admite (nil, IShellCommandVerb, SCV) then' realmente se destacaba. Por favor, también corrija el código en su blog. Sin embargo, mi primer comentario sigue siendo válido. –