Нужно: в winXP выпадающее shell-меню как в Проводнике

[Paradigm]

Нужно имеющемуся элементу в ListView (или произвольной строке с названием файла) запустить выпадающее меню системы, как в Проводнике Windows.

Меню "открыть с помощью.." я научился открывать через rundll.
Для shell-меню такого приёма с запуском некоего процесса в WinXP не нашёл.
Однако нарыл 2 ссылки на создание ручками такого меню в Дельфи:
http://www.delphikingdom.com/asp/answer.asp?IDAnswer=44012
http://www.ls.iatp.org.ua/index.php?go=delphi215

При попытке тупо компилять первый пример начинают валиться ошибки прямо с первого упоминания IContextMenu. Настроение портится, ручонки опускаются..

Что можете посоветовать?

[Alexx2000]

Я для этого воспользовался модулем http://doublecmd.svn.sourceforge.net/vi ... iew=markup плюс добавить в uses JwaShlGuid;

[Paradigm]

Несколько лет не работал с такими модулями, тем более под Windows.

Функций много. И какие за что отвечают не совсем ясно.
Можно короткий пример дёргания контекстного меню?


А JwaShlGuid даёт перечисление шелловских констант? Для чего? =)

[Alexx2000]

Вот пример, использования:

Код: Выделить всё

uses
Windows,
ComObj,
ActiveX,
ShellApi,
ShlObj, uShlObjAdditional, JwaShlGuid;

var
ICM2: IContextMenu2 = nil;

procedure TForm1.Button1Click(Sender: TObject);
var
desktop: IShellFolder;
mycomputer: IShellFolder;
folder: IShellFolder;
pidl: PItemIDList;
malloc: IMalloc;
chEaten: ULONG;
dwAttributes: ULONG;
contMenu: IContextMenu;
menuX: HMENU;
cmd: UINT;
cmici: CMINVOKECOMMANDINFO;

begin
OleCheck( SHGetMalloc(malloc) );
OleCheck( SHGetDesktopFolder(desktop) );
OleCheck( SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, pidl) );
try
OleCheck( desktop.BindToObject(pidl, nil, IShellFolder, mycomputer) );
finally
malloc.Free(pidl);
end;
dwAttributes := 0;
OleCheck( mycomputer.ParseDisplayName(Handle, nil, 'C:\', chEaten, pidl, dwAttributes) );
try
OleCheck( mycomputer.BindToObject(pidl, nil, IShellFolder, folder) );
finally
malloc.Free(pidl);
end;
dwAttributes := 0;
OleCheck( folder.ParseDisplayName(Handle, nil, 'boot.ini', chEaten, pidl, dwAttributes) );
try
OleCheck( folder.GetUIObjectOf(Handle, 1, pidl, IContextMenu, nil, contMenu) );
finally
malloc.Free(pidl);
end;
menuX := CreatePopupMenu;
try
OleCheck( contMenu.QueryContextMenu(menuX, 0, 1, $7FFF, CMF_EXPLORE or CMF_CANRENAME) );

contMenu.QueryInterface(IID_IContextMenu2, ICM2); //To handle submenus.
cmd := UINT(TrackPopupMenu(menuX, TPM_RETURNCMD, Mouse.CursorPos.x, Mouse.CursorPos.y, 0, Handle, nil));
finally
DestroyMenu(menuX);
end;
if cmd > 0 then
begin
cmici.cbSize := sizeof(cmici);
cmici.fMask := 0;
cmici.hwnd := Handle;
cmici.lpVerb := PChar(cmd - 1);
cmici.lpParameters := nil;
cmici.lpDirectory := nil;
cmici.nShow := SW_NORMAL;
OleCheck( contMenu.InvokeCommand(cmici) );
end
end;

[Paradigm]

Ооооо!!!! Огромное спасибо за столь внушительный пример!

Скачал ushlobjadditional.pas с указанной ссылки и jwashlguid.pas

При компиляции с ushlobjadditional.pas возникли ошибки на строке 1803. Поправил декларирование внешних функций, скопировав полное декларирование и вставив перед "external".
Ниже идёт код до правки. В нём Лазарус ругался на отсутствие нормального описания функций.

Код: Выделить всё

const
   shell32 = 'Shell32.dll'; //from ShellAPI, ShlObj

function SHGetIconOverlayIndexA; external shell32 name 'SHGetIconOverlayIndexA';
function SHGetIconOverlayIndexW; external shell32 name 'SHGetIconOverlayIndexW';
function SHGetIconOverlayIndex ; external shell32 name 'SHGetIconOverlayIndexA';

function SHCreateDirectoryExA; external shell32 name 'SHCreateDirectoryExA';
function SHCreateDirectoryExW; external shell32 name 'SHCreateDirectoryExW';
function SHCreateDirectoryEx ; external shell32 name 'SHCreateDirectoryExA';

function SHGetSpecialFolderPathA; external shell32 name 'SHGetSpecialFolderPathA';
function SHGetSpecialFolderPathW; external shell32 name 'SHGetSpecialFolderPathW';
function SHGetSpecialFolderPath;  external shell32 name 'SHGetSpecialFolderPathA';

function SHGetFolderPathA; external shell32 name 'SHGetFolderPathA';
function SHGetFolderPathW; external shell32 name 'SHGetFolderPathW';
function SHGetFolderPath;  external shell32 name 'SHGetFolderPathA';

function SHGetFolderLocation; external shell32 name 'SHGetFolderLocation';

procedure SHGetSettings; external shell32 name 'SHGetSettings';

function SoftwareUpdateMessageBox; external shell32 name 'SoftwareUpdateMessageBox';

function SHGetMalloc;                   external shell32 name 'SHGetMalloc';
function SHGetDesktopFolder;            external shell32 name 'SHGetDesktopFolder';

В другом месте Лазарус ругался на пробразование array of char в shortstring. Я переменную с массивом загнал в PChar(). Раньше в Дельфях и Киликсе, вроде, это прокатывало. Или в данном случае это неприменимо?

Затем я скачал пару .INC файлов из комплекта JEDI, которые требовались.

В довершение привычная функция FindClose в главном модуле программы резко отказалась работать с TSeachRec и потребовала себе что-то вроде хэндла. Ну ок. Скормил TSeachRec.FindHandle

Программа наконец компилится. И тут я заметил, что забыл самое важное! =)))
Куда засовывать название файла или каталога, для которого я хочу получить выпадающее меню?!
Посмотрел на код и так, и этак.. Не понял. =(
По-умолчанию процедура никакого меню не показывает.

Подскажите, плиз!

[Alexx2000]

Сюда путь каталогу (вместо "C:\")

Код: Выделить всё

OleCheck( mycomputer.ParseDisplayName(Handle, nil, 'C:\', chEaten, pidl, dwAttributes) );

А сюда имя файла (вместо "boot.ini"):

Код: Выделить всё

OleCheck( folder.ParseDisplayName(Handle, nil, 'boot.ini', chEaten, pidl, dwAttributes) ); 

Затем я скачал пару .INC файлов из комплекта JEDI, которые требовались.

Вообще то необходимые модули JEDI уже входят в состав FPC

Ошибки при компилировании были из-за того, что надо было указать режим совместимости с Делфи (например добавив директиву

Код: Выделить всё

{$mode delphi}

или установив соответствующую галочку в настройках компилятора)

[Paradigm]

Да!!! Теперь пример работает! Воспользовался директивой компилятору и указанием пути до инклудов JEDI.

Долго выяснял причину ошибки Access Violation при открытии меню для произвольного объекта. Оказывается, пример открывает меню только для файлов, но не для каталогов.
Попробовал некоторые умозрительные варианты изменения параметров, но ни один не привёл к каким-либо результатам кроме изменения первоначальной ошибки на "Параметр задан неверно". =))

Как открывать шелл-меню и для каталогов?

Также обнаружены пустоты во вложенных меню "Отправить" и не отображается текст с иконками для пункта и подпунктов TortoiseSVN. Другие пункты с подпунктами отображаются нормально (например 7-zip, пункты TuneUp и другие)..

[Alexx2000]

Чтобы работали подменю надо добавить к примеру следующий код:

Код: Выделить всё

var
  OldWProc: WNDPROC;

function MyWndProc(hwnd: HWND; Msg, wParam, lParam: Cardinal): Cardinal; stdcall;
begin
    if ((Msg = WM_INITMENUPOPUP) or (Msg = WM_DRAWITEM) or (Msg = WM_MENUCHAR)
    or (Msg = WM_MEASUREITEM)) and Assigned(ICM2) then
    begin
      ICM2.HandleMenuMsg(Msg, wParam, lParam);
      Result := 0;
    end
    else
      Result := CallWindowProc(OldWProc, hwnd, Msg, wParam, lParam);
end;
  
procedure TForm1.FormCreate(Sender: TObject);
begin
  OldWProc := Windows.WNDPROC(SetWindowLong(Handle, GWL_WNDPROC, Integer(@MyWndProc)));
end;  

Для каталогов все точно также, просто вместо имени файла подставить имя каталога.

[Paradigm]

Работает. Радует. Спасибо огромное!

В процессе использования обратил внимание, что при пользовании указанными функциями исчезает главное меню окна, где я для элемента вызываю выпадающее меню Shell.
Делаю я это просто через щелчок в собственном выпадающем меню. Компонента выпадающего и главного меню лежат на форме, динамически в них ничего не трогаю.
Пробовал повесить выполнение выпадающего меню Shell на кнопку. Результат тот-же.

[poiuyt555]

Alexx2000 Спасибо, код работает, но есть проблема:
Если в полученном меню нажимаю Удалить и Да - то все нормально и файл в Корзине, но если отвечаю Нет - то программа вылетает с ошибкой на строчке:

Код: Выделить всё

OleCheck( contMenu.InvokeCommand(cmici) );

Т.е. как будто Windows-меню пытается вернуть мне ответ Нет и программа вылетает в ошибку.

Вопрос: что делать, как убрать эту ошибку?
Не вызовет ли нестабильная работа данного меню каких-нибудь проблем с данным файлом?

Добавлено спустя 23 часа 34 минуты 57 секунд:
Кто-нибудь может что-нибудь сказать?