Exploring Delphi XE2 – VCL Styles Part III

January 8, 2012 by Rodrigo 3 Comments

Update : this project now is hosted on Github.

Introduction

The VCL Styles are great but it seems that was designed to hide (and protect?) a lot of useful properties and classes. Because that I wrote a small (for the moment) library that using class helpers (and another tricks) can access to hidden properties and classes of the VCL Styles. Today I will show you how using this library you can create a previewer for your vcl styles.

When you design a GUI and include the option to change the current VCL Style of an application you generally provide a list of the availables VCL Styles, then the user without knowing nothing about the appearance of the style must choose one and then apply the changes. Well you can improve the user experience showing a preview image of the VCL style before to apply the selection.

Check out this sample image of a settings option of the WDCC, that shows a preview of the VCL Styles.

The internals

The TStyleManager class contains an internal collection with all the registered (loaded) styles, this list is stored in a Dictionary class var like this FRegisteredStyles: TDictionary; and each TPair contains the style name and a TSourceInfo value.

This is the definition of the TSourceInfo type

TStyleServicesHandle = type Pointer;
  strict private type
    TSourceInfo = record
      Data: TStyleServicesHandle;
      StyleClass: TCustomStyleServicesClass;
    end;

The Data field point to a TStream that contains all the objects and bitmaps related to the style and the StyleClass field has the type of the class Style Service. Now in order to access the visual elements of the style we need interpret the content of the Data field. The logic to interpret the streams with the VCL style info is placed in two files StyleUtils.inc and StyleAPI.inc, these files are in the source\vcl folder of your Rad Studio installation. As probably you must know these files are not units and are embedded in the implementation part of the Vcl.Styles unit, because that the classes and methods of these files are not accesible in any way (for now).

Note : The StyleUtils.inc and StyleAPI.inc files contains code that originally was part of the SkineEngine library of Eugene A. Kryukov (Yeah Eugene is the original author of the DXScene the antecesor of FireMonkey).

Accesing the TSourceInfo

The first task is gain access to the class var FRegisteredStyles of the TStyleManager class. So using a class helper we can do the trick.

  //we need redeclare these types because are defined as <em>strict private</em> types inside of the <em>TStyleManager </em>class and are not accesible of outside.
  TStyleServicesHandle = type Pointer;
  TSourceInfo = record
    Data: TStyleServicesHandle;
    StyleClass: TCustomStyleServicesClass;
  end;
   
  //the class helper
  TStyleManagerHelper = Class Helper for TStyleManager
  strict private
    class function GetStyleSourceInfo(const StyleName: string): TSourceInfo; static;
  public
   class function GetRegisteredStyles: TDictionary<string, TSourceInfo>;
   class property StyleSourceInfo[const StyleName: string]: TSourceInfo read GetStyleSourceInfo;
  end;

class function TStyleManagerHelper.GetRegisteredStyles: TDictionary<string, TSourceInfo>;
var
  t            : TPair<string, TStyleManager.TSourceInfo>;
  SourceInfo   : TSourceInfo;
begin
 Result:=TDictionary<string, TSourceInfo>.Create;
  for t in Self.FRegisteredStyles do
  begin
   SourceInfo.Data:=t.Value.Data;
   SourceInfo.StyleClass:=t.Value.StyleClass;
   Result.Add(t.Key,SourceInfo);
  end;
end;

class function TStyleManagerHelper.GetStyleSourceInfo(const StyleName: string): TSourceInfo;
Var
 LRegisteredStyles : TDictionary<string, TSourceInfo>;
begin
  LRegisteredStyles:=TStyleManager.GetRegisteredStyles;
  try
    if LRegisteredStyles.ContainsKey(StyleName) then
      Result:=LRegisteredStyles[StyleName];
  finally
     LRegisteredStyles.Free;
  end;
end;

So in this point we have access to the TSourceInfo of each registered style. Now we can use the above class helper in this way

var
  SourceInfo: TSourceInfo;
begin
  SourceInfo:=TStyleManager.StyleSourceInfo[StyleName];
  //do something 
end;

Writting a TCustomStyle

The second part of the task is interpret the stream stored in TSourceInfo.Data, to do this we need create a TCustomStyle descendant class and use the code of the StyleUtils.inc and StyleAPI.inc files. The TCustomStyle class has a private field FSource: TObject; that store the VCL Style content (objects, fonts, colors, bitmaps and so on) this field must be filled with the content of the Stream stored in the TSourceInfo.Data. After of that you will have a new Style Class ready to use as you want.

This is the definiton of the TCustomStyleExt class.

type
  TCustomStyleHelper = Class Helper for TCustomStyle
  private
    function GetSource: TObject;
  public
    property Source: TObject read GetSource;
  End;

  TCustomStyleExt = class(TCustomStyle)
  strict private
    FStream    : TStream;
  public
    function  GetStyleInfo : TStyleInfo;
  public
    constructor Create(const FileName :string);overload;
    constructor Create(const Stream:TStream);overload;
    destructor Destroy;override;
    property StyleInfo : TStyleInfo read GetStyleInfo;
  end;

//we need include this files in the implemnetation part to use the TseStyle class
{$I 'C:\Program Files (x86)\Embarcadero\RAD Studio\9.0\source\vcl\StyleUtils.inc'}
{$I 'C:\Program Files (x86)\Embarcadero\RAD Studio\9.0\source\vcl\StyleAPI.inc'}

//Gain acess to the FSource field of the TCustomStyle
function TCustomStyleHelper.GetSource: TObject;
begin
  Result:=Self.FSource;
end;

//with this constructor we can load a Vcl Style file, without register in the system
constructor TCustomStyleExt.Create(const FileName: string);
var
  LStream: TFileStream;
begin
  LStream := TFileStream.Create(FileName, fmOpenRead);
  try
    Create(LStream);
  finally
    LStream.Free;
  end;
end;

//Load an stream with the Vcl Style Data
constructor TCustomStyleExt.Create(const Stream: TStream);
begin
  inherited Create;
  FStream:=TMemoryStream.Create;

  Stream.Seek(0, soBeginning); //set position to 0 before to copy
  FStream.CopyFrom(Stream, Stream.Size); //copy the content in a local stream
  Stream.Seek(0, soBeginning); //very importan restore the index to 0.

  FStream.Seek(0, soBeginning);//set position to 0 before to load
  TseStyle(Source).LoadFromStream(FStream);//makes the magic, fill the 
end;

//free the resources
destructor TCustomStyleExt.Destroy;
begin
  if Assigned(FStream) then
    FStream.Free;
  inherited Destroy;
end;

//Get misc info about the Vcl Style
function TCustomStyleExt.GetStyleInfo: TStyleInfo;
begin
 Result.Name        :=  TseStyle(Source).StyleSource.Name;
 Result.Author      :=  TseStyle(Source).StyleSource.Author;
 Result.AuthorEMail :=  TseStyle(Source).StyleSource.AuthorEMail;
 Result.AuthorURL   :=  TseStyle(Source).StyleSource.AuthorURL;
 Result.Version     :=  TseStyle(Source).StyleSource.Version;
end;

Creating the preview

Finally now we can create a image that represent the VCL Style.

Check out the code to create a simple image of a form using a TCustomStyle.

//draws a form (window) over a Canvas using a TCustomStyle
procedure DrawSampleWindow(Style:TCustomStyle;Canvas:TCanvas;ARect:TRect;const ACaption : string);
var
  LDetails        : TThemedElementDetails;
  CaptionDetails  : TThemedElementDetails;
  IconDetails     : TThemedElementDetails;
  IconRect        : TRect;
  BorderRect      : TRect;
  CaptionRect     : TRect;
  ButtonRect      : TRect;
  TextRect        : TRect;
  CaptionBitmap   : TBitmap;

    function GetBorderSize: TRect;
    var
      Size: TSize;
      Details: TThemedElementDetails;
      Detail: TThemedWindow;
    begin
      Result  := Rect(0, 0, 0, 0);
      Detail  := twCaptionActive;
      Details := Style.GetElementDetails(Detail);
      Style.GetElementSize(0, Details, esActual, Size);
      Result.Top := Size.cy;
      Detail := twFrameLeftActive;
      Details := Style.GetElementDetails(Detail);
      Style.GetElementSize(0, Details, esActual, Size);
      Result.Left := Size.cx;
      Detail := twFrameRightActive;
      Details := Style.GetElementDetails(Detail);
      Style.GetElementSize(0, Details, esActual, Size);
      Result.Right := Size.cx;
      Detail := twFrameBottomActive;
      Details := Style.GetElementDetails(Detail);
      Style.GetElementSize(0, Details, esActual, Size);
      Result.Bottom := Size.cy;
    end;

    function RectVCenter(var R: TRect; Bounds: TRect): TRect;
    begin
      OffsetRect(R, -R.Left, -R.Top);
      OffsetRect(R, 0, (Bounds.Height - R.Height) div 2);
      OffsetRect(R, Bounds.Left, Bounds.Top);
      Result := R;
    end;

begin
  BorderRect := GetBorderSize;

  CaptionBitmap := TBitmap.Create;
  CaptionBitmap.SetSize(ARect.Width, BorderRect.Top);

  //Draw background
  LDetails.Element := teWindow;
  LDetails.Part := 0;
  Style.DrawElement(Canvas.Handle, LDetails, ARect);

  //Draw caption border
  CaptionRect := Rect(0, 0, CaptionBitmap.Width, CaptionBitmap.Height);
  LDetails := Style.GetElementDetails(twCaptionActive);
  Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, CaptionRect);
  TextRect := CaptionRect;
  CaptionDetails := LDetails;

  //Draw icon
  IconDetails := Style.GetElementDetails(twSysButtonNormal);
  if not Style.GetElementContentRect(0, IconDetails, CaptionRect, ButtonRect) then
    ButtonRect := Rect(0, 0, 0, 0);
  IconRect := Rect(0, 0, GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON));
  RectVCenter(IconRect, ButtonRect);
  if ButtonRect.Width > 0 then
   if Assigned(Application.MainForm) then
    DrawIconEx(CaptionBitmap.Canvas.Handle, IconRect.Left, IconRect.Top, Application.MainForm.Icon.Handle, 0, 0, 0, 0, DI_NORMAL);

  Inc(TextRect.Left, ButtonRect.Width + 5);

  //Draw buttons

  //Close button
  LDetails := Style.GetElementDetails(twCloseButtonNormal);
  if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then
   Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect);

  //Maximize button
  LDetails := Style.GetElementDetails(twMaxButtonNormal);
  if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then
    Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect);

  //Minimize button
  LDetails := Style.GetElementDetails(twMinButtonNormal);

  if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then
    Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect);

  //Help button
  LDetails := Style.GetElementDetails(twHelpButtonNormal);
  if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then
    Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect);

  if ButtonRect.Left > 0 then
    TextRect.Right := ButtonRect.Left;

  //Draw text
  Style.DrawText(CaptionBitmap.Canvas.Handle, CaptionDetails, ACaption, TextRect, [tfLeft, tfSingleLine, tfVerticalCenter]);

  //Draw caption
  Canvas.Draw(0, 0, CaptionBitmap);
  CaptionBitmap.Free;

  //Draw left border
  CaptionRect := Rect(0, BorderRect.Top, BorderRect.Left, ARect.Height - BorderRect.Bottom);
  LDetails := Style.GetElementDetails(twFrameLeftActive);
  if CaptionRect.Bottom - CaptionRect.Top > 0 then
    Style.DrawElement(Canvas.Handle, LDetails, CaptionRect);

  //Draw right border
  CaptionRect := Rect(ARect.Width - BorderRect.Right, BorderRect.Top, ARect.Width, ARect.Height - BorderRect.Bottom);
  LDetails := Style.GetElementDetails(twFrameRightActive);
  Style.DrawElement(Canvas.Handle, LDetails, CaptionRect);

  //Draw Bottom border
  CaptionRect := Rect(0, ARect.Height - BorderRect.Bottom, ARect.Width, ARect.Height);
  LDetails := Style.GetElementDetails(twFrameBottomActive);
  Style.DrawElement(Canvas.Handle, LDetails, CaptionRect);
end;

Finally joining all the pieces we can access the objects, bitmaps, colors and fonts of any VCl style, no matter where is located (embedded in a resource or in a external file).

The library and the demo application of the above image is available in the code google site.

Stay tuned for more updates of this library, the next updates will be include HSL, RGB effects to VCL Styles, vcl style explorer and so on.