paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-26 10:09:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

win32: menus:

Browse Source 
- remove submenu flag from the menu item if there are no more child items there
  - set submenu flag only when GetMenuItemInfo result is True
  - don't try to double destroy menu item handle
  - show debug messages in the console in case of errors

git-svn-id: trunk@22080 -
This commit is contained in:
paul 2009-10-09 09:28:13 +00:00
parent f26a487bf9
commit e477c10fea
1 changed files with 45 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
lcl/interfaces/win32/win32wsmenus.pp
View File

@ -38,7 +38,8 @@ uses
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
WSMenus, WSLCLClasses, WSProc, WSMenus, WSLCLClasses, WSProc,
Windows, Controls, Classes, SysUtils, Win32Int, Win32Proc, Win32WSImgList, Windows, Controls, Classes, SysUtils, Win32Int, Win32Proc, Win32WSImgList,
InterfaceBase, LCLProc, Themes, Win32UxTheme, TmSchema, Win32Themes, Win32Extra; InterfaceBase, LCLProc, Themes, Win32UxTheme, TmSchema, Win32Themes, Win32Extra,
FileUtil;
type type
@ -1225,30 +1226,30 @@ var
ParentOfParent: HMenu; ParentOfParent: HMenu;
begin begin
ParentMenuHandle := AMenuItem.Parent.Handle; ParentMenuHandle := AMenuItem.Parent.Handle;
FillChar(MenuInfo, SizeOf(MenuInfo), 0);
MenuInfo.cbSize := menuiteminfosize;
{Following part fixes the case when an item is added in runtime // Following part fixes the case when an item is added in runtime
but the parent item has not defined the submenu flag (hSubmenu=0) } // but the parent item has not defined the submenu flag (hSubmenu=0)
if AMenuItem.Parent.Parent <> nil then if AMenuItem.Parent.Parent <> nil then
begin begin
ParentOfParent := AMenuItem.Parent.Parent.Handle; ParentOfParent := AMenuItem.Parent.Parent.Handle;
with MenuInfo do MenuInfo.fMask := MIIM_SUBMENU;
if GetMenuItemInfo(ParentOfParent, AMenuItem.Parent.Command, False, @MenuInfo) then
begin begin
cbSize := menuiteminfosize; // the parent menu item is not defined with submenu flag
fMask := MIIM_SUBMENU; // convert it to submenu
end; if MenuInfo.hSubmenu = 0 then
GetMenuItemInfo(ParentOfParent, AMenuItem.Parent.Command, begin
False, @MenuInfo); MenuInfo.hSubmenu := ParentMenuHandle;
if MenuInfo.hSubmenu = 0 then // the parent menu item is not yet defined with submenu flag if not SetMenuItemInfo(ParentOfParent, AMenuItem.Parent.Command, False, @MenuInfo) then
begin DebugLn(['SetMenuItemInfo failed: ', GetLastError, ' : ', UTF8ToConsole(AnsiToUtf8(GetLastErrorText(GetLastError)))]);
MenuInfo.hSubmenu := ParentMenuHandle; end;
SetMenuItemInfo(ParentOfParent, AMenuItem.Parent.Command,
False, @MenuInfo);
end; end;
end; end;
with MenuInfo do with MenuInfo do
begin begin
cbsize := menuiteminfosize;
if AMenuItem.Enabled then if AMenuItem.Enabled then
fState := MFS_ENABLED fState := MFS_ENABLED
else else
@ -1284,9 +1285,8 @@ begin
if AMenuItem.RightJustify then if AMenuItem.RightJustify then
fType := fType or MFT_RIGHTJUSTIFY; fType := fType or MFT_RIGHTJUSTIFY;
end; end;
if dword(InsertMenuItem(ParentMenuHandle, if not InsertMenuItem(ParentMenuHandle, AMenuItem.Parent.VisibleIndexOf(AMenuItem), True, @MenuInfo) then
AMenuItem.Parent.VisibleIndexOf(AMenuItem), true, @MenuInfo)) = 0 then DebugLn(['InsertMenuItem failed with error: ', GetLastError, ' : ', UTF8ToConsole(AnsiToUtf8(GetLastErrorText(GetLastError)))]);
DebugLn('InsertMenuItem failed with error: ', IntToStr(Windows.GetLastError));
TriggerFormUpdate(AMenuItem); TriggerFormUpdate(AMenuItem);
end; end;
@ -1296,9 +1296,35 @@ begin
end; end;
class procedure TWin32WSMenuItem.DestroyHandle(const AMenuItem: TMenuItem); class procedure TWin32WSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
var
ParentOfParent: HMENU;
MenuInfo: MENUITEMINFO;
begin begin
if Assigned(AMenuItem.Parent) then if Assigned(AMenuItem.Parent) then
DeleteMenu(AMenuItem.Parent.Handle, AMenuItem.Command, MF_BYCOMMAND); begin
RemoveMenu(AMenuItem.Parent.Handle, AMenuItem.Command, MF_BYCOMMAND);
// convert submenu to a simple menu item if needed
if (GetMenuItemCount(AMenuItem.Parent.Handle) = 0) and
Assigned(AMenuItem.Parent.Parent) and
AMenuItem.Parent.Parent.HandleAllocated then
begin
ParentOfParent := AMenuItem.Parent.Parent.Handle;
FillChar(MenuInfo, SizeOf(MenuInfo), 0);
with MenuInfo do
begin
cbSize := menuiteminfosize;
fMask := MIIM_SUBMENU;
end;
GetMenuItemInfo(ParentOfParent, AMenuItem.Parent.Command, False, @MenuInfo);
// the parent menu item is defined with submenu flag then reset it
if MenuInfo.hSubmenu <> 0 then
begin
MenuInfo.hSubmenu := 0;
if not SetMenuItemInfo(ParentOfParent, AMenuItem.Parent.Command, False, @MenuInfo) then
DebugLn(['SetMenuItemInfo failed: ', GetLastError, ' : ', UTF8ToConsole(AnsiToUtf8(GetLastErrorText(GetLastError)))]);
end;
end;
end;
DestroyMenu(AMenuItem.Handle); DestroyMenu(AMenuItem.Handle);
TriggerFormUpdate(AMenuItem); TriggerFormUpdate(AMenuItem);
end; end;