← Back to branch summary

~chronoscz/c-evo/trunk

« back to all changes in this revision

Viewing changes to Packages/Common/UTheme.pas

  • Committer: chronos
  • Date: 2023-05-30 09:31:10 UTC
  • Revision ID: svn-v4:df67fc5e-c296-4801-ab9c-02011ead39ce:trunk:456
* Modified: Removed U prefix from unit names.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Packages/Common/UTheme.pas
1
 
unit UTheme;
2
 
 
3
 
interface
4
 
 
5
 
uses
6
 
  Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls,
7
 
  Spin, Forms, Generics.Collections, Grids;
8
 
 
9
 
type
10
 
  TTheme = class
11
 
    Name: string;
12
 
    ColorWindow: TColor;
13
 
    ColorWindowText: TColor;
14
 
    ColorControl: TColor;
15
 
    ColorControlText: TColor;
16
 
    ColorControlSelected: TColor;
17
 
  end;
18
 
 
19
 
  { TThemes }
20
 
 
21
 
  TThemes = class(TObjectList<TTheme>)
22
 
    function AddNew(Name: string): TTheme;
23
 
    function FindByName(Name: string): TTheme;
24
 
    procedure LoadToStrings(Strings: TStrings);
25
 
  end;
26
 
 
27
 
  { TThemeManager }
28
 
 
29
 
  TThemeManager = class(TComponent)
30
 
  private
31
 
    FTheme: TTheme;
32
 
    procedure SetTheme(AValue: TTheme);
33
 
    procedure SetThemeName(AValue: TTheme);
34
 
  public
35
 
    Used: Boolean;
36
 
    Themes: TThemes;
37
 
    procedure ApplyTheme(Component: TComponent);
38
 
    constructor Create(AOwner: TComponent); override;
39
 
    destructor Destroy; override;
40
 
    procedure UseTheme(Form: TForm);
41
 
    property Theme: TTheme read FTheme write SetTheme;
42
 
  end;
43
 
 
44
 
const
45
 
  ThemeNameSystem = 'System';
46
 
  ThemeNameLight = 'Light';
47
 
  ThemeNameDark = 'Dark';
48
 
 
49
 
procedure Register;
50
 
 
51
 
 
52
 
implementation
53
 
 
54
 
{ TThemes }
55
 
 
56
 
procedure Register;
57
 
begin
58
 
  RegisterComponents('Common', [TThemeManager]);
59
 
end;
60
 
 
61
 
function TThemes.AddNew(Name: string): TTheme;
62
 
begin
63
 
  Result := TTheme.Create;
64
 
  Result.Name := Name;
65
 
  Add(Result);
66
 
end;
67
 
 
68
 
function TThemes.FindByName(Name: string): TTheme;
69
 
var
70
 
  Theme: TTheme;
71
 
begin
72
 
  Result := nil;
73
 
  for Theme in Self do
74
 
    if Theme.Name = Name then begin
75
 
      Result := Theme;
76
 
      Exit;
77
 
    end;
78
 
end;
79
 
 
80
 
procedure TThemes.LoadToStrings(Strings: TStrings);
81
 
var
82
 
  I: Integer;
83
 
begin
84
 
  Strings.BeginUpdate;
85
 
  try
86
 
    while Strings.Count < Count do Strings.Add('');
87
 
    while Strings.Count > Count do Strings.Delete(Strings.Count - 1);
88
 
    for I := 0 to Count - 1 do begin
89
 
      Strings[I] := Items[I].Name;
90
 
      Strings.Objects[I] := Items[I];
91
 
    end;
92
 
  finally
93
 
    Strings.EndUpdate;
94
 
  end;
95
 
end;
96
 
 
97
 
procedure TThemeManager.SetThemeName(AValue: TTheme);
98
 
begin
99
 
  if FTheme = AValue then Exit;
100
 
  FTheme := AValue;
101
 
end;
102
 
 
103
 
procedure TThemeManager.SetTheme(AValue: TTheme);
104
 
begin
105
 
  if FTheme = AValue then Exit;
106
 
  FTheme := AValue;
107
 
end;
108
 
 
109
 
constructor TThemeManager.Create(AOwner: TComponent);
110
 
begin
111
 
  inherited;
112
 
  Themes := TThemes.Create;
113
 
  with Themes.AddNew(ThemeNameSystem) do begin
114
 
    ColorWindow := clWindow;
115
 
    ColorWindowText := clWindowText;
116
 
    ColorControl := clMenu;
117
 
    ColorControlText := clWindowText;
118
 
    ColorControlSelected := clWindow;
119
 
  end;
120
 
  Theme := TTheme(Themes.First);
121
 
  with Themes.AddNew(ThemeNameDark) do begin
122
 
    ColorWindow := RGBToColor($20, $20, $20);
123
 
    ColorWindowText := clWhite;
124
 
    ColorControl := RGBToColor($40, $40, $40);
125
 
    ColorControlText := clWhite;
126
 
    ColorControlSelected := RGBToColor(96, 125, 155);
127
 
  end;
128
 
  with Themes.AddNew(ThemeNameLight) do begin
129
 
    ColorWindow := clWhite;
130
 
    ColorWindowText := clBlack;
131
 
    ColorControl := RGBToColor($e0, $e0, $e0);
132
 
    ColorControlText := clBlack;
133
 
    ColorControlSelected := RGBToColor(196, 225, 255);
134
 
  end;
135
 
end;
136
 
 
137
 
destructor TThemeManager.Destroy;
138
 
begin
139
 
  FreeAndNil(Themes);
140
 
  inherited;
141
 
end;
142
 
 
143
 
procedure TThemeManager.ApplyTheme(Component: TComponent);
144
 
var
145
 
  Control: TControl;
146
 
  I: Integer;
147
 
begin
148
 
  if Component is TWinControl then begin
149
 
    for I := 0 to TWinControl(Component).ControlCount - 1 do
150
 
      ApplyTheme(TWinControl(Component).Controls[I]);
151
 
  end;
152
 
 
153
 
  if Component is TControl then begin
154
 
    Control := (Component as TControl);
155
 
    if (Control is TEdit) or (Control is TSpinEdit) or (Control is TComboBox) and
156
 
    (Control is TMemo) or (Control is TListView) or (Control is TCustomDrawGrid) or
157
 
    (Control is TCheckBox) or (Control is TPageControl) or (Control is TRadioButton) then begin
158
 
      Control.Color := FTheme.ColorWindow;
159
 
      Control.Font.Color := FTheme.ColorWindowText;
160
 
    end else begin
161
 
      Control.Color := FTheme.ColorControl;
162
 
      Control.Font.Color := FTheme.ColorControlText;
163
 
    end;
164
 
 
165
 
    if Control is TCustomDrawGrid then begin
166
 
      (Control as TCustomDrawGrid).Editor.Color := FTheme.ColorWindow;
167
 
      (Control as TCustomDrawGrid).Editor.Font.Color := FTheme.ColorWindowText;
168
 
    end;
169
 
 
170
 
    if Control is TPageControl then begin
171
 
      for I := 0 to TPageControl(Component).PageCount - 1 do
172
 
        ApplyTheme(TPageControl(Component).Pages[I]);
173
 
    end;
174
 
 
175
 
    if Control is TCoolBar then begin
176
 
      (Control as TCoolBar).Themed := False;
177
 
    end;
178
 
  end;
179
 
end;
180
 
 
181
 
procedure TThemeManager.UseTheme(Form: TForm);
182
 
begin
183
 
  if not Used and (FTheme.Name = ThemeNameSystem) then Exit;
184
 
  ApplyTheme(Form);
185
 
  Used := True;
186
 
end;
187
 
 
188
 
 
189
 
end.
190