Is there a good VCL Styles tutorial where we see how to dynamically (in run time) load/change the style ?
This should work with Delphi XE2 and up, since XE2 is the first version with VCL Styles.
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.
Related
I'm trying to write a plugin for Delphi 5 that will store the paths to our testing exes in the DOF so that there is a direct association between the project and the tests for that project. When I go to add my own module to the DOF file, something like
[DUint Plugin]
IntegrationTestExe=Somepath
UnitTestExeList=Some;Path;
Anytime I go to add this either manually or through code, when I save the project, the lines I add are removed. I chalked this up to maybe the IDE just doesn't allow custom modules in the DOF.
However, we use a third party plugin called EurekaLog. EurekaLog injects its own vars into the DOF and when you save, those vars are not removed. I copied much of the code over so I could test if the EurekaLog code would work properly (through some magic) but their code just wrote their module to the DOF and did nothing else special.
Does anyone know how this is accomplished in EurekaLog? Do I need to register my module somewhere so that the IDE knows not to remove it?
Update After a bit of experimenting, it seems that saving settings to the DOF is actually noticeably more reliable than saving them to the DSK file.
Add another TEdit to the form and create LoadDOFSettings and SaveDOFSettings
analogous to the existing LoadSettings and SaveSettings and call them on receipt
of the DesktopLoad and DesktoSave notifications. The SaveDOFSettings doesn't need to be called via the Timer1 event because the renaming doesn't seem to happen to the DOF.
Original answer
I suggest that before reading this answer, you do a File | Close All in the IDE,
create a new package, add the unit below into it and install it in the IDE.
The purpose of the package is two-fold, firstly to show how to save custom settings in the DSK file and secondly to give you an idea of what event information about project
files you can get from the IDE via the services in the ToolsAPI unit..
Once you've installed the package, keep an eye on its form, which shows you file notifications in the upper memo as you open, work on and close a project. There are
several things to notice:
When you open a project, the last notification you receive is about its DSK file having been opened.
Not every file type is the subject of a notification. In particular, you don't receive any notifications specifically about the DOF file, so if you want to write to it and later read from it, you have to make assumptions about when it's safe (or not) to do so, and this is possibly why you have run into the problem you are asking about.
When you do a Close All on the project, the last file change you get notified about is the DSK being written. The catch is that it's initially written to a file of the same name but with the extension .$$$. Very soon afterwards, but asaics you can't tell exactly when, this .$$$ file is renamed to .DSK.
The form created by the code below has an edit box, edMyValue' which can be used to set a value in a section of the DSK file calledMySettingsand which is reloaded the next time the project is opened. The writing of theMySettings` section of the DSK file is triggered aby a TTimer with a 2-second delay to give the IDE time to write and rename the DSK file as I've described. This obviously provides the opportunity for a race condition.
You might like to refer to
http://www.gexperts.org/open-tools-api-faq/#dsk
(GExperts is the IDE add-in tool that's been around since very early days of Delphi)
The section of the article is talking about the current project's .DSK file. Like the DOF, this is in INI file format, with sections like
[Closed Files]
[Modules]
[EditWindow0]
[View0]
As you'll see it says
check for the ofnProjectDesktopLoad and ofnProjectDesktopSave NotifyCode values. When you see one of those, you can save/load values from the file indicated by the FileName parameter using a class such as TIniFile.
Perhaps it's a bit trickier than the article suggests, because of the renaming business.
Have fun!
unit IDEEventsu;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ToolsAPI, Grids, IniFiles;
type
TFileEventsForm = class(TForm)
Panel1: TPanel;
Memo1: TMemo;
edMyValue: TEdit;
btnClear: TButton;
Timer1: TTimer;
Memo2: TMemo;
procedure btnClearClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
function GetCurrentProject: IOTAProject;
public
// The following are using interfaces accessible via the ToolsAPI
Services: IOTAServices;
ProjectGroup : IOTAProjectGroup;
Project: IOTAProject;
Options : IOTAProjectOptions;
ModServices: IOTAModuleServices;
Module: IOTAModule;
NotifierIndex: Integer; // This is used to disconnect our notifier from the IDE
IsSetUp : Boolean;
SetUpCount : Integer;
DskFileName : String;
procedure SetUp;
procedure SaveSettings;
procedure LoadSettings;
end;
var
FileEventsForm: TFileEventsForm;
procedure Register;
[...]
uses
typinfo;
type
TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier)
// This is the class we use to receive file notication events from the IDE via the
// interfaces in ToolsAPI.Pas
//
// It needs to implement the IOTANotifier and IOTAIDENotifier interfaces and,
// once registered with the IDE, the IDE calls its methods as a kind of call-back
// mechanism so that it gets notified of file events
//
// Note that this file also provides a form for displaying the received event
// notifications and that the IOTANotifier and IOTAIDENotifier interfaces could
// just as easily be implemented by the form itself
protected
procedure AfterCompile(Succeeded: Boolean);
procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
procedure FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
end;
procedure Register;
// This is necessary to register the package in the IDE
var
Notifier : TIdeNotifier;
begin
FileEventsForm:= TFileEventsForm.Create(Nil);
FileEventsForm.Services := BorlandIDEServices as IOTAServices;
Notifier := TIdeNotifier.Create;
Notifier.Form := FileEventsForm;
FileEventsForm.NotifierIndex := FileEventsForm.Services.AddNotifier(TIdeNotifier.Create);
end;
procedure CloseDown;
begin
FileEventsForm.Services.RemoveNotifier(FileEventsForm.NotifierIndex);
FileEventsForm.Close;
FileEventsForm.Free;
end;
function NotifyCodeString(NotifyCode : TOTAFileNotification) : String;
begin
Result := Copy(GetEnumName(TypeInfo(TOTAFileNotification), Ord(NotifyCode)), 4, MaxInt);
end;
procedure TIdeNotifier.AfterCompile(Succeeded: Boolean);
begin
end;
procedure TIdeNotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
begin
end;
procedure TIdeNotifier.FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
begin
if True {NotifyCode in [ofnProjectDesktopLoad, ofnActiveProjectChanged]} then begin
FileEventsForm.Show;
FileEventsForm.Memo1.Lines.Add(Format('%s file: %s', [NotifyCodeString(NotifyCode), FileName]));
case NotifyCode of
ofnProjectDesktopLoad,
ofnDefaultDesktopLoad : begin
FileEventsForm.DskFileName := FileName;
FileEventsForm.LoadSettings;
end;
ofnProjectDesktopSave,
ofnDefaultDesktopSave : begin
if True{CompareText(ExtractFileExt(FileName), '.DSK') = 0} then begin
FileEventsForm.Caption := FileName;
FileEventsForm.Timer1.Enabled := True; // causes DSK file to be updated after Timer1.Interval (=2000ms)
end;
end;
end; { case }
end;
end;
procedure TFileEventsForm.btnClearClick(Sender: TObject);
begin
Memo1.Lines.Clear;
end;
function TFileEventsForm.GetCurrentProject: IOTAProject;
var
i: Integer;
begin
Result := nil;
ModServices := BorlandIDEServices as IOTAModuleServices;
for i := 0 to ModServices.ModuleCount - 1 do
begin
Module := ModServices.Modules[i];
if Supports(Module, IOTAProjectGroup, ProjectGroup) then begin
Result := ProjectGroup.ActiveProject;
Options := Result.ProjectOptions;
Exit;
end
else if Supports(Module, IOTAProject, Project) then
begin // In the case of unbound packages, return the 1st
if Result = nil then begin
Result := Project;
Options := Result.ProjectOptions;
end;
end;
end;
end;
procedure TFileEventsForm.SetUp;
begin
Project := GetCurrentProject;
Inc(SetUpCount);
Caption := 'Setup done ' + IntToStr(SetUpCount);
IsSetUp := True;
end;
procedure TFileEventsForm.LoadSettings;
var
Ini : TMemIniFile;
S : String;
begin
Ini := TMemIniFile.Create(DSKFileName);
try
S := Ini.ReadString('MySettings', 'Name', 'no value');
edMyValue.Text := S;
finally
Ini.Free;
end;
end;
procedure TFileEventsForm.SaveSettings;
var
Ini : TMemIniFile;
S : String;
begin
S := DSKFileName;
Caption := 'Saving: ' + S;
Ini := TMemIniFile.Create(S);
try
Ini.WriteString('MySettings', 'Name', edMyValue.Text);
Ini.UpdateFile;
Ini.ReadSections(Memo2.Lines);
Memo2.Lines.Add('This file : ' + DSKFileName);
edMyValue.Text := '?';
finally
Ini.Free;
end;
end;
procedure TFileEventsForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
SaveSettings;
end;
initialization
finalization
CloseDown;
end.
I have developed an android app that will run in some Asus Android 7 tablets in a firm but I find a very weird behavior. This application is very small and easy; it has:
A button to store 2 string values taken from 2 edits
A TTabControl with 3 pages and each of them has a TWebBrowser inside.
A button on the top to execute some javascript code.
You can see a picture here taken from win32. Below there is the code which is pretty easy and (I guess) without errors. I am under firemonkey of course.
type
TForm1 = class(TForm)
// ... declarations ...
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
FLinea: string;
list: TStringList;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
//I take the text from the 3 edits you can see above (picture) and I save a txt file
procedure TForm1.Button1Click(Sender: TObject);
var salva: TStringList;
begin
/*just for debug purpose...*/
if ( (Length(EditLinea.Text) > 0) and (Length(EditOperatore.Text) > 0) and (Password.Text = 'abc123') ) then
begin
FLinea := TPath.Combine(TPath.GetHomePath, 'operatore.txt');
salva := TStringList.Create;
salva.Add(EditLinea.Text);
salva.Add(EditOperatore.Text);
salva.SaveToFile(FLinea);
ShowMessage('Saved! Restart the app.');
end
else
begin
ShowMessage('Wrong password!');
end;
end;
//when I press the STOP button above I execute a javascript function that is defined in the page loaded in the browser
procedure TForm1.Button2Click(Sender: TObject);
begin
WebBrowser.EvaluateJavaScript('stopExec();');
end;
//Here I just check if a txt file exists and I load it
procedure TForm1.FormCreate(Sender: TObject);
begin
//HERE I CHECK IF THERE IS A TXT FILE THAT I NEED TO LOAD
FLinea := TPath.Combine(TPath.GetHomePath, 'operatore.txt');
if (FileExists(FLinea)) then
begin
list := TStringList.Create;
list.LoadFromFile(FLinea);
LabelImpiegato.Text := 'OPERATORE '+list.Strings[1];
WebBrowser.URL := 'www.aaa.com/loader.php?linea='+list.Strings[0]+'&operat='+list.Strings[1];
WebBrowser.EnableCaching := false;
WebBrowser.Navigate;
end
else
begin
//error
TabControl.Visible := false;
Error.Visible := true;
end;
end;
Problem: the application works correctly but after some time (in general 10/15 min) it crashes. The error message is "The application has suddenly stopped". Could it be something wrong with my code?
I really doubt that it might be a power-saving configuration on the tablet. I really don't know what to do because I was looking for something like a form OnException property but no luck.
Could it be the javascript code that clashes with TWebBrowser? Look:
function start() {
myVar = setInterval(myTimer, 1000);
myVar2 = setInterval(orologio, 1000);
}
Basically that is a function that is called when the page opens (body onload) and the setInterval is like the delphi TTimer. With a period of 1000ms it executes the function on 1st argument. It works perfectly on Firefox and as Win32 app.
I have solved my problem, this is an issue that is not related to Delphi (or javascript). The application crashes due to an update of Google's Webview service that is causing problems on applications like the one I have (applications with a web browser inside).
I have uninstalled the updates on Google's webview and now the application works properly. Of course Delphi's TWebBrowser relies on the webview service and so uninstalling the update was the solution.
The default font of the object inspector is ridiculously small, esp on a high resolution screen.
Is there a way to make it bigger?
Yes there is and it's really easy.
You can alter any window in the IDE by creating a package and installing this in the IDE.
Because the bpl gets loaded into the main process of the Delphi IDE you can alter any IDE window's properties from there.
Code by Mike Fletcher
Create a new package and add the following unit:
unit AdjustOIFont;
interface
uses Vcl.Forms, Vcl.Controls, Vcl.Dialogs, Vcl.StdCtrls;
procedure Register;
implementation
function GetOIForm: TForm;
var
i: Integer;
begin
Result:= nil;
for i:= 0 to Screen.FormCount - 1 do begin
if Screen.Forms[i].Name = 'PropertyInspector' then begin
Result:= Screen.Forms[I];
Exit;
end;
end;
end;
function GetChildControl(AParent: TWinControl; AName: string): TWinControl;
var
i: Integer;
begin
Result:= nil;
for i:= 0 to AParent.ControlCount - 1 do begin
if AParent.Controls[i].Name = AName then begin
Result:= TWinControl(AParent.Controls[i]);
Exit;
end;
end;
end;
function GetOIControl: TCustomListBox;
var
OIForm: TForm;
begin
OIForm:= GetOIForm;
Result:= TCustomListBox(GetChildControl(GetChildControl(OIForm, 'Panel3'), 'PropList'));
end;
procedure Register;
var
OI: TListBox;
OIForm: TForm;
begin
OIForm:= GetOIForm;
OIForm.Font.Size:= 10;
OI:= TListBox(GetOIControl);
OI.Font.Size:= 10;
OI.ItemHeight:= 20;
end;
end.
Build the package and install.
The change will take effect immediately.
Knowing this trick it's also be easy to collect all the enumerated names in a stringlist and copy them to the clipboard.
These names can than be used to expand the code and fix the fonts of other IDE elements as well (e.g. the Structure pane).
Much better.
Works on Seattle and XE7.
One way to achieving this is by modifying registry like it is described in Malcolm Groves article here: http://www.malcolmgroves.com/blog/?p=1804
Another option is to use Delphi IDE Colorizer which is a third party application designed to greatly change appearance of Delphi IDE by changing fonts, colors, etc. You can find it here: https://github.com/RRUZ/Delphi-IDE-Colorizer
And if you perhaps also want to change syntax fonts and syntax highlighting you can also check Delphi IDE Theme Editor which is designed to change the appearance of code highlighting based on your desires. You can find it here: https://github.com/RRUZ/delphi-ide-theme-editor
Is there a good VCL Styles tutorial where we see how to dynamically (in run time) load/change the style ?
This should work with Delphi XE2 and up, since XE2 is the first version with VCL Styles.
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.
What can I do that shortcuts for menu items don't overwrite those from local controls?
Imagine this simple app in the screenshot. It has one "undo" menu item with the shortcut CTRL+Z (Strg+Z in German) assigned to it. When I edit some text in the memo and press CTRL+Z I assume that the last input in the memo is reverted, but instead the menu item is executed.
This is especially bad in this fictional application because the undo function will now delete my last added "Item 3" which properties I was editing.
CTRL+Z is just an example. Other popular shortcuts cause similar problems (Copy&Paste: CTRL+X/C/V, Select all: CTRL+A).
Mini Demo with menu item with CTRL+Z short-cut http://img31.imageshack.us/img31/9074/ctrlzproblem.png
The VCL is designed to give menu item shortcuts precedence. You can, however, write your item click handler (or action execute handler) to do some special handling when ActiveControl is TCustomEdit (call Undo, etc.)
Edit: I understand you don't like handling all possible special cases in many places in your code (all menu item or action handlers). I'm afraid I can't give you a completely satisfactory answer but perhaps this will help you find a bit more generic solution. Try the following OnShortCut event handler on your form:
procedure TMyForm.FormShortCut(var Msg: TWMKey; var Handled: Boolean);
var
Message: TMessage absolute Msg;
Shift: TShiftState;
begin
Handled := False;
if ActiveControl is TCustomEdit then
begin
Shift := KeyDataToShiftState(Msg.KeyData);
// add more cases if needed
Handled := (Shift = [ssCtrl]) and (Msg.CharCode in [Ord('C'), Ord('X'), Ord('V'), Ord('Z')]);
if Handled then
TCustomEdit(ActiveControl).DefaultHandler(Message);
end
else if ActiveControl is ... then ... // add more cases as needed
end;
You could also override IsShortCut method in a similar way and derive your project's forms from this new TCustomForm descendant.
You probably need an alike solution as below. Yes, feels cumbersome but this is the easiest way I could think of at the time. If only Delphi allowed duck-typing!
{ you need to derive a class supporting this interface
for every distinct control type your UI contains }
IEditOperations = interface(IInterface)
['{C5342AAA-6D62-4654-BF73-B767267CB583}']
function CanCut: boolean;
function CanCopy: boolean;
function CanPaste: boolean;
function CanDelete: boolean;
function CanUndo: boolean;
function CanRedo: boolean;
function CanSelectAll: Boolean;
procedure CutToClipBoard;
procedure Paste;
procedure CopyToClipboard;
procedure Delete;
procedure Undo;
procedure Redo;
procedure SelectAll;
end;
// actions....
procedure TMainDataModule.actEditCutUpdate(Sender: TObject);
var intf: IEditOperations;
begin
if Supports(Screen.ActiveControl, IEditOperations, intf) then
(Sender as TAction).Enabled := intf.CanCut
else
(Sender as TAction).Enabled := False;
end;
procedure TMainDataModule.actEditCutExecute(Sender: TObject);
var intf: IEditOperations;
begin
if Supports(Screen.ActiveControl, IEditOperations, intf) then
intf.CutToClipBoard;
end;
....