إضافة تعليق جديد

pop-up the Windows context menu for a given files using Delphi

أضافه Issam Ali في جمعة, 11/09/2012 - 22:11

I've got new request regarding my answer to this question in stackoverflow about "how to show context menu for multi files". Here is the answer

Create new Delphi VCL application and add these units to the "Uses" section in the main form:

... ShlObj, ActiveX, ComObj, shellapi

Add these declarations 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;

PArrayOfPItemIDList = ^TArrayOfPItemIDList;
TArrayOfPItemIDList = array[0..0] of PItemIDList;

Modify the old ShowSysPopup method to support multi-files:

procedure ShowSysPopup(aFileList: TStrings; 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;

ItemIDListArray: PArrayOfPItemIDList;
idx: Integer;
Begin
if aFileList.Count = 0 then
Exit;

OleCheck(SHGetDesktopFolder(Root));//Get the Desktop IShellFolder interface

OleCheck(Root.ParseDisplayName(HND, nil,
PWideChar(WideString(ExtractFilePath(aFileList[0]))),
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

//allocate memory for the PItemIDList array
ItemIDListArray := AllocMem(SizeOf(PItemIDList) * aFileList.Count);
try
for idx := 0 to aFileList.Count - 1 do
Begin
// Get the relative PItemIDList of each file in the list
OleCheck(ShellParentFolder.ParseDisplayName(HND, nil,
PWideChar(WideString(ExtractFileName(aFileList[idx]))),
chEaten, FilePIDL, dwAttributes));
ItemIDListArray^[idx] := FilePIDL;
End;
// get the IContextMenu Interace for the file array
ShellParentFolder.GetUIObjectOf(hnd, aFileList.Count, ItemIDListArray^[0], IID_IContextMenu, nil, CM);
finally
FreeMem(ItemIDListArray);
end;

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;

Add TListBox and two buttons; The first button will fill the list with files name like this:

procedure TForm2.btnAddFilesToListClick(Sender: TObject);
var
idx: Integer;
begin
ListBox1.Clear;
with TOpenDialog.Create(self) do
try
Options := [ofReadOnly, ofAllowMultiSelect, ofEnableSizing];
if Execute then
for idx := 0 to Files.Count - 1 do
ListBox1.Items.Add(Files[idx])
finally
free;
end;
end;

The second button will show the context menu for the files in the ListBox like this:

procedure TForm2.btnShowMenuClick(Sender: TObject);
begin
ShowSysPopup(ListBox1.Items,btnShowMenu.Left,btnShowMenu.Top, Handle);
end;