The Road to Delphi

Delphi – Free Pascal – Oxygene

VCL Styles Utils Project – New Addition : Patch for System colors.

17 Comments

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

ColorBox ColorBox_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.

Author: Rodrigo

Just another Delphi guy.

17 thoughts on “VCL Styles Utils Project – New Addition : Patch for System colors.

  1. Rodrigo, this is awesome. Great work. Thank you.

  2. Great job!

    We had a problem with “VCL Styles with Forms using BorderWidth causes wrong Layout” which stopped us using styles
    http://qc.embarcadero.com/wc/qcmain.aspx?d=113544

    Do you see a chance to fix that as well?

    regards

    Günther

    • You’re welcome. About your request. It seems which a workaround was already posted in the same issue report.

      • Yes. You are right. But I have not tested as all this things are really time consuming (what are the side effects introduced by such changes …). Actually your work should flow directly into the EMBT XE(n) updates. Were you never contacted by EMBT?

  3. Pingback: VCL Styles Utils Project – New Addition :...

  4. Rodrigo, thank you for your work!

    Have you tried Vcl.Styles.Hooks and KOLDetours with a 64-Bit debug build?
    I get lot of access violations (for example “First chance exception at $00007FFD007D5810. Exception class $C0000005 with message ‘c0000005 ACCESS_VIOLATION’. Process ThemedSysControls.exe (11312)”) in uxtheme.dll after Vcl.Forms.TApplication.SetMainFormOnTaskBar(True).

    I think the problem is in the KOLDetours unit.
    Is it possible to get a Vcl.Styles.Hooks that does not need KOLDetours?

    • I just fixed the issue related to 64 bits. download the last version of the code from the repository.

      • Rodrigo, thank you for your quick response and bugfix.
        Unfortunately the error still occours in subversion revision 123.

        Have you tested the bugfix?

        Add Vcl.Styles.Hooks and KOLDetours to a project file, for example ThemedSysControls-Demo, and change the Target Platform to Win64 and let it run.

        There are also access violation in your own TDictionary implementation when USEGENERICS is undefined.

        • Thanks again for your feedback, I disable temporally the 64 bits support for the Vcl.Styles.Hooks library. I will work to extended the full 64 bits support in the KOLDetours unit or even better write a new detours library.

  5. Delphi XE4 64 bit target. Application crashes on Application.MainFormOnTaskbar := True; line in main project when Vcl.Styles.Hooks unit is linked to main executable. 32 bit target is ok. “c000006 Access violation” Any chanse you can fix that?
    Thanks for wonderful work anyways

  6. Hi,

    Thank you for your job. It is really helpful.
    But I have some problem when I return to Windows style. For some reason I get Stackoverflow exception. After some debugging I found that the problem comes from attached Vcl.Styles.Hooks under InterceptDrawThemeBackground function.
    StyleServices.DrawElement enter to infinite recursion.

    Can you check it please?

  7. Hi Rodrigo, thanks again for your work.
    Is there a way to disable this fix for the Vcl.HTMLHelpViewer?
    The window is not completely styled so i was looking for a way to disable the styles just for that.
    Or any workaround to have a consistent help window?

  8. Pingback: VCL Styles Utils – New feature | The Road to Delphi - a Blog about programming

Leave a comment