Одна из тонкостей контекстных меню - это показ подсказок в строке статуса. Ну, у нашей программы сейчас нет строки статуса, поэтому мы будем показывать подсказки в заголовке.
Ключевой метод для этой задачи - это IContextMenu.GetCommandString, который позволяет взаимодействовать с обработчиком контекстного меню. Мы должны будем сохранять ещё один интерфейс:
private
{ Private declarations }
g_pcm: IContextMenu;
g_pcm2: IContextMenu2;
g_pcm3: IContextMenu3;
end;Нам также нужно обновлять это поле во время отслеживания меню.
g_pcm := Pcm; Pcm.QueryInterface(IID_IContextMenu2, g_pcm2); Pcm.QueryInterface(IID_IContextMenu3, g_pcm3); try iCmd := Integer(TrackPopupMenuEx(Menu, TPM_RETURNCMD, Pt.X, Pt.y, Handle, nil)); finally g_pcm3 := nil; g_pcm2 := nil; g_pcm := nil; end;
Теперь мы можем предоставить обратную связь, когда пользователь просматривает меню.
// Этот код бажный - см. ниже
procedure TForm1.WMMenuSelect(var Message: TWMMenuSelect);
var
szBuf: array[0..MAX_PATH] of AnsiChar;
begin
if Assigned(g_pcm) and (Message.IDItem >= SCRATCH_QCM_FIRST) and (Message.IDItem <= SRATCH_QCM_LAST) then
begin
if FAILED(g_pcm.GetCommandString(Message.IDItem - SCRATCH_QCM_FIRST, GCS_HELPTEXT, nil, szBuf, MAX_PATH)) then
Caption := 'No help available.'
else
Caption := szBuf;
end;
end;
Эта функция проверяет, находится ли выделение в меню в диапазоне допустимых значений. Если да, то мы спрашиваем о строке-подсказке (или откатываемся до встроенной строки, если обработчик меню не предоставляет подсказки) и показываем её в заголовке окна.
Наконец, мы вставляем вызов этой функции в нашу оконную процедуру. Мы хотим обновлять подсказку, даже если обработчики меню что-то с ним делают, поэтому мы вызываем WMMenuSelect до передачи вызова обработчикам.
procedure TForm1.WndProc(var Message: TMessage);
begin
if Message.Msg = WM_MENUSELECT then
WMMenuSelect(TWMMenuSelect(Message));
if Assigned(g_pcm3) then
...
Погодите-ка, там выше был комментарий, что в нашей реализации WMMenuSelect есть баг. Где же он?
Ну, технически у нас тут нет никакого бага. Но если вы запустите программу как есть (и я вам рекомендую сделать это), то увидите, что программа работает нестабильно.
Это потому что у нас есть куча бажных обработчиков контекстных меню.
Некоторые обработчики не поддерживают Unicode; другие не поддерживают Ansi. А что забавно: вместо того, чтобы возвратить E_NOTIMPL, они возвращают S_OK, но в действительности ничего не делают. Другие обработчики контекстных меню имеют проблемы переполнения буфера и записывают в буфер больше, чем вы указали.
Добро пожаловать в мир обратной совместимости.
Давайте попробуем написать вспомогательную функцию, которая смягчит последствия некоторых багов.
function IContextMenu_GetCommandString(const pcm: IContextMenu; idCmd: UINT_PTR; uFlags: UINT; pwReserved: Pointer; pszName: PWideChar; cchMax: UINT): HRESULT;
var
pszAnsi: PAnsiChar;
begin
// Считаем, что вызывающий всегда хочет Unicode.
if (uFlags and GCS_UNICODE) = 0 then
Exit(E_INVALIDARG);
// Некоторые обработчики имеют баг "размер буфера плюс один" и портят ваш буфер.
// Мы искуственно уменьшаем размер буфера, так что затирание лишнего символа ничего не испортит.
if cchMax <= 1 then
Exit(E_FAIL);
Dec(cchMax);
// Сначала пробуем Unicode.
// Заполним буфер шаблоном, обработчики врут и возвращают S_OK, ничего не делая.
pszName[0] := #0;
Result := pcm.GetCommandString(idCmd, uFlags, pwReserved, Pointer(pszName), cchMax);
if SUCCEEDED(Result) and (pszName[0] = #0) then
// Ага! Попался!
Result := E_NOTIMPL;
if FAILED(Result) then
begin
// Теперь пробуем ANSI - не забываем про + 1 символ для защиты от переполнения
GetMem(pszAnsi, (cchMax + 1) * SizeOf(AnsiChar));
try
pszAnsi[0] := #0;
Result := pcm.GetCommandString(idCmd, uFlags and (not GCS_UNICODE), pwReserved, pszAnsi, cchMax);
if SUCCEEDED(Result) and (pszAnsi[0] = #0) then
// Дьявол, бажный обработчик IContextMenu вернул успех, хотя он ничего не сделал
Result := E_NOTIMPL;
if SUCCEEDED(Result) then
if (MultiByteToWideChar(CP_ACP, 0, pszAnsi, -1, pszName, cchMax) = 0) then
Result := E_FAIL;
finally
FreeMem(pszAnsi);
end;
end;
end;
В оболочке (shell) есть множество странных функций, похожих на эту.
С помощью этой функции мы теперь можем исправить нашу основную функцию.
procedure TForm1.WMMenuSelect(var Message: TWMMenuSelect);
var
szBuf: array[0..MAX_PATH] of WideChar;
begin
if Assigned(g_pcm) and (Message.IDItem >= SCRATCH_QCM_FIRST) and (Message.IDItem <= SCRATCH_QCM_LAST) then
begin
if FAILED(IContextMenu_GetCommandString(g_pcm, Message.IDItem - SCRATCH_QCM_FIRST, GCS_HELPTEXT or GCS_UNICODE, nil, szBuf, MAX_PATH)) then
Caption := 'Подсказка недоступна.'
else
Caption := szBuf;
end;
end;
Этот новый вариант может корректно показывать подсказки для тех пунктов меню, что имеют баги переполнения буфера на единичку или неверно возвращают результат метода.
Окей, это было довольно сильное отклонение от первой части серии. Давайте в следующий раз всё же вернёмся к теме вызова пункта меню по-умолчанию.
Впрочем, пока я сам тестировал этот код, я нашёл кривой обработчик, который вовсе игнорирует флаг GCS_UNICODE, всегда (корректно) заполняя буфер в ANSI и возвращая S_OK.
ОтветитьУдалитьПонятно, что в итоге получаются нечитабельные дракозябры.
Поэтому в IContextMenu_GetCommandString можно бы добавить ещё проверочек для распознавания этих случаев. Хм, не знаю, может чтобы бинарные слепки буфера от вызовов с GCS_UNICODE и без отличались бы? Если нет - то значит у нас кривой обработчик и кодировку в буфере надо ещё определить.
У меня был тоже весьма странный случай: есть пункт меню 7Zip, после него - сепаратор. На самом пункте 7Zip подсказки нет, а вот на сепараторе - пишет "Команды 7Zip". Это тоже бажный обработчик?
ОтветитьУдалитьКонечно.
ОтветитьУдалитьВопрос только: чей обработчик. Не факт, что виновный тут 7z.