TActionMainMenuBar, वीसीएल-स्टाइल और एमडीआई बटन (न्यूनतम, बंद आदि) स्टाइल नहीं किया जा रहा है।

Question

मैं TActionMainMenuBar डिस्प्ले स्टाइल वाले एमडीआई बटन जैसे टीएमएएनमेनू करता हूं।

कोई सुझाव? मैं इस परियोजना के लिए एमडीआई का उपयोग बंद नहीं कर सकता।

Answer 1

ठीक है, पहले यह वीसीएल स्टाइल बग नहीं है, यह एक वीसीएल बग है। यह समस्या तब भी प्रकट होती है जब Vcl स्टाइल अक्षम हैं।

मुद्दा TCustomMDIMenuButton.Paint विधि है जो कैप्शन बटन आकर्षित करने के लिए वर्ष DrawFrameControl 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. 

परिणाम होगा