1 | unit UTheme;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls,
|
---|
7 | Spin, Forms, Contnrs, 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)
|
---|
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 | procedure Register;
|
---|
45 |
|
---|
46 | implementation
|
---|
47 |
|
---|
48 | { TThemes }
|
---|
49 |
|
---|
50 | procedure Register;
|
---|
51 | begin
|
---|
52 | RegisterComponents('Common', [TThemeManager]);
|
---|
53 | end;
|
---|
54 |
|
---|
55 | function TThemes.AddNew(Name: string): TTheme;
|
---|
56 | begin
|
---|
57 | Result := TTheme.Create;
|
---|
58 | Result.Name := Name;
|
---|
59 | Add(Result);
|
---|
60 | end;
|
---|
61 |
|
---|
62 | function TThemes.FindByName(Name: string): TTheme;
|
---|
63 | var
|
---|
64 | Theme: TTheme;
|
---|
65 | begin
|
---|
66 | Result := nil;
|
---|
67 | for Theme in Self do
|
---|
68 | if Theme.Name = Name then begin
|
---|
69 | Result := Theme;
|
---|
70 | Exit;
|
---|
71 | end;
|
---|
72 | end;
|
---|
73 |
|
---|
74 | procedure TThemes.LoadToStrings(Strings: TStrings);
|
---|
75 | var
|
---|
76 | Theme: TTheme;
|
---|
77 | begin
|
---|
78 | Strings.Clear;
|
---|
79 | for Theme in Self do
|
---|
80 | Strings.AddObject(Theme.Name, Theme);
|
---|
81 | end;
|
---|
82 |
|
---|
83 | procedure TThemeManager.SetThemeName(AValue: TTheme);
|
---|
84 | begin
|
---|
85 | if FTheme = AValue then Exit;
|
---|
86 | FTheme := AValue;
|
---|
87 | end;
|
---|
88 |
|
---|
89 | procedure TThemeManager.SetTheme(AValue: TTheme);
|
---|
90 | begin
|
---|
91 | if FTheme = AValue then Exit;
|
---|
92 | FTheme := AValue;
|
---|
93 | end;
|
---|
94 |
|
---|
95 | constructor TThemeManager.Create(AOwner: TComponent);
|
---|
96 | begin
|
---|
97 | inherited;
|
---|
98 | Themes := TThemes.Create;
|
---|
99 | with Themes.AddNew('System') do begin
|
---|
100 | ColorWindow := clWindow;
|
---|
101 | ColorWindowText := clWindowText;
|
---|
102 | ColorControl := clMenu;
|
---|
103 | ColorControlText := clWindowText;
|
---|
104 | ColorControlSelected := clWindow;
|
---|
105 | end;
|
---|
106 | Theme := TTheme(Themes.First);
|
---|
107 | with Themes.AddNew('Dark') do begin
|
---|
108 | ColorWindow := RGBToColor($20, $20, $20);
|
---|
109 | ColorWindowText := clWhite;
|
---|
110 | ColorControl := RGBToColor($40, $40, $40);
|
---|
111 | ColorControlText := clWhite;
|
---|
112 | ColorControlSelected := RGBToColor(96, 125, 155);
|
---|
113 | end;
|
---|
114 | with Themes.AddNew('Light') do begin
|
---|
115 | ColorWindow := clWhite;
|
---|
116 | ColorWindowText := clBlack;
|
---|
117 | ColorControl := RGBToColor($e0, $e0, $e0);
|
---|
118 | ColorControlText := clBlack;
|
---|
119 | ColorControlSelected := RGBToColor(196, 225, 255);
|
---|
120 | end;
|
---|
121 | end;
|
---|
122 |
|
---|
123 | destructor TThemeManager.Destroy;
|
---|
124 | begin
|
---|
125 | Themes.Free;
|
---|
126 | inherited Destroy;
|
---|
127 | end;
|
---|
128 |
|
---|
129 | procedure TThemeManager.ApplyTheme(Component: TComponent);
|
---|
130 | var
|
---|
131 | Control: TControl;
|
---|
132 | I: Integer;
|
---|
133 | begin
|
---|
134 | if Component is TWinControl then begin
|
---|
135 | for I := 0 to TWinControl(Component).ControlCount - 1 do
|
---|
136 | ApplyTheme(TWinControl(Component).Controls[I]);
|
---|
137 | end;
|
---|
138 |
|
---|
139 | if Component is TControl then begin
|
---|
140 | Control := (Component as TControl);
|
---|
141 | if (Control is TEdit) or (Control is TSpinEdit) or (Control is TComboBox) and
|
---|
142 | (Control is TMemo) or (Control is TListView) or (Control is TCustomDrawGrid) or
|
---|
143 | (Control is TCheckBox) or (Control is TPageControl) or (Control is TRadioButton) then begin
|
---|
144 | Control.Color := FTheme.ColorWindow;
|
---|
145 | Control.Font.Color := FTheme.ColorWindowText;
|
---|
146 | end else begin
|
---|
147 | Control.Color := FTheme.ColorControl;
|
---|
148 | Control.Font.Color := FTheme.ColorControlText;
|
---|
149 | end;
|
---|
150 |
|
---|
151 | if Control is TCustomDrawGrid then begin
|
---|
152 | (Control as TCustomDrawGrid).Editor.Color := FTheme.ColorWindow;
|
---|
153 | (Control as TCustomDrawGrid).Editor.Font.Color := FTheme.ColorWindowText;
|
---|
154 | end;
|
---|
155 |
|
---|
156 | if Control is TPageControl then begin
|
---|
157 | for I := 0 to TPageControl(Component).PageCount - 1 do
|
---|
158 | ApplyTheme(TPageControl(Component).Pages[I]);
|
---|
159 | end;
|
---|
160 | end;
|
---|
161 | end;
|
---|
162 |
|
---|
163 | procedure TThemeManager.UseTheme(Form: TForm);
|
---|
164 | begin
|
---|
165 | if not Used and (FTheme.Name = 'System') then Exit;
|
---|
166 | ApplyTheme(Form);
|
---|
167 | Used := True;
|
---|
168 | end;
|
---|
169 |
|
---|
170 |
|
---|
171 | end.
|
---|