1. مدونات
  2. مدونة Issam Ali
  3. pop-up the Windows context menu for a given files using Delphi

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;

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

initialization
  OleInitialize(nil);
finalization
  OleUninitialize;

download source code.

Articles Categories: 
Delphi

التعليقات

أضافه Dominic (لم يتم التحقق) في سبت, 11/10/2012 - 01:27

Thanks this is very useful! :)

أضافه Elbert (لم يتم التحقق) في خميس, 07/18/2013 - 09:08

Very clean example. Thank you very much.

أضافه Sebastiaan (لم يتم التحقق) في ثلاثاء, 07/23/2013 - 13:25

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.

أضافه Issam Ali في ثلاثاء, 07/23/2013 - 15:58

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.

أضافه Sebastiaan (لم يتم التحقق) في أربعاء, 07/24/2013 - 08:34

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;

أضافه Issam Ali في أربعاء, 07/24/2013 - 09:46
This is not assigning but a clever visual trick! good job :-)

أضافه Sebastiaan (لم يتم التحقق) في أربعاء, 07/24/2013 - 12:08

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.

أضافه Issam Ali في أربعاء, 07/24/2013 - 18:15

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.

أضافه G Bradley MacDonald (لم يتم التحقق) في سبت, 12/31/2016 - 00:35

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?

أضافه Issam Ali في سبت, 12/31/2016 - 11:59

I think this code needs a review. I'll try to find time to do this. thanks for bringing this to my attention.

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