delphi - Delphi VCL 样式教程 - 如何在运行时更改样式

Question

是否有一个很好的 VCL 样式教程，我们可以在其中看到如何动态（在运行时）加载/更改样式？

这应该适用于 Delphi XE2 及更高版本，因为 XE2 是第一个带有 VCL 样式的版本。

Answer 1

我正在添加一个答案，因为本地信息通常比链接更受欢迎。

在开始之前，您需要了解以下关键事实：

1. 许多 VCL 控件具有颜色属性，但是当样式打开时，这些属性将被忽略，并且默认的“通用控件”（如 Button）将由 Delphi 自己绘制，而不是使用“自带的 XP 或 Windows 2000 样式”带窗户”。

2. 不知何故，在您的应用程序的深处，VCL 样式将钩子放入，以接管绘制您的控件。它可以处理的所有内容都将使用常规控件顶部的“皮肤”绘制。很多人称其为“为 vcl 蒙皮”，在 VCL 样式之前，您可能已经找到了第三方皮肤系统。现在它已经内置了。

3. 任何没有上钩的东西，仍然会得到常规的样式。所以大多数第三方控件，以及 VCL 的某些部分不会被主题化。不要指望完美的即时结果。此外，由于蒙皮，您有时可能会看到一些瞬时闪烁或故障，这是意料之中的。在运行时添加样式加载，结果的最终质量是任何人的猜测。您不一定能保证在运行时加载的样式将包含您可能希望它包含的所有内容。您也不能保证在您的应用程序中静态包含一个，但至少您的静态包含的那些可以由您的 QA 团队（可能是您）验证。

以下是最简单的入门步骤：实际上只有第 2 步到第 4 步是必不可少的。

1. 单击文件 -> 新建 -> VCL Forms 项目。

2. 右键单击项目管理器窗格中的项目选项，然后单击属性。导航到应用程序 -> 外观

3. 单击自定义样式将其打开。（Amakrits 是我列表中的第一个，所以我会点击它）。

4. 单击默认样式组合框并将其更改为非默认样式。

5. 在你的表格上放一些东西，这样它就不会是空的。（按钮、列表框等）。

6. 运行您的应用程序。

现在，高级的东西：在运行时改变你的风格：

我使用此按钮单击和 formcreate 来执行此操作：

添加fdefaultStyleName:String;到表单的私人部分。

确保Vcl.Themes在您的使用条款中。

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;

Answer 2

一个例子（公共程序）。记住使用 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;

Answer 3

我有一个（模板）表单，我在我的应用程序中调用它来让用户设置皮肤。只需 ShowSkinForm 即可显示表格。您还可以在应用程序初始化期间调用 LoadLastSkin 以自动应用最后一个皮肤。

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.

一个警告：在当前版本 (Sydney/10.4.2) 下，皮肤仍然存在严重的错误。在皮肤子窗体上使用 caFree，可能会关闭您的整个应用程序。