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;
['{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;
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;
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;
begin
ShowSysPopup(ListBox1.Items,btnShowMenu.Left,btnShowMenu.Top, Handle);
end;
also like the in the old answer you need to initialize OLE like this:
initialization
OleInitialize(nil);
finalization
OleUninitialize;
OleInitialize(nil);
finalization
OleUninitialize;
Articles Categories:
Comments
Great work
Thanks this is very useful! :)
Wonderful
Very clean example. Thank you very much.
Nice Example
Nice Example just what i'm looking for.
Is it posible to assign the SysMenu to a TMenuItem?
eg. Select a couple of files in the listbox and Right-click to popup a TPopupMenu with the SysMenu in it.
Re:Nice Example
I don't think it's possible to assign the SysMenu to a TMenuItem, instead you can add your custom menu items (commands) into SysMenu.
Found solution that meets my requirement
Using the OnMouseDown Event.
Shift: TShiftState; X, Y: Integer);
var
lStringList: TStringlist;
lCounter: Integer;
lPoint : TPoint;
begin
if Button = mbRight then
begin
if cxTreeList1.GetNodeAt(X, Y) nil then
begin
lStringList := TStringlist.Create;
for lCounter := 0 to cxTreelist1.Nodes.Count - 1 do
begin
if cxTreelist1.Items[lCounter].Selected then
begin
lStringList.Add(cxTreelist1.Items[lCounter].Values[0]);
end;
end;
ShowSysPopup(lStringList, X, Y, Handle);
lStringList.Free;
end
else
begin
Windows.ClientToScreen(cxTreelist1.Handle, lPoint);
PopupMenu1.Popup(lPoint.X + X, lPoint.Y + Y); //If no 'files' selected popup de default menu
end;
end;
end;
Re:Found solution that meets my requirement
Use PopupMenu for Parent Directory
If the Treelist is empty I would like to popup the Menu for the ParentDirectory.
Changed
ShellParentFolder.GetUIObjectOf(hnd, aFileList.Count, ItemIDListArray^[0], IID_IContextMenu, nil, CM)
ShellParentFolder.GetUIObjectOf(hnd, 1, ParentFolderPIDL, IID_IContextMenu, nil, CM);
Into
But somehow the CM stays nil.
Re:Use PopupMenu for Parent Directory
CM is nil because: GetUIObjectOf should be called from the parent directory IShellFolder interface (in your situation from the parent of the parent directory interface) but you are calling it from the same directory.
I think the easiest solution in this case is to call ShowSysPopup with the parent directory in the lStringList: if Treelist is not empty add files to lStringList and call ShowSysPopup but if Treelist is empty add the parent directory to the lStringList and call ShowSysPopup.
Issue with using this with 'c:\'
Hello Issam - a very nice piece of code.
I was using it - and testing it - and I came across an interesting problem. If you use the code to try to generate the popup menu for 'c:\' (or any root directory - d:\, e:\, etc.) - it will crash on the line
OleCheck(ShellParentFolder.ParseDisplayName(HND, nil,
PWideChar(WideString(ExtractFileName(aFileList[idx]))),
chEaten, FilePIDL, dwAttributes));
the error is (raised exception exception class EOleSysError with message 'The parameter is incorrect')
Have you encountered this?
Do you have a workaround?
RE: Issue with using this with 'c:\'
I think this code needs a review. I'll try to find time to do this. thanks for bringing this to my attention.
Add new comment