Delphi 对TEdit中的选定文本使用样式化SysColor

我正在使用DelphiXE3构建一个VCL应用程序。此VCL应用程序使用unit

VCL.Styles

中的内置样式设置样式

在我使用的样式中，SysColor

clHighlight

已被更改，但当在

TEdit

中选择一段文本时（或

TComboBox

或

TMemo

），将使用默认的系统突出显示颜色（默认为蓝色）为所选文本的背景着色

注意：其他控件对样式中的选定项使用SysColor

clHighlight

---

问题：如何在样式中指定此颜色？

这是WinApi的一个限制，这些控件使用的高亮颜色不能直接修改。唯一的解决方法是用函数钩住并替换方法。像这样

implementation

uses
  DDetours,
  WinApi.Windows,
  Vcl.Styles,
  Vcl.Themes;

var
  TrampolineGetSysColor:  function (nIndex: Integer): DWORD; stdcall;
  GetSysColorOrgPointer : Pointer = nil;

function InterceptGetSysColor(nIndex: Integer): DWORD; stdcall;
begin
  if StyleServices.IsSystemStyle then
   Result:= TrampolineGetSysColor(nIndex)
  else
   Result:= StyleServices.GetSystemColor(nIndex or Integer($FF000000));
end;

initialization
 if StyleServices.Available then
 begin
    GetSysColorOrgPointer := GetProcAddress(GetModuleHandle('user32.dll'), 'GetSysColor');
    @TrampolineGetSysColor := InterceptCreate(GetSysColorOrgPointer, @InterceptGetSysColor);
 end;
finalization
  if GetSysColorOrgPointer<>nil then
    InterceptRemove(@TrampolineGetSysColor);

end. 

实现
使用
迪图尔，
WinApi.Windows，
Vcl.样式，
Vcl.主题；
变量
TrampolineGetSysColor:函数（nIndex:整数）：DWORD；stdcall；
GetSysColorgPointer:Pointer=nil；
函数getsyscolor（nIndex:Integer）：DWORD；stdcall；
开始
如果是StyleServices.IsSystemStyle，那么
结果：=蹦床运动颜色（nIndex）
其他的
结果：=StyleServices.GetSystemColor（nIndex或整数（$FF000000））；
结束；
初始化
如果是StyleServices，则可用
开始
GetSysColorgPointer:=GetProcAddress（GetModuleHandle（'user32.dll'），'GetSysColor'）；
@TrampolineGetSysColor:=InterceptCreate（GetSysColorOrgPointer，@InterceptGetSysColor）；
结束；
定稿
如果GetSysColorgPointernil，则
拦截器移除（@trampolingetsyscolor）；
结束。

以前

之后

---

顺便说一句，该项目包含一个带有此挂钩的单元。

这是WinApi的一个限制，这些控件使用的高亮颜色不能直接修改。唯一的解决方法是用函数钩住并替换方法。像这样

implementation

uses
  DDetours,
  WinApi.Windows,
  Vcl.Styles,
  Vcl.Themes;

var
  TrampolineGetSysColor:  function (nIndex: Integer): DWORD; stdcall;
  GetSysColorOrgPointer : Pointer = nil;

function InterceptGetSysColor(nIndex: Integer): DWORD; stdcall;
begin
  if StyleServices.IsSystemStyle then
   Result:= TrampolineGetSysColor(nIndex)
  else
   Result:= StyleServices.GetSystemColor(nIndex or Integer($FF000000));
end;

initialization
 if StyleServices.Available then
 begin
    GetSysColorOrgPointer := GetProcAddress(GetModuleHandle('user32.dll'), 'GetSysColor');
    @TrampolineGetSysColor := InterceptCreate(GetSysColorOrgPointer, @InterceptGetSysColor);
 end;
finalization
  if GetSysColorOrgPointer<>nil then
    InterceptRemove(@TrampolineGetSysColor);

end. 

实现
使用
迪图尔，
WinApi.Windows，
Vcl.样式，
Vcl.主题；
变量
TrampolineGetSysColor:函数（nIndex:整数）：DWORD；stdcall；
GetSysColorgPointer:Pointer=nil；
函数getsyscolor（nIndex:Integer）：DWORD；stdcall；
开始
如果是StyleServices.IsSystemStyle，那么
结果：=蹦床运动颜色（nIndex）
其他的
结果：=StyleServices.GetSystemColor（nIndex或整数（$FF000000））；
结束；
初始化
如果是StyleServices，则可用
开始
GetSysColorgPointer:=GetProcAddress（GetModuleHandle（'user32.dll'），'GetSysColor'）；
@TrampolineGetSysColor:=InterceptCreate（GetSysColorOrgPointer，@InterceptGetSysColor）；
结束；
定稿
如果GetSysColorgPointernil，则
拦截器移除（@trampolingetsyscolor）；
结束。

以前

之后

---

顺便说一句，该项目包含一个带有此挂钩的单元。

在向项目添加Vcl.Styles.Hooks后，编辑控件看起来很棒。仅：在单元

DDetours

中，我需要添加

{$Q-}

以避免启动时出现

EIntOverflow

异常。在向项目添加Vcl.Styles.hook后，您可以在项目页面中报告有关迂回库的问题。编辑控件看起来很棒。仅：在单元

DDetours

中，我需要添加

{$Q-}

，以避免启动时出现

EIntOverflow

异常。您可以在项目页面中报告有关迂回库的问题