Add new comment

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.

Articles Categories: