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.
就是这样。只需保存此单元并将其添加到项目中即可。无需在任何地方调用它。
我在应用了 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.
就是这样。只需保存此单元并将其添加到项目中即可。无需在任何地方调用它。