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

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;

also like the in the old answer you need to initialize OLE like this:

initialization
  OleInitialize(nil);
finalization
  OleUninitialize;

download source code.

Comments

Great work

Thanks this is very useful! Smile

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.

procedure TForm2.cxTreeList1MouseDown(Sender: TObject; Button: TMouseButton;
  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

This is not assigning but a clever visual trick! good job Smile

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)
Into
ShellParentFolder.GetUIObjectOf(hnd, 1, ParentFolderPIDL, IID_IContextMenu, nil, CM);

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.

Syndicate content