Delphi VCL styles tutorial - how to change the style at runtime
I'm adding an answer because local information is often preferred to just links.
Here's the key facts you need to know before you start:
Many VCL controls have color properties, but those properties are going to get ignored when styles are on, and the default "common controls" like Button are going to get drawn by Delphi itself, instead of using the XP or Windows 2000 style that "comes with windows".
Somehow, deep within your application, VCL styles puts hooks in that take over painting your controls. Everything that it can handle, will be drawn using a "skin" on top of the regular controls. Many people call this "skinning the vcl", and prior to VCL styles, you might have found a third party skin system. Now it's built in.
Anything that is not hooked, will still get the regular style. So most third party controls, and some bits of the VCL will not be themed. Don't expect perfect instant results. Also, you might sometimes see some momentary flicker or glitches as a result of skinning, that's to be expected. Add loading of styles at runtime, and the end-quality of your result is anybody's guess. You can't necessarily guarantee that the style which is loaded at runtime, will contain everything you might want it to contain. Nor can you guarantee that with one you statically include in your app, but at least the ones you statically include could be verified by your QA team (which might be you).
And here's the simplest steps to get started: Really only step #2 through #4 are essential.
Click File -> New -> VCL Forms project.
Right click on the project options in the Project manager pane, and click properties. Navigate to Application -> Appearance
Click on a custom style to turn it on. (Amakrits is the first in my list, so I'll click that).
Click on the Default Style combobox and change it to something other than default.
Put something on your form so it's not empty. (A button, a listbox, etc).
Run your app.
Now, advanced stuff: Change your style at runtime:
I use this button click and formcreate to do that:
Add fdefaultStyleName:String; to private section of your form.
Make sure Vcl.Themes is in your uses clause.
procedure TForm1.Button1Click(Sender: TObject);
begin
if Assigned(TStyleManager.ActiveStyle) and (TStyleManager.ActiveStyle.Name<>'Windows') then begin
TStyleManager.TrySetStyle('Windows');
end else begin
TStyleManager.TrySetStyle(fdefaultStyleName); // whatever was in the project settings.
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if Assigned(TStyleManager.ActiveStyle) then
fdefaultStyleName := TStyleManager.ActiveStyle.Name;
end;
A example (public procedure). Remember uses Vcl.Themes;
procedure TData.AllowSKIN( bSKIN:boolean );
var
sSKIN:string;
begin
sSKIN := 'Aqua Light Slate';
if not bSKIN then sSKIN := 'Windows';
TStyleManager.TrySetStyle( sSKIN );
end;
I have a (template) form that I call in my application to let user set skins. Simply ShowSkinForm to show the form. Also you can call LoadLastSkin during application initialization to have the last skin automatically applied.
UNIT FormSkinsDisk;
{-----------------
2017.02.23
Universal skin loader. Loads skins from disk (vsf file)
To use it:
Application.ShowMainForm:= FALSE;
MainForm.Visible:= FALSE; // Necessary so the form won't flicker during skin loading at startup
LoadLastSkin (during application initialization)
MainForm.Show;
Skins should be present in the 'System\skins' folder
Skins folder:
c:\Users\Public\Documents\Embarcadero\Studio\15.0\Styles\
KNOWN BUG:
TStyleManager.IsValidStyle always fails if Vcl.Styles is not in the USES list!! http://stackoverflow.com/questions/30328644/how-to-check-if-a-style-file-is-already-loaded
-------------------------------------------------------------------------------------------------------------}
INTERFACE {$WARN GARBAGE OFF} {Silence the: 'W1011 Text after final END' warning }
USES
System.SysUtils, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls, System.Classes, System.Types;
TYPE
TfrmSkinsDisk = class(TForm)
lBox: TListBox;
procedure FormCreate (Sender: TObject);
procedure FormDestroy (Sender: TObject);
procedure lBoxClick (Sender: TObject);
procedure FormClose (Sender: TObject; var Action: TCloseAction);
procedure lblTopClick (Sender: TObject);
private
procedure FillLstBox;
public
end;
procedure LoadLastSkin(CONST DefaultSkin: string= ''); { On first run, set the DefaultSkin to an existing file (no path) like: 'Graphite Green.vsf'. Leave it empty if you want the default Windows theme to load }
procedure ShowSkinForm;
IMPLEMENTATION {$R *.dfm}
USES
IOUtils, Vcl.Styles, cIO, vcl.Themes, cINIFile, cINIFileEx, CubicTPU; {VCL.Styles is mandatory here}
VAR
SkinFile: string; { Disk short file name (not full path) for the current loaded skin }
CONST
DefWinTheme= 'Windows default theme';
{-----------------------------------------------------------------------------------------
UTILS
-----------------------------------------------------------------------------------------}
function GetSkinDir: string;
begin
Result:= GetAppSysDir+ 'skins\';
end;
function LoadSkinFromFile(CONST DiskShortName: string): Boolean;
VAR Style : TStyleInfo;
begin
Result:= FileExists(GetSkinDir+ DiskShortName);
if Result then
if TStyleManager.IsValidStyle(GetSkinDir+ DiskShortName, Style)
then
if NOT TStyleManager.TrySetStyle(Style.Name, FALSE)
then
begin
TStyleManager.LoadFromFile(GetSkinDir+ DiskShortName);
TStyleManager.SetStyle(Style.Name);
end
else Result:= FALSE
else
MesajError('Style is not valid: '+ GetSkinDir+ DiskShortName);
end;
procedure LoadLastSkin(CONST DefaultSkin: string= '');
begin
SkinFile:= cINIFile.ReadString('LastDiskSkin', DefaultSkin); { This is a relative path so the skin can still be loaded when the application is moved to a different folder }
if SkinFile = ''
then SkinFile:= DefaultSkin;
if (SkinFile > '')
AND (SkinFile <> DefWinTheme) { DefWinTheme represents the default Windows theme/skin. In other words don't load any skin file. Let Win skin the app }
then LoadSkinFromFile(SkinFile);
end;
procedure ShowSkinForm;
VAR
frmSkins: TfrmSkinsDisk;
begin
frmSkins:= TfrmSkinsDisk.Create(NIL);
frmSkins.ShowModal;
FreeAndNil(frmSkins);
end;
{----------------------------------------------------------------------------------------
CREATE
-----------------------------------------------------------------------------------------}
procedure TfrmSkinsDisk.FormCreate(Sender: TObject);
begin
LoadForm(Self);
FillLstBox; { Populate skins }
end;
procedure TfrmSkinsDisk.FormDestroy(Sender: TObject);
begin
SaveForm(Self);
cINIFile.WriteString ('LastDiskSkin', SkinFile);
end;
procedure TfrmSkinsDisk.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:= caFree;
end;
{-----------------------------------------------------------------------------------------------------------------------
Populate skins
-----------------------------------------------------------------------------------------------------------------------}
procedure TfrmSkinsDisk.lblTopClick(Sender: TObject);
begin
FillLstBox;
end;
procedure TfrmSkinsDisk.FillLstBox; { Populate skins }
VAR
s, FullFileName: string;
begin
lBox.Items.Clear;
lBox.Items.Add(DefWinTheme); { This corresponds to Windows' default theme }
lblTop.Hint:= GetSkinDir;
if NOT DirectoryExists(GetSkinDir) then
begin
lblTop.Caption:= 'The skin directory could not be located! '+ GetSkinDir+ CRLF+ 'Add skins then click here to refresh the list.';
lblTop.Color:= clRedBright;
lblTop.Transparent:= FALSE;
EXIT;
end;
{ Display all *.vsf files }
for FullFileName in TDirectory.GetFiles(GetSkinDir, '*.vsf') DO
begin
s:= ExtractFileName(FullFileName);
lBox.Items.Add(s);
end;
end;
procedure TfrmSkinsDisk.lBoxClick(Sender: TObject);
begin
if lBox.ItemIndex < 0 then EXIT;
SkinFile:= lBox.Items[lBox.ItemIndex];
if SkinFile= DefWinTheme then
begin
TStyleManager.SetStyle('Windows');
SkinFile:= DefWinTheme;
end
else
if LoadSkinFromFile(SkinFile) then
begin
{ Bug fix } { fix for this bug: http://stackoverflow.com/questions/30328924/form-losses-modal-attribute-after-changing-app-style }
Application.ProcessMessages;
BringToFront;
end;
end;
end.
A word of warning: under current version (Sydney/10.4.2) skins are still terribly bugged. Using caFree on a skinned child form, might close your entire application.