paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 22:58:50 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL, Win32: fixed onUpdate event triggering of TAction and submenu item of TPopupMenu, patch by Henner Drewes, issue #28069

Browse Source
This commit is contained in:
Maxim Ganetsky 2023-04-22 01:29:41 +03:00
parent 9e69dd9798
commit e566a58336
1 changed files with 19 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lcl/interfaces/win32/win32callback.inc
View File

@ -442,15 +442,31 @@ function TWindowProcHelper.GetPopMenuItemObject: TObject;
var
MainMenuHandle: HMENU;
MenuInfo: MENUITEMINFO;
PopupMenu: TPopupMenu;
begin
Result := nil;
MenuInfo.cbSize := MMenuItemInfoSize;
MenuInfo.fMask := MIIM_DATA;
// first we have to decide if the command is from a popup menu
// or from the window main menu
// if the 'PopupMenu' property exists, there is a big probability
// that the command is from a popup menu
PopupMenu := WindowInfo^.PopupMenu;
if Assigned(PopupMenu) then
begin
MainMenuHandle := GetMenuParent(HMENU(WParam), PopupMenu.Handle);
if (MainMenuHandle <> 0) and GetMenuItemInfo(MainMenuHandle, LOWORD(LParam), true, @MenuInfo) then
begin
Result := TObject(MenuInfo.dwItemData);
Exit;
end;
end;
MainMenuHandle := GetMenuParent(HMENU(WParam), GetMenu(Window));
if GetMenuItemInfo(MainMenuHandle, LOWORD(LParam), true, @MenuInfo) then
Result := TObject(MenuInfo.dwItemData)
else
Result := nil;
Result := TObject(MenuInfo.dwItemData);
end;
function TWindowProcHelper.GetMenuItemObject(ByPosition: Boolean): TObject;