Delphi - 应用 VCL 主题时更改功能区菜单颜色

Delphi - change ribbon menu color when VCL theme is applied

我在应用了 VCL 主题 的 Delphi XE7 应用程序上使用 TRibbon,我想更改菜单颜色(因为在深色主题下很难看清项目),如下:

我试过下面的代码,但它只在禁用样式时有效:

  Ribbon1.ApplicationMenu.Menu.ColorMap.MenuColor:= clYellow;

此行也无效:

  Ribbon1.ApplicationMenu.Menu.ColorMap.MenuColor:= StyleServices.GetStyleColor(scButtonHot);

有谁知道这是否可能? 非常感谢!

用你喜欢的颜色创造你自己的风格。

经过一番尝试,我找到了解决办法。我不知道这是否是最好的方法,但它对我有用并且可能对其他人有用。

问题出在以下方法 (Vcl.ActnMenus.pas) 中,启用 StyleServices 时:

procedure TCustomActionPopupMenu.DrawBackground;
begin
  inherited;
  if StyleServices.Enabled and not StyleServices.IsSystemStyle then
    StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tmPopupBackground),
      Rect(0, 0, Width, Height))
  else
  begin
    Canvas.Brush.Color := ColorMap.MenuColor;
    Canvas.FillRect(ClientRect);
  end;
end;

所以,为了绕过这个方法,我直接hook了它(改编自here):

unit MethodHooker;

interface

uses Windows, Vcl.ActnMenus;

type
  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;

  TCustomActionPopupMenu = class(Vcl.ActnMenus.TCustomActionPopupMenu)
    procedure DrawBackgroundEx;
  end;

implementation

procedure Patch(Address: Pointer; const NewCode; Size: NativeUInt);
var
  NumberOfBytes: NativeUInt;
begin
  WriteProcessMemory(GetCurrentProcess, Address, @NewCode, Size, NumberOfBytes);
end;

procedure Redirect(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := Integer(NewAddress)-Integer(OldAddress)-SizeOf(NewCode);
  Patch(OldAddress, NewCode, SizeOf(NewCode));
end;

{ TCustomActionPopupMenu }

procedure TCustomActionPopupMenu.DrawBackgroundEx;
begin
  Canvas.Brush.Color := [=11=]EEEAE9;
  Canvas.FillRect(ClientRect);
end;

initialization
  Redirect(@TCustomActionPopupMenu.DrawBackground, @TCustomActionPopupMenu.DrawBackgroundEx);

end.

就是这样。只需保存此单元并将其添加到项目中即可。无需在任何地方调用它。