Delphi TActionMainMenuBar、VCL样式和MDI按钮（最小化、关闭等）未设置样式。

我正试图使TActionMainMenuBar显示风格的MDI按钮像TMainMenu一样

---

有什么建议吗？我无法停止在此项目中使用MDI。

好的，首先这不是Vcl样式错误，这是Vcl错误。即使禁用Vcl样式，也会出现此问题

问题出现在

TCustomMDIMenuButton.Paint

方法中，该方法使用旧的WinAPi方法绘制标题按钮

procedure TCustomMDIMenuButton.Paint;
begin
  DrawFrameControl(Canvas.Handle, ClientRect, DFC_CAPTION,
    MouseStyles[MouseInControl] or ButtonStyles[ButtonStyle] or
    PushStyles[FState = bsDown]);
end;

作为解决方法，您可以使用迂回路线修补此方法，然后使用

StylesServices

实现新的绘制方法

只需将此单元添加到您的项目中

unit PatchMDIButtons;

interface

implementation

uses
  System.SysUtils,
  Winapi.Windows,
  Vcl.Themes,
  Vcl.Styles,
  Vcl.ActnMenus;

type
  TCustomMDIMenuButtonClass= class(TCustomMDIMenuButton);

  TJumpOfs = Integer;
  PPointer = ^Pointer;

  PXRedirCode = ^TXRedirCode;
  TXRedirCode = packed record
    Jump: Byte;
    Offset: TJumpOfs;
  end;

  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;
    Addr: PPointer;
  end;

var
  PaintMethodBackup   : TXRedirCode;

function GetActualAddr(Proc: Pointer): Pointer;
begin
  if Proc <> nil then
  begin
    if (Win32Platform = VER_PLATFORM_WIN32_NT) and (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
      Result := PAbsoluteIndirectJmp(Proc).Addr^
    else
      Result := Proc;
  end
  else
    Result := nil;
end;

procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);
var
  n: NativeUInt;
  Code: TXRedirCode;
begin
  Proc := GetActualAddr(Proc);
  Assert(Proc <> nil);
  if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then
  begin
    Code.Jump := $E9;
    Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code);
    WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
  end;
end;

procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);
var
  n: NativeUInt;
begin
  if (BackupCode.Jump <> 0) and (Proc <> nil) then
  begin
    Proc := GetActualAddr(Proc);
    Assert(Proc <> nil);
    WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n);
    BackupCode.Jump := 0;
  end;
end;


procedure PaintPatch(Self: TObject);
const
  ButtonStyles: array[TMDIButtonStyle] of TThemedWindow = (twMDIMinButtonNormal, twMDIRestoreButtonNormal, twMDICloseButtonNormal);
var
  LButton : TCustomMDIMenuButtonClass;
  LDetails: TThemedElementDetails;
begin
  LButton:=TCustomMDIMenuButtonClass(Self);
  LDetails := StyleServices.GetElementDetails(ButtonStyles[LButton.ButtonStyle]);
  StyleServices.DrawElement(LButton.Canvas.Handle, LDetails, LButton.ClientRect);
end;

procedure HookPaint;
begin
  HookProc(@TCustomMDIMenuButtonClass.Paint, @PaintPatch, PaintMethodBackup);
end;

procedure UnHookPaint;
begin
  UnhookProc(@TCustomMDIMenuButtonClass.Paint, PaintMethodBackup);
end;


initialization
 HookPaint;
finalization
 UnHookPaint;
end. 

单元按钮；
接口
实施
使用
System.SysUtils，
Winapi.Windows，
Vcl.主题，
Vcl.样式，
Vcl.ActnMenus；
类型
TcustomDimenuButtonClass=类（TcustomDimenuButton）；
TJumpOfs=整数；
p指针=^指针；
PXRedirCode=^TXRedirCode；
TXRedirCode=压缩记录
跳转：字节；
偏移量：Tf；
结束；
PAbsoluteIndirectJmp=^TAbsoluteIndirectJmp；
TAbsoluteIndirectJmp=打包记录
操作码：Word；
地址：PPointer；
结束；
变量
PaintMethodBackup:TXRedirCode；
函数GetActualAddr（Proc:Pointer）：指针；
开始
如果Proc nil那么
开始
如果（Win32Platform=VER\u PLATFORM\u win32nt）和（PAbsoluteIndirectJmp（Proc）.OpCode=$25FF），则
结果：=PAbsoluteIndirectJmp（Proc）.Addr^
其他的
结果：=Proc；
结束
其他的
结果：=无；
结束；
过程HookProc（Proc，Dest:Pointer；var BackupCode:TXRedirCode）；
变量
n：本地单元；
代码：TXRedirCode；
开始
Proc:=getactualadr（Proc）；
断言（Proc nil）；
如果ReadProcessMemory（GetCurrentProcess，Proc，@BackupCode，SizeOf（BackupCode），n），则
开始
代码.跳转：=$E9；
代码偏移量：=PAnsiChar（目的地）-PAnsiChar（过程）-尺寸（代码）；
WriteProcessMemory（GetCurrentProcess，Proc，@Code，SizeOf（Code），n）；
结束；
结束；
过程UnhookProc（过程：指针；变量备份代码：TXRedirCode）；
变量
n：本地单元；
开始
如果（BackupCode.Jump 0）和（Proc nil），则
开始
Proc:=getactualadr（Proc）；
断言（Proc nil）；
WriteProcessMemory（GetCurrentProcess，Proc，@BackupCode，SizeOf（BackupCode），n）；
BackupCode.Jump:=0；
结束；
结束；
程序PaintPatch（Self:TObject）；
常数
ButtonStyles:TThemedWindow=（twMDIMinButtonNormal、twmdireRestoreButtonNormal、twmdCloseButtonNormal）的数组[TMDIButtonStyle]；
变量
LButton:TCustomMDIMenuButtonClass；
详细信息：t元素详细信息；
开始
LButton:=TCustomMDIMenuButtonClass（Self）；
LDetails:=StyleServices.GetElementDetails（ButtonStyles[LButton.ButtonStyle]）；
StyleServices.drawerElement（LButton.Canvas.Handle、LDetails、LButton.ClientRect）；
结束；
喷漆程序；
开始
HookProc（@TCustomMDIMenuButtonClass.Paint、@PaintPatch、PaintMethodBackup）；
结束；
脱漆程序；
开始
UnhookProc（@TCustomMDIMenuButtonClass.Paint，PaintMethodBackup）；
结束；
初始化
钩子漆；
定稿
脱漆；
结束。

结果将是

---

您可以随时停止使用VCL样式…….MDI是由一个单亲窗口承载同一类“文档”的多个实例的想法产生的，框架允许您这样做，而不会给开发人员和用户带来不必要的麻烦。您能提供一个示例代码来重现该问题吗？@RRUZ，在IDE中创建新的MDI应用程序，将ActionManager和ActionMainMenuBar添加到主窗体中，使用Vcl样式，运行project并级联新的子窗体。@RRUZ正如Peter Vonča所说。但是你需要最大化孩子的窗户。太好了！非常感谢Rodrigo。不客气，别忘了将此问题报告给QC现场