Quantcast
Channel: Planet Object Pascal
Viewing all articles
Browse latest Browse all 1725

The road to Delphi: VCL Styles Utils Project New Addition : Patch for System colors.

$
0
0

Introduction

A result of the work in a new sub project of the VCL Styles Utils , many new features as been added to the library, One of my favorites is a patch for the GetSysColor WinApi function. This fix replace the original call to this function by a jump to the StyleServices.GetSystemColor method replacing the original system colors by the current VCL Style colors. One of the advantages of use this fix is which the controls uses the proper VCL Style highlight color.

Screenshots

Check these controls with the VCL Styles

full

Now using the Vcl.Styles.Hooks unit

Full_Fix

TColorBox

ColorBoxColorBox_Fix

Source Code

This is the actual source code of the Vcl.Styles.Hooks unit which includes the patch to the GetSysColor function. To use this unit in your code you must add the KOLDetours unit too.

unit Vcl.Styles.Hooks;

interface

implementation

uses
  KOLDetours,
  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, @InterceptGetSysColor);

end.


Viewing all articles
Browse latest Browse all 1725

Trending Articles