delphi – TActionMainMenuBar,VCL-Styles和MDI按钮(最小化,关闭
发布时间:2020-12-15 04:12:12 所属栏目:大数据 来源:网络整理
导读:我正在尝试制作TActionMainMenuBar显示风格的MDI按钮,就像TMainMenu一样. 有什么建议?我不能停止在这个项目中使用MDI. 解决方法 好的,首先这不是Vcl样式错误,这是一个VCL错误.即使禁用Vcl样式,也会出现此问题. 该问题位于TCustomMDIMenuButton.Paint方法中,
我正在尝试制作TActionMainMenuBar显示风格的MDI按钮,就像TMainMenu一样.
有什么建议?我不能停止在这个项目中使用MDI. 解决方法
好的,首先这不是Vcl样式错误,这是一个VCL错误.即使禁用Vcl样式,也会出现此问题.
该问题位于TCustomMDIMenuButton.Paint方法中,该方法使用旧的 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,@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,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. 结果将是 (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |