Dérecensement styles en Delphi XE7

**gegila** · 24/11/2015, 11h25

Bonjour à tous

J'ai implémenté dans mon programme le choix de différents style à appliquer.
Le choix fait je l'enregistre dans la base de registre de façon à pouvoir redémarrer avec le même choix à la prochaine session.
Voici mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm1.actChangerStyleObsidianExecute(Sender: TObject);
begin
 
if TStyleManager.IsValidStyle(ExtractFilePath(Application.ExeName)+'Obsidian.vsf') then
    begin
     TStyleManager.LoadFromFile(ExtractFilePath(Application.ExeName)+'Obsidian.vsf');
     TStyleManager.TrySetStyle('Obsidian');
     // Stockage du style dans le registre
     Ecrire_registre('Sauvegarde_Style', 'style','Obsidian', True);
    end
    else
    begin
      ShowMessage('Style non touvé !');
    end;
end;

Si l'utilisateur veux tester tous les différents styles avant son choix définitif, il aura un message d'erreur du type "Style "Obsidian" déjà recensé".
Question: comment dérecencer un style avant de le rappeler de nouveau ?

**ShaiLeTroll** · 25/11/2015, 09h30

Tu n'aurais pas a la fois stocké les styles dans l'exe (option de projet) en plus de le charger manuellement ?

Sinon la réponse tu l'avais déjà "dérecencer un style" donne TStyleManager.UnRegisterStyle

Et tu peux aussi résoudre le problème autrement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
if not TStyleManager.TrySetStyle('Obsidian')  then
begin
  if TStyleManager.IsValidStyle(ExtractFilePath(Application.ExeName)+'Obsidian.vsf') then
  begin
     TStyleManager.LoadFromFile(ExtractFilePath(Application.ExeName)+'Obsidian.vsf');
     if TStyleManager.TrySetStyle('Obsidian') then
       Ecrire_registre('Sauvegarde_Style', 'style','Obsidian', True)
	 else
	   ShowMessage('Style touvé mais non activé !');
  end
  else
    ShowMessage('Style non touvé !');
end;

Perso, je me suis fait une classe pour gérer cela en XE2
Pour le moment, je fonctionne par inclusion de la ressource dans le projet
mais rien de plus facile que de remplacer le parcours sur "Vcl.Themes.TStyleManager.StyleNames" par un FindFirst/FindNext/FindClose sur un dossier contenant les fichiers VSF dans BuildChangeStyleMenu
Cela évite de faire manuellement le menu pour chaque style, de plus, cela me permet de réutiliser le code dans un grand nombre de projet sans effort

Une classe simplifiant les appels dans les applications professionnels que je développe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
  TStyleManagerSliteAssistant = class(TObject)
  public
    class procedure BuildChangeStyleMenu(AMenu: TMenuItem; const ADefaultStyle: string = ''); overload;
    class procedure SelectStyleInMenu(AMenu: TMenuItem; const ASelectedStyle: string);
    class procedure ChangeStyle(const AStyle: string);
    class function GetThemedBackgroundColor(): TColor;
    class procedure ChangePanelParentColorFromParentBackground(RootComponent: TComponent);
  end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
{ TStyleManagerSliteAssistant }
 
//------------------------------------------------------------------------------
class procedure TStyleManagerSliteAssistant.BuildChangeStyleMenu(AMenu: TMenuItem; const ADefaultStyle: string = '');
begin
  TStyleManagerSLTAssistant.BuildChangeStyleMenu(AMenu, TStyleManagerSLTAssistant.StyleClickDefaultEventHandler, ADefaultStyle);
end;
 
//------------------------------------------------------------------------------
class procedure TStyleManagerSliteAssistant.ChangePanelParentColorFromParentBackground(RootComponent: TComponent);
var
  I: Integer;
  Cpt: TComponent;
begin
  // En local, les postes développeurs sous Vista\Seven,
  // En Citrix, les environnements semblent être sous Window 2003 ou Window 2008 sous le thème classique (Win2K)
  // Avec le Thème Aero, une application avec coloration de la TForm nécessite
  // . ParentBackground si elle compilée avec le Manifest Common Control Version 6.0 fourni par Embarcadero, ParentBackground provoque une transparence permettant de voir la couleur de fond (cela peut-être une image)
  // . ParentColor si elle est compilée SANS les thèmes, Si ParentColor est à True cela propage la couleur, problème par défaut le TPanel force cette valeur à False depuis l'apparition de ParentBackground
  // Avec le Thème classique (Win2K), une application avec coloration de la TForm nécessite
  // . ParentColor si elle est compilée AVEC ou SANS les thèmes
  if not VCL.Themes.StyleServices.Enabled then
  begin
    // ParentBackground est sans effet à moins que les thèmes XP ne soient activés.
    // Il faut forcer ParentColor à True alors que sur les TPanel c'est par défaut à False
    for I := 0 to RootComponent.ComponentCount - 1 do
    begin
      Cpt := RootComponent.Components[I];
      if Cpt is TPanel then
        if TPanel(Cpt).ParentBackground then
          TPanel(Cpt).ParentColor := True;
    end;
  end;
end;
 
//------------------------------------------------------------------------------
class procedure TStyleManagerSliteAssistant.ChangeStyle(const AStyle: string);
begin
  TStyleManager.TrySetStyle(AStyle, False);
end;
 
//------------------------------------------------------------------------------
class function TStyleManagerSliteAssistant.GetThemedBackgroundColor(): TColor;
begin
  Result := TStyleManagerSLTAssistant.GetThemedBackgroundColor();
end;
 
//------------------------------------------------------------------------------
class procedure TStyleManagerSliteAssistant.SelectStyleInMenu(AMenu: TMenuItem; const ASelectedStyle: string);
var
  I: Integer;
begin
  for I := 0 to AMenu.Count - 1 do
  begin
    if SameText(AMenu.Items[I].Caption, ASelectedStyle) then
    begin
      TStyleManagerSLTAssistant.StyleClickDefaultEventHandler(AMenu.Items[I]);
      Exit;
    end;
  end;
end;

Ma classe personnelle traduite d'une version C++Buider XE2 que j'avais écrite sur la version Beta

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
//------------------------------------------------------------------------------
(*                SoLuTions is an Versatile Library for Delphi                 -
 *                                                                             -
 *  Version alternative publiée sur "www.developpez.net"                       -
 *  Post : "Des applications qui ont de la gueule avec XE2 "                   -
 *  Post Number : 6596974                                                      -
 *  Post URL = "http://www.developpez.net/forums/d1204594/c-cpp/outils-c-cpp/cppbuilder/applications-ont-gueule-xe2/#post6596974"
 *                                                                             -
 *  Copyright ou © ou Copr. "SLT Solutions", (2006)                            -
 *  contributeur : ShaiLeTroll (2012) - Gestion des Styles sous C++BuilderXE2  -
 *  contributeur : ShaiLeTroll (2012) - Documentation Insight                  -
 *  contributeur : ShaiLeTroll (2014) - Traduction du code C++Builder vers DelphiXE2
 *                                                                             -
 *                                                                             -
 * Ce logiciel est un programme informatique servant à aider les développeurs  -
 * Delphi avec une bibliothèque polyvalente, adaptable et fragmentable.        -
 *                                                                             -
 * Ce logiciel est régi par la licence CeCILL-C soumise au droit français et   -
 * respectant les principes de diffusion des logiciels libres. Vous pouvez     -
 * utiliser, modifier et/ou redistribuer ce programme sous les conditions      -
 * de la licence CeCILL-C telle que diffusée par le CEA, le CNRS et l'INRIA    -
 * sur le site "http://www.cecill.info".                                       -
 *                                                                             -
 * En contrepartie de l'accessibilité au code source et des droits de copie,   -
 * de modification et de redistribution accordés par cette licence, il n'est   -
 * offert aux utilisateurs qu'une garantie limitée.  Pour les mêmes raisons,   -
 * seule une responsabilité restreinte pèse sur l'auteur du programme,  le     -
 * titulaire des droits patrimoniaux et les concédants successifs.             -
 *                                                                             -
 * A cet égard  l'attention de l'utilisateur est attirée sur les risques       -
 * associés au chargement,  à l'utilisation,  à la modification et/ou au       -
 * développement et à la reproduction du logiciel par l'utilisateur étant      -
 * donné sa spécificité de logiciel libre, qui peut le rendre complexe à       -
 * manipuler et qui le réserve donc à des développeurs et des professionnels   -
 * avertis possédant  des  connaissances  informatiques approfondies.  Les     -
 * utilisateurs sont donc invités à charger  et  tester  l'adéquation  du      -
 * logiciel à leurs besoins dans des conditions permettant d'assurer la        -
 * sécurité de leurs systèmes et ou de leurs données et, plus généralement,    -
 * à l'utiliser et l'exploiter dans les mêmes conditions de sécurité.          -
 *                                                                             -
 * Le fait que vous puissiez accéder à cet en-tête signifie que vous avez      -
 * pris connaissance de la licence CeCILL-C, et que vous en avez accepté les   -
 * termes.                                                                     -
 *                                                                             -
 *----------------------------------------------------------------------------*)
unit SLT.Controls.VCL.ThemesEx;
 
interface
 
uses System.Classes, System.SysUtils,
  Vcl.Themes, Vcl.Menus, Vcl.Forms, Vcl.Graphics;
 
type
  /// <summary>Assistance de la classe TStyleManager</summary>
  /// <remarks>Le TStyleManagerSLTAssistant n'est pas un class helper car lors de sa création la version utilisée était C++Builder XE2,
  /// Traduction C++Builder vers Delphi en concervant ce concept des Assistances de classes (Class Helper) du Delphi.NET</remarks>
  TStyleManagerSLTAssistant = class(TObject)
  public
    /// <summary>BuildChangeStyleMenu ajoute comme menus enfants dans un TMenuItem, tous les noms de style connus par le gestionnaire de style</summary>
    /// <param name="AMenu">Menu dans lequel seront insérés comme sous-menu chaque style géré par l'application</param>
    /// <param name="AOnClick">Gestionnaire d'évèmenent commun à chaque sous-menu, le Tag permet de trouver le style concerné, il recommandé d'utiliser StyleClickDefaultEventHandler</param>
    /// <param name="ADefaultStyle">Style fixé à l'origine</param>
    class procedure BuildChangeStyleMenu(AMenu: TMenuItem; AOnClick: TNotifyEvent; const ADefaultStyle: string = '');
    class procedure StyleClickDefaultEventHandler(Sender: TObject);
    class function GetThemedBackgroundColor(): TColor;
  end;
 
implementation
 
 
//------------------------------------------------------------------------------
class procedure TStyleManagerSLTAssistant.BuildChangeStyleMenu(AMenu: TMenuItem; AOnClick: TNotifyEvent; const ADefaultStyle: string = '');
var
  Styles: TArray<string>;
  I: Integer;
  menu: TMenuItem;
  DefaultStyleName: string;
begin
  AMenu.AutoHotkeys := maManual;
  AMenu.Clear();
 
  if ADefaultStyle <> '' then
    DefaultStyleName := ADefaultStyle
  else
    DefaultStyleName := Vcl.Themes.TStyleManager.SystemStyle.Name;
 
  Styles := Vcl.Themes.TStyleManager.StyleNames;
  for I := Low(Styles) to High(Styles) do
  begin
    menu := TMenuItem.Create(AMenu);
    AMenu.Add(menu);
    menu.Tag := i;
    menu.AutoHotkeys := maManual;
    menu.RadioItem := true;
    menu.GroupIndex := 1;
    menu.Caption := Styles[i];
 
    if menu.Caption = DefaultStyleName then
    begin
      menu.Checked := True;
      TStyleManager.SetStyle(menu.Caption);
    end;
 
    menu.OnClick := AOnClick;
  end;
end;
 
//------------------------------------------------------------------------------
class function TStyleManagerSLTAssistant.GetThemedBackgroundColor(): TColor;
begin
  if not StyleServices.Enabled or StyleServices.IsSystemStyle then
    Result := clBtnFace
  else
    Result := ColorToRGB(StyleServices.GetStyleColor(scWindow)); // semble la même couleur que scGenericBackground
end;
 
//------------------------------------------------------------------------------
class procedure TStyleManagerSLTAssistant.StyleClickDefaultEventHandler(Sender: TObject);
var
  menu: TMenuItem;
begin
  if Sender is TMenuItem then
  begin
    menu := TMenuItem(Sender);
    if not SameText(TStyleManager.ActiveStyle.Name, menu.Caption) then
    begin
      menu.Checked := True;
      TStyleManager.SetStyle(menu.Caption);
    end;
 
    Application.BringToFront();
  end;
end;
 
 
end.

**gegila** · 25/11/2015, 14h39

Merci beaucoup de ta réponse hyper complète

En effet je charge dans l'exe (via le menu Projets/options/Application/apparence un premier Style de Base.

Si je veux le réinitialiser pas de Pb je fais:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 TStyleManager.TrySetStyle('Diamond');

et cela autant de fois que je le veux.

Le Pb était pour ceux que je recense à partir du Programme.

Je vais certainement me pencher sur la création d'une classe comme tu me le proposes car effectivement je devrai énormément gagner en souplesse d'utilisation pour les futurs programmes

Dérecensement styles en Delphi XE7

Composants VCL Delphi

Discussions similaires

Partager

Partager