По умолчанию свойство TPopupMenu.WindowHandle
установлено на Application.Handle
, а не на private HWND
, что TPopupMenu
на самом деле использует для фактической отправки своих WM_COMMAND
сообщений. Это окно создается при вызове метода TPopupMenu.Popup()
и не обновляет свойство TPopupMenu.WindowHandle
.
Попробуйте вместо этого использовать свойство TPopupList.Window
свойства TPopupMenu.WindowHandle
для HWND
для передачи HiliteMenuItem()
. В модуле Vcl.Menus
есть глобальный объект PopupList
:
procedure TMyForm.pmTestPopup(Sender: TObject);
begin
Winapi.Windows.HiliteMenuItem({pmTest.WindowHandle}PopupList.Window, pmTest.Handle, 1, MF_BYPOSITION or MF_HILITE);
end;
Если это все еще не работает, попробуйте Win32 SetMenuItemInfo()
вместо этого функция, которая не принимает HWND
для ввода:
procedure TMyForm.pmTestPopup(Sender: TObject);
var
mii: MENUITEMINFO;
begin
ZeroMemory(@mii, sizeof(mii));
mii.cbSize := sizeof(mii);
mii.fMask := MIIM_STATE;
mii.fState := MFS_HILITE;
Winapi.Windows.SetMenuItemInfoW(pmTest.Handle, 1, True, mii);
end;
ОБНОВЛЕНИЕ : При дальнейшем рассмотрении событие TPopupMenu.OnPopup
запускается ДО того, как меню становится видимым, и TPopupMenu
может воссоздать меню ПОСЛЕ вызова OnPopup
и ДО того, как меню действительно отобразится. Таким образом, ваша лучшая ставка, скорее всего, подкласс TPopupList
окна , так что вы можете перехватить сообщение WM_ENTERMENULOOP
, а затем настроить элементы вашего меню в этой точке. Например:
type
TPopupListEx = class(TPopupList)
protected
procedure WndProc(var Message: TMessage); override;
end;
procedure TPopupListEx.WndProc(var Message: TMessage);
begin
inherited;
if (Message.Msg = WM_ENTERMENULOOP) and (Message.WParam = 1) then
begin
// customize pmTest items as needed...
end;
end;
initialization
Popuplist.Free; //free the "default", "old" list
PopupList := TPopupListEx.Create; //create the new one
// The new PopupList will be freed by
// finalization section of Menus unit.
end.