TActionMainMenuBar, стили VCL и кнопки MDI (свернуть, закрыть и т. д.) не стилизованы.

Я пытаюсь заставить TActionMainMenuBar отображать кнопки MDI в стиле, как это делает TMainMenu.

Проблема со стилями VCL

Какие-либо предложения? Я не могу перестать использовать MDI для этого проекта.


person Marcio Rodrigues    schedule 01.06.2013    source источник
comment
Вы всегда можете перестать использовать стили VCL .......   -  person David Heffernan    schedule 02.06.2013
comment
MDI был порожден идеей единого родительского окна, в котором размещаются несколько экземпляров одного и того же класса документа. Фреймы позволяют вам делать это без ненужных хлопот для разработчика и пользователя.   -  person Peter    schedule 03.06.2013
comment
Можете ли вы включить пример кода для воспроизведения проблемы?   -  person RRUZ    schedule 03.06.2013
comment
@RRUZ, в IDE создайте новое приложение MDI, добавьте ActionManager и ActionMainMenuBar в основную форму, используйте стили Vcl, запустите проект и каскадируйте новую дочернюю форму.   -  person Peter    schedule 04.06.2013
comment
@RRUZ Как сказал Питер Вонча. Но вам нужно максимизировать дочернее окно.   -  person Marcio Rodrigues    schedule 04.06.2013


Ответы (1)


Хорошо, во-первых, это не ошибка Vcl Styles, это ошибка VCL. Эта проблема возникает, даже если стили 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. 

Результат будет

введите здесь описание изображениявведите здесь описание изображения

person RRUZ    schedule 04.06.2013
comment
Здорово! Большое спасибо, Родриго. - person Marcio Rodrigues; 04.06.2013
comment
Пожалуйста, не забудьте сообщить об этой проблеме на сайт контроля качества qc.embarcadero.com/wc/ qcmain.aspx - person RRUZ; 04.06.2013