TActionMainMenuBar, VCL- 스타일 및 MDI 버튼 (최소화, 닫기 등)은 스타일이 지정되지 않습니다.

Question

TMainMenu처럼 스타일이 적용된 MDI 단추를 TActionMainMenuBar에 표시하려고합니다.

어떤 제안이? 나는이 프로젝트에서 MDI 사용을 멈출 수 없다.

Answer 1

좋아, 먼저 이것은 VCL 스타일 버그이 아니며 VCL 버그입니다. 이 문제는 Vcl 스타일을 사용할 수없는 경우에도 나타납니다.

문제가 자막 버튼을 그리 오래 DrawFrameControl WINAPI 방법을 사용 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, 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. 

결과가 될 것입니다

당신은 항상 VCL 스타일을 사용을 중지 .......