Utiliser le menu contextuel de l'explorateur de fichier

Version imprimable

20/05/2025, 16h57
der§en

Utiliser le menu contextuel de l'explorateur de fichier

Bonjour,

Dans un composant perso (pour la VCL), je voudrais y voir le menu contextuel de l'explorateur de fichier, et pas celui par défaut proposé par Delphi, auriez-vous une idée de comment le récupérer et l'exploiter ?

Merci d'avances de vos retours...

Moi, pour afficher le menu système sur un fichier, j'avais trouvé ça :

Code:

DisplayContextMenuForFile(Application.MainForm.Handle, MonFichier);

Code:

1
2
3
4
5
6
7
8
9
10
11
procedure DisplayContextMenuForFile(ApplicationMainFormHandle: THandle; szFileName: String);
var
   ShellFolder: IShellFolder;
   Pidl: pItemIDList;
begin
   _ApplicationMainFormHandle := ApplicationMainFormHandle;
 
   Pidl := SHGetIDListFromPath(szFileName, ShellFolder);
   if Assigned(Pidl) then
      ContextMenuForFile(ShellFolder, Pidl);
end;

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
function SlashDirName(szDir: String): String;
var
   s: String;
   bRootDir: Boolean;
begin
   if szDir <> '' then
   begin
      s := szDir;
      bRootDir := ((Length(s) = 3) and (S[2] = ':')) or (s = '\');
      if not bRootDir then
         if s[Length(s)] <> '\' then
            s := s + '\';
      Result := s;
   end;
end;
 
function SHGetIDListFromPath(Path: TFileName; var ShellFolder: IShellFolder): pItemIDList;
var 
   TempPath, NextDir: TFileName; 
   nSlashPos, nScanParam: Integer;
   Folder, subFolder: IShellFolder; 
   PIDL, PIDLbase: PItemIDList; 
   ParseStruct: TStrRet; 
   szParseName: String;
   EList: IEnumIDList; 
   DidGet: ULONG; 
begin
   SHGetDesktopFolder(Folder);
   SHGetSpecialFolderLocation(0, CSIDL_DRIVES, PIDLbase);
 
   OLECheck(Folder.BindToObject(PIDLbase, nil, IID_IShellFolder, Pointer(SubFolder)));
   TempPath := Path;
   NextDir := '';
 
   //.Enumerate the path one directory at a time.
   while Length(TempPath) > 0 do
   begin
      nSlashPos := Pos('\', TempPath);
      if nSlashPos > 0 then
      begin
         if Pos(':', TempPath) > 0 then
            NextDir := Copy(TempPath, 1, 3)
         else
            NextDir := SlashDirName(NextDir) + Copy(TempPath, 1, nSlashPos - 1);
         TempPath := Copy(TempPath, nSlashPos + 1, Length(TempPath));
      end
      else
      begin
         if NextDir = '' then
            NextDir:=TempPath
         else
            NextDir := SlashDirName(NextDir) + TempPath;
         TempPath := '';
      end;
 
      Pidl := PidlBase;
      nScanParam := SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN;
      if (NextDir = Path) and (not DirectoryExists(Path)) then
         nScanParam := nScanParam or SHCONTF_NONFOLDERS;
 
      if S_OK = SubFolder.EnumObjects(0, nScanParam, EList) then
         while S_OK = EList.Next(1, pidl, DidGet) do
         begin
            OLECheck(SubFolder.GetDisplayNameOf(PIDL, SHGDN_FORPARSING, ParseStruct));
            case ParseStruct.uType of
               STRRET_CSTR: szParseName := ParseStruct.cStr;
               STRRET_WSTR: szParseName := WideCharToString(ParseStruct.pOleStr);
               STRRET_OFFSET: szParsename := PChar(DWORD(Pidl) + ParseStruct.uOffset);
            end;
            if UpperCase(szParsename) = UpperCase(NextDir) then
               Break;
         end
         else
         begin
            Folder := nil;
            Result := nil;
            Exit;
         end;
 
      if DidGet = 0 then
      begin
         Folder := nil;
         Result := nil;
         Exit;
      end;
      PIDLBase := Pidl;
      Folder := subFolder;
 
      //.As best as we can, determine whether or not this is a file.
      //.If so then we cannot bind it to the ShellFolder (hence "folder".) 
      if not FileExists(NextDir) then
         OLECheck(Folder.BindToObject(Pidl, nil, IID_IShellFolder, Pointer(SubFolder)));
   end;
 
   ShellFolder := Folder;
   if ShellFolder = nil then
      Result := nil
   else
      Result := Pidl;
end;

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
procedure ContextMenuForFile(Folder: IShellFolder; Pidl: pItemIDList);
var
   aContextMenu: IContextMenu;
   aPrgOut: Pointer;
   aPopup: HMENU;
   nCmd: Integer;
   aCmdInfo: TCMInvokeCommandInfo;
   //    MenuInfo: TMenuItemInfo;
   //    t, ItemCount: integer;
   //    buf: array[0..80] of Char;
   Where: TPoint;
begin 
   GetCursorPos(Where);
   aPrgOut := nil; 
   OLECheck(Folder.GetUIObjectOf(_ApplicationMainFormHandle, 1, Pidl, IID_IContextMenu, aPrgOut, Pointer(aContextMenu)));
   aPopup := CreatePopUpMenu;
   if aPopup = 0 then
      Exit;
 
   try
      OLECheck(aContextMenu.QueryContextMenu(aPopup, 0, 1, $7FFF, CMF_NORMAL));
      nCmd := Integer(TrackPopupMenuEx(aPopup, TPM_LEFTALIGN or TPM_RETURNCMD or TPM_RIGHTBUTTON or TPM_HORIZONTAL or TPM_VERTICAL, Where.X, Where.Y, _ApplicationMainFormHandle, nil));
      if nCmd <> 0 then
      begin
         Fillchar(aCmdInfo, Sizeof(aCmdInfo), 0);
         with aCmdInfo do
         begin
            cbSize := SizeOf(TCMInvokeCommandInfo);
            hwnd := _ApplicationMainFormHandle;
            lpVerb := MakeIntResource(nCmd - 1);
            nShow := SW_SHOWNORMAL;
         end;
 
         try
            aContextMenu.InvokeCommand(aCmdInfo);
         except
            raise Exception.Create('Erreur :  le menu système de ce fichier ne peut pas être créé !');
         end;
      end;
   finally
      DestroyMenu(aPopup);
   end;
end;

Avec ça :

Code:

uses Windows, SysUtils, ShlObj, ComObj, Dialogs;

21/05/2025, 10h45
der§en

Merci de ton retours, je vais tester ton code !

:ccool:
21/05/2025, 12h57
der§en

J'ai pas compris comment tu l'associes au contextmenu ?
21/05/2025, 13h13
Lung

Si mes souvenirs sont bons, il suffit juste d'un appel à DisplayContextMenuForFile(Application.MainForm.Handle, MonFichier); pour faire apparaitre le menu système du fichier donné.
21/05/2025, 17h38
ShaiLeTroll

Evidemment, si tu veux le Menu du Shell dans le deux cas, il faut un fichier (ou dossier) puisqu'il le Menu Contextuel est relatif à l'élément :
DesignTime - Peut-être le fichier DPR si tu en trouves le nom (sinon le dossier Documents ou le CurrentDir)
RunTime - Peut-être l'Exe ou son Dossier Parent, à quoi veux-tu lié le Context Menu, un fichier déjà ouvert dans un éditeur (ton programme serait donc un éditeur de fichier dans ce cas, il comprend peut-être un TShellTreeView/TShellListView qui affiche déjà une liste de fichier, c'est là que tu as besoin du clic-droit)

Si c'est un composant et le menu en DesignTime faut lui faire un TComponentEditor (voire RegisterComponentEditor) et lui ajouter un Menu GetVerbCount/GetVerb
L'appel de DisplayContextMenuForFile sera dans ExecuteVerb

Si c'est en RunTime, tu gère le Menu dynamiquement, ajout du TMenuItem nécessaire* (Faut juste le PopupMenu attaché à la propriété Menu si c'est bien un TControl et non un TComponent)
* C'est quoi le but ? avoir un explorateur via clic-droit, tu ne veux quand même pas faire la liste des fichiers/dossiers comme TMenuItem ?

Tu peux ajouter utiliser OnContextPopup

Faudrait mieux expliquer le besoin
21/05/2025, 21h37
der§en

J’ai une treeview qui correspond à une arborescence sur le disque, donc quand je fait un clic droit sur un élément, je voudrais afficher le menu contextuel du gestionnaire de fichiers.
22/05/2025, 09h28
ShaiLeTroll

TPopupMenu OnPopup (celui du TreeView1.PopupMenu)
Un code genre TreeView1.GetNodeAt(ClientToScreen(Mouse.CursorPos.X, Mouse.CursorPos.Y)); pour avoir le noeud en cours

Tu peux mettre le shell Menu comme sous Menu peut-être

Sinon

OnMouseUp, Button = mbLeft : X Y -> ClientToScreen

Popup() d'un TPopupMenu, c'est à la place de ça que tu peux faire DisplayContextMenuForFile