Краткий ответ
Попробуйте Компоненты ShellBrowser от JAM Software. У них есть компонент, который позволяет вам показывать контекстное меню Проводника с вашими собственными командами, смешанными с TPopupMenu.
Длинный ответ
Возможно получить меню Проводника, запросить все его свойства и разместить их в своем собственном меню, но вам действительно должно быть удобно читать / писать низкоуровневый код Win32, и знание C поможет вам. Вам также нужно остерегаться некоторых ошибок (описанных ниже). Я настоятельно рекомендую прочитать серию Рэймонда Чена «Как разместить серию IContextMenu » для ознакомления с множеством технических деталей.
Подход проще состоит в том, чтобы запросить интерфейс IContextMenu, затем HMENU, затем использовать TrackPopupMenu, чтобы позволить Windows показать меню, а затем вызвать InvokeCommand в конце.
Часть приведенного ниже кода не проверена или изменена по сравнению с тем, что мы используем, поэтому действуйте на свой страх и риск.
Вот как вы получаете IContextMenu для группы файлов в базовой папке:
function GetExplorerMenu(AHandle: HWND; const APath: string;
AFilenames: TStrings): IContextMenu;
var
Desktop, Parent: IShellFolder;
FolderPidl: PItemIDList;
FilePidls: array of PItemIDList;
PathW: WideString;
i: Integer;
begin
// Retrieve the Desktop's IShellFolder interface
OleCheck(SHGetDesktopFolder(Desktop));
// Retrieve the parent folder's PItemIDList and then it's IShellFolder interface
PathW := WideString(IncludeTrailingPathDelimiter(APath));
OleCheck(Desktop.ParseDisplayName(AHandle, nil, PWideChar(PathW),
Cardinal(nil^), FolderPidl, Cardinal(nil^)));
try
OleCheck(Desktop.BindToObject(FolderPidl, nil, IID_IShellFolder, Parent));
finally
SHFree(FolderPidl);
end;
// Retrieve PIDLs for each file, relative the the parent folder
SetLength(FilePidls, AFilenames.Count);
try
FillChar(FilePidls[0], SizeOf(PItemIDList) * AFilenames.Count, 0);
for i := 0 to AFilenames.Count-1 do begin
PathW := WideString(AFilenames[i]);
OleCheck(Parent.ParseDisplayName(AHandle, nil, PWideChar(PathW),
Cardinal(nil^), FilePidls[i], Cardinal(nil^)));
end;
// Get the context menu for the files from the parent's IShellFolder
OleCheck(Parent.GetUIObjectOf(AHandle, AFilenames.Count, FilePidls[0],
IID_IContextMenu, nil, Result));
finally
for i := 0 to Length(FilePidls) - 1 do
SHFree(FilePidls[i]);
end;
end;
Для получения актуальных пунктов меню вам нужно вызвать IContextMenu.QueryContextMenu . Вы можете уничтожить возвращенное HMENU используя DestroyMenu .
function GetExplorerHMenu(const AContextMenu: IContextMenu): HMENU;
const
MENUID_FIRST = 1;
MENUID_LAST = $7FFF;
var
OldMode: UINT;
begin
OldMode := SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOOPENFILEERRORBOX);
try
Result := CreatePopupMenu;
AContextMenu.QueryContextMenu(Result, 0, MENUID_FIRST, MENUID_LAST, CMF_NORMAL);
finally
SetErrorMode(OldMode);
end;
end;
Вот как вы на самом деле вызываете команду, выбранную пользователем из меню:
procedure InvokeCommand(const AContextMenu: IContextMenu; AVerb: PChar);
const
CMIC_MASK_SHIFT_DOWN = $10000000;
CMIC_MASK_CONTROL_DOWN = $20000000;
var
CI: TCMInvokeCommandInfoEx;
begin
FillChar(CI, SizeOf(TCMInvokeCommandInfoEx), 0);
CI.cbSize := SizeOf(TCMInvokeCommandInfo);
CI.hwnd := GetOwnerHandle(Owner);
CI.lpVerb := AVerb;
CI.nShow := SW_SHOWNORMAL;
// Ignore return value for InvokeCommand. Some shell extensions return errors
// from it even if the command worked.
try
AContextMenu.InvokeCommand(PCMInvokeCommandInfo(@CI)^)
except on E: Exception do
MessageDlg(Owner, E.Message, mtError, [mbOk], 0);
end;
end;
procedure InvokeCommand(const AContextMenu: IContextMenu; ACommandID: UINT);
begin
InvokeCommand(AContextMenu, MakeIntResource(Word(ACommandID)));
end;
Теперь вы можете использовать функцию GetMenuItemInfo , чтобы получить заголовок, растровое изображение и т. Д., Но гораздо более простой подход - вызвать TrackPopupMenu и позволить Windows показать всплывающее меню. Это будет выглядеть примерно так:
procedure ShowExplorerMenu(AForm: TForm; AMousePos: TPoint;
const APath: string; AFilenames: TStrings; );
var
ShellMenu: IContextMenu;
Menu: HMENU;
MenuID: LongInt;
begin
ShellMenu := GetExplorerMenu(AForm.Handle, APath, AFilenames);
Menu := GetExplorerHMenu(ShellMenu);
try
MenuID := TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_TOPALIGN or TPM_RETURNCMD,
AMousePos.X, AMousePos.Y, 0, AForm.Handle, nil);
InvokeCommand(ShellMenu, MenuID - MENUID_FIRST);
finally
DestroyMenu(Menu);
end;
end;
Если вы действительно хотите извлечь пункты / заголовки меню и добавить их в свое собственное всплывающее меню (мы используем Toolbar 2000 и делаем именно это), вот другие важные проблемы, с которыми вы столкнетесь:
- Меню «Отправить» и другие, созданные по требованию, не будут работать, если вы не обработаете сообщения и не передадите их интерфейсам IContextMenu2 / IContextMenu3.
- Растровые изображения меню представлены в нескольких разных форматах. Delphi не обрабатывает Vista с высоким цветом без коаксиального преобразования, а старые смешиваются с цветом фона с помощью XOR.
- Некоторые пункты меню нарисованы владельцем, поэтому вам нужно записывать сообщения рисования и рисовать их на собственном холсте.
- Строки подсказок не будут работать, если вы не запросите их вручную.
- Вам нужно будет управлять временем жизни IContextMenu и HMENU и освобождать их только после закрытия всплывающего меню.