In the past days I’ve added many new features and a lot of improvements in the Vcl Style Utils project. You can see the updated site here and a new video showing the Vcl Style Utils library in action, also the repository contains a set of demo projects to check how use the library.
Check this video of an Demo app which was built using the Vcl Style Utils.
You can download the demo app VCL Styles Equalizer from here.
I just uploaded a video showing how you can change the HSL values of any VCL Style in runtime using the vcl styles utils library. in the code google site you can found the the full source code of the application and more demo projects.
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 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).
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;
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;
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).
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.
Starting with Windows Vista , Microsoft introduces the The Software Licensing API (SLAPI), this API can be used to determine a genuine Microsoft Windows installation.
So using the SLIsGenuineLocal function you can check if your app is running in a genuine Windows installation.
This is the definition of the function
HRESULT WINAPI SLIsGenuineLocal( __in const SLID *pAppId, __out SL_GENUINE_STATE *pGenuineState, __inout_opt SL_NONGENUINE_UI_OPTIONS *pUIOptions );
The use of this funtion is very easy, only you must pass the GUID (Application Id) of Windows {55c92734-d682-4d71-983e-d6ec3f16059f} and a variable of type SL_GENUINE_STATE to receive the status of the license.
Check this delphi implementation
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils;
type
SLID = TGUID;
_SL_GENUINE_STATE = (
SL_GEN_STATE_IS_GENUINE = 0,
SL_GEN_STATE_INVALID_LICENSE = 1,
SL_GEN_STATE_TAMPERED = 2,
SL_GEN_STATE_LAST = 3
);
SL_GENUINE_STATE = _SL_GENUINE_STATE;
function SLIsGenuineLocal(var pAppId: SLID; var pGenuineState: SL_GENUINE_STATE; pUIOptions: Pointer): HRESULT; stdcall; external 'Slwga.dll' name 'SLIsGenuineLocal' delayed;
Var
pAppId : SLID;
pGenuineState: SL_GENUINE_STATE;
Status: HRESULT;
begin
try
if Win32MajorVersion>= 6 then //Windows Vista o newer
begin
pAppId:=StringToGUID('{55C92734-D682-4D71-983E-D6EC3F16059F}');
Status:=SLIsGenuineLocal(pAppId, pGenuineState,nil);
if Succeeded(Status) then
case pGenuineState of
SL_GEN_STATE_IS_GENUINE : Writeln('The installation is genuine.');
SL_GEN_STATE_INVALID_LICENSE : Writeln('The application does not have a valid license.');
SL_GEN_STATE_TAMPERED : Writeln('The Tampered flag of the license associated with the application is set.');
SL_GEN_STATE_LAST : Writeln('The state of the installation has not changed since the last time it was checked.');
end
else
Writeln(SysErrorMessage(Cardinal(Status)));
end
else
Writeln('OS not supported');
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
In windows XP does not exist the SLAPI, but you can use the Win32_WindowsProductActivation WMI class to get simmilar information. the key is check the ActivationRequired property, If return 1 then the system activation is pending for the system. else If returns 0 (zero) the activation is not required.
{$APPTYPE CONSOLE}
uses
SysUtils,
ActiveX,
ComObj,
Variants;
procedure GetWin32_WindowsProductActivationInfo;
const
WbemUser ='';
WbemPassword ='';
WbemComputer ='localhost';
wbemFlagForwardOnly = $00000020;
var
FSWbemLocator : OLEVariant;
FWMIService : OLEVariant;
FWbemObjectSet: OLEVariant;
FWbemObject : OLEVariant;
oEnum : IEnumvariant;
iValue : LongWord;
begin;
if (Win32MajorVersion=5) and (Win32MinorVersion=1) then
begin
NullStrictConvert :=False;
FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
FWMIService := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_WindowsProductActivation','WQL',wbemFlagForwardOnly);
oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
while oEnum.Next(1, FWbemObject, iValue) = 0 do
begin
Writeln(Format('Windows is Activated %s',[BooltoStr(FWbemObject.ActivationRequired=0,True)]));
Writeln(Format('ActivationRequired %d',[Integer(FWbemObject.ActivationRequired)]));
Writeln(Format('Description %s',[String(FWbemObject.Description)]));
Writeln(Format('ProductID %s',[String(FWbemObject.ProductID)]));
if FWbemObject.ActivationRequired=1 then
begin
Writeln(Format('RemainingEvaluationPeriod %d',[Integer(FWbemObject.RemainingEvaluationPeriod)]));
Writeln(Format('RemainingGracePeriod %d',[Integer(FWbemObject.RemainingGracePeriod)]));
end;
Writeln(Format('ServerName %s',[String(FWbemObject.ServerName)]));
Writeln(Format('SettingID %s',[String(FWbemObject.SettingID)]));
Writeln;
FWbemObject:=Unassigned;
end;
end
else
Writeln('OS not supported');
end;
begin
try
CoInitialize(nil);
try
GetWin32_WindowsProductActivationInfo;
finally
CoUninitialize;
end;
except
on E:EOleException do
Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
