解决TActionMainMenuBar绘画错误,其中项目未取消选择

utm*_*ost 5 delphi menu tactionmanager

TActionMainMenuBar有一个绘制根元素没有子项的错误.

使用Delphi XE2/w7-32bit**

如何重现:
使用TActionMainMenuBar构建菜单,向其添加一些操作:

 file  | options | help
 - New
 - Open
 - Save
  -Exit
Run Code Online (Sandbox Code Playgroud)

为所有操作分配一个空方法

procedure TfrmMain.ActionExecute(Sender: TObject); 
begin 
// 
end;
Run Code Online (Sandbox Code Playgroud)

现在运行应用程序并尝试单击选项或帮助元素.
现在单击表单,但菜单元素仍然按下!

有任何变通方法吗?

upd:看截图,菜单元素是down,但是鼠标光标不在菜单上,而autocheck是false,并且检查也是false.
在此输入图像描述
这里不是表单上的任何色彩映射,经理风格是平台默认

utm*_*ost 1

这是我的解决方法:
创建自定义类,如下所示:


type
  TFastThemedButton = class(TThemedMenuButton)
  protected
    procedure DrawBackground(var PaintRect: TRect); override;
end;
Run Code Online (Sandbox Code Playgroud)

...


procedure TFastThemedButton.DrawBackground(var PaintRect: TRect);
const
  MenuStates: array[Boolean {MouseInControl}, Boolean {Selected}] of TThemedMenu =
    ((tmMenuBarItemNormal, tmMenuBarItemPushed), (tmMenuBarItemHot, tmMenuBarItemPushed));
var
  BannerRect: TRect;
  StartCol, EndCol: TColor;
begin
   Canvas.Brush.Color := ActionBar.ColorMap.Color;
   Canvas.Font := ActionBar.Font;
   StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(MenuStates[MouseInControl, (State=bsDown)]), PaintRect);
end;
Run Code Online (Sandbox Code Playgroud)

现在在你的 TActionMainMenuBar.OnGetControlClass 添加这个简单的代码,并设置为 buggy actionclients tag=-100


procedure TfrmActions.ActionMainMenuBar1GetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
  if ControlClass.InheritsFrom(TCustomMenuButton) and then
   begin
    if (AnItem.Tag =-100) and (ControlClass = TThemedMenuButton) then
      ControlClass := TFastThemedButton;
   end;
end;
Run Code Online (Sandbox Code Playgroud)

好吧,现在所有带有 -100 标签的根项目都可以按照我们的意愿工作