;
220 | Index: Integer;
221 | Filter: TBitmapFilter;
222 | Element: TIdentMapEntry;
223 | LColor: TColor;
224 | StyleColor: TStyleColor;
225 | StyleFont: TStyleFont;
226 | begin
227 | if vseBitmaps in FElements then
228 | begin
229 | BitmapList:=StyleExt.BitmapList;
230 | try
231 | Index:=0;
232 | for LBitmap in BitmapList do
233 | begin
234 | for Filter in Filters do
235 | Filter.ProcessBitmap(LBitmap);
236 | StyleExt.ReplaceBitmap(Index, LBitmap);
237 | Inc(Index);
238 | end;
239 | finally
240 | BitmapList.Free;
241 | end;
242 | end;
243 |
244 | if vseSysColors in FElements then
245 | begin
246 | for Element in VclStyles_SysColors do
247 | begin
248 | LColor:=StyleExt.GetSystemColor(Element.Value);
249 | for Filter in Filters do
250 | LColor:=Filter.ProcessColor(LColor);
251 |
252 | StyleExt.SetSystemColor(Element.Value,LColor);
253 | end;
254 | end;
255 |
256 | if vseStyleColors in FElements then
257 | begin
258 | for StyleColor := Low(TStyleColor) to High(TStyleColor) do
259 | begin
260 | LColor:=StyleExt.GetStyleColor(StyleColor);
261 | for Filter in Filters do
262 | LColor:=Filter.ProcessColor(LColor);
263 |
264 | StyleExt.SetStyleColor(StyleColor, LColor);
265 | end;
266 | end;
267 |
268 | if vseStyleFontColors in FElements then
269 | begin
270 | for StyleFont := Low(TStyleFont) to High(TStyleFont) do
271 | begin
272 | LColor:=StyleExt.GetStyleFontColor(StyleFont);
273 | for Filter in Filters do
274 | LColor:=Filter.ProcessColor(LColor);
275 |
276 | StyleExt.SetStyleFontColor(StyleFont, LColor);
277 | end;
278 | end;
279 | end;
280 |
281 | end.
282 |
--------------------------------------------------------------------------------
/Ext/VCLStyleUtils/Common/fontawesome.ttf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/EtheaDev/VCLThemeSelector/dc0834e7b2c6bdfb51cbc9a11ecba8c097afc364/Ext/VCLStyleUtils/Common/fontawesome.ttf
--------------------------------------------------------------------------------
/Ext/VCLStyleUtils/Common/fontawesome.zip:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/EtheaDev/VCLThemeSelector/dc0834e7b2c6bdfb51cbc9a11ecba8c097afc364/Ext/VCLStyleUtils/Common/fontawesome.zip
--------------------------------------------------------------------------------
/Ext/VCLStyleUtils/DDetours/Source/CPUID.pas:
--------------------------------------------------------------------------------
1 | // **************************************************************************************************
2 | // CPUID for Delphi.
3 | // Unit CPUID
4 | // https://github.com/MahdiSafsafi/DDetours
5 | //
6 | // This Source Code Form is subject to the terms of the Mozilla
7 | // Public License, v. 2.0. If a copy of the MPL was not distributed
8 | // with this file, You can obtain one at
9 | // https://mozilla.org/MPL/2.0/.
10 | // **************************************************************************************************
11 |
12 | unit CPUID;
13 | {$IFDEF FPC}
14 | {$MODE DELPHI}
15 | {$WARN 4055 OFF}
16 | {$WARN 4082 OFF}
17 | {$WARN 5057 OFF}
18 | {$ENDIF FPC}
19 |
20 | interface
21 |
22 | {$I DDetoursDefs.inc}
23 |
24 | uses
25 | SysUtils
26 | {$IFNDEF FPC}, LegacyTypes{$ENDIF FPC}
27 | ;
28 |
29 | type
30 | { Do not change registers order ! }
31 | TCPUIDStruct = packed record
32 | rEAX: Cardinal; { EAX Register }
33 | rEBX: Cardinal; { EBX Register }
34 | rEDX: Cardinal; { EDX Register }
35 | rECX: Cardinal; { ECX Register }
36 | end;
37 |
38 | PCPUIDStruct = ^TCPUIDStruct;
39 |
40 | procedure CallCPUID(ID: NativeUInt; var CPUIDStruct: TCPUIDStruct);
41 | function IsCPUIDSupported(): Boolean;
42 |
43 | type
44 | TCPUVendor = (vUnknown, vIntel, vAMD, vNextGen);
45 | TCPUEncoding = set of (REX, VEX, EVEX);
46 | TCPUInstructions = set of (iMultiNop);
47 |
48 | var
49 | CPUVendor: TCPUVendor;
50 | CPUEncoding: TCPUEncoding;
51 | CPUInsts: TCPUInstructions;
52 |
53 | implementation
54 |
55 | var
56 | CPUIDSupported: Boolean = False;
57 |
58 | function ___IsCPUIDSupported: Boolean;
59 | asm
60 | {$IFDEF CPUX64}
61 | PUSH RCX
62 | MOV RCX,RCX
63 | PUSHFQ
64 | POP RAX
65 | MOV RCX, RAX
66 | XOR RAX, $200000
67 | PUSH RAX
68 | POPFQ
69 | PUSHFQ
70 | POP RAX
71 | XOR RAX, RCX
72 | SHR RAX, 21
73 | AND RAX, 1
74 | PUSH RCX
75 | POPFQ
76 | POP RCX
77 | {$ELSE !CPUX64}
78 |
79 | PUSH ECX
80 | PUSHFD
81 | POP EAX { EAX = EFLAGS }
82 | MOV ECX, EAX { Save the original EFLAGS value . }
83 | {
84 | CPUID is supported only if we can modify
85 | bit 21 of EFLAGS register !
86 | }
87 | XOR EAX, $200000
88 | PUSH EAX
89 | POPFD { Set the new EFLAGS value }
90 | PUSHFD
91 | POP EAX { Read EFLAGS }
92 | {
93 | Check if the 21 bit was modified !
94 | If so ==> Return True .
95 | else ==> Return False.
96 | }
97 | XOR EAX, ECX
98 | SHR EAX, 21
99 | AND EAX, 1
100 | PUSH ECX
101 | POPFD { Restore original EFLAGS value . }
102 | POP ECX
103 | {$ENDIF CPUX64}
104 | end;
105 |
106 | procedure ___CallCPUID(const ID: NativeInt; var CPUIDStruct);
107 | asm
108 | {
109 | ALL REGISTERS (rDX,rCX,rBX) MUST BE SAVED BEFORE
110 | EXECUTING CPUID INSTRUCTION !
111 | }
112 | {$IFDEF CPUX64}
113 | PUSH R9
114 | PUSH RBX
115 | PUSH RDX
116 | MOV RAX,RCX
117 | MOV R9,RDX
118 | CPUID
119 | {$IFNDEF FPC}
120 | MOV R9.TCPUIDStruct.rEAX,EAX
121 | MOV R9.TCPUIDStruct.rEBX,EBX
122 | MOV R9.TCPUIDStruct.rECX,ECX
123 | MOV R9.TCPUIDStruct.rEDX,EDX
124 | {$ELSE FPC}
125 | MOV [R9].TCPUIDStruct.rEAX,EAX
126 | MOV [R9].TCPUIDStruct.rEBX,EBX
127 | MOV [R9].TCPUIDStruct.rECX,ECX
128 | MOV [R9].TCPUIDStruct.rEDX,EDX
129 | {$ENDIF !FPC}
130 | POP RDX
131 | POP RBX
132 | POP R9
133 | {$ELSE !CPUX64}
134 |
135 | PUSH EDI
136 | PUSH ECX
137 | PUSH EBX
138 | MOV EDI,EDX
139 | CPUID
140 | {$IFNDEF FPC}
141 | MOV EDI.TCPUIDStruct.rEAX,EAX
142 | MOV EDI.TCPUIDStruct.rEBX,EBX
143 | MOV EDI.TCPUIDStruct.rECX,ECX
144 | MOV EDI.TCPUIDStruct.rEDX,EDX
145 | {$ELSE FPC}
146 | MOV [EDI].TCPUIDStruct.rEAX,EAX
147 | MOV [EDI].TCPUIDStruct.rEBX,EBX
148 | MOV [EDI].TCPUIDStruct.rECX,ECX
149 | MOV [EDI].TCPUIDStruct.rEDX,EDX
150 | {$ENDIF !FPC}
151 | POP EBX
152 | POP ECX
153 | POP EDI
154 | {$ENDIF CPUX64}
155 | end;
156 |
157 | function ___IsAVXSupported: Boolean;
158 | asm
159 | {
160 | Checking for AVX support requires 3 steps:
161 |
162 | 1) Detect CPUID.1:ECX.OSXSAVE[bit 27] = 1
163 | => XGETBV enabled for application use
164 |
165 | 2) Detect CPUID.1:ECX.AVX[bit 28] = 1
166 | => AVX instructions supported.
167 |
168 | 3) Issue XGETBV and verify that XCR0[2:1] = ‘11b’
169 | => XMM state and YMM state are enabled by OS.
170 |
171 | }
172 |
173 | { Steps : 1 and 2 }
174 | {$IFDEF CPUX64}
175 | MOV RAX, 1
176 | PUSH RCX
177 | PUSH RBX
178 | PUSH RDX
179 | {$ELSE !CPUX64}
180 | MOV EAX, 1
181 | PUSH ECX
182 | PUSH EBX
183 | PUSH EDX
184 | {$ENDIF CPUX64}
185 | CPUID
186 | AND ECX, $018000000
187 | CMP ECX, $018000000
188 | JNE @@NOT_SUPPORTED
189 | XOR ECX,ECX
190 | {
191 | Delphi does not support XGETBV !
192 | => We need to use the XGETBV opcodes !
193 | }
194 | DB $0F DB $01 DB $D0 // XGETBV
195 | { Step :3 }
196 | AND EAX, $06
197 | CMP EAX, $06
198 | JNE @@NOT_SUPPORTED
199 | MOV EAX, 1
200 | JMP @@END
201 | @@NOT_SUPPORTED:
202 | XOR EAX,EAX
203 | @@END:
204 | {$IFDEF CPUX64}
205 | POP RDX
206 | POP RBX
207 | POP RCX
208 | {$ELSE !CPUX64}
209 | POP EDX
210 | POP EBX
211 | POP ECX
212 | {$ENDIF CPUX64}
213 | end;
214 |
215 | procedure CallCPUID(ID: NativeUInt; var CPUIDStruct: TCPUIDStruct);
216 | begin
217 | FillChar(CPUIDStruct, SizeOf(TCPUIDStruct), #0);
218 | if not CPUIDSupported then
219 | raise Exception.Create('CPUID instruction not supported.')
220 | else
221 | ___CallCPUID(ID, CPUIDStruct);
222 | end;
223 |
224 | function IsCPUIDSupported: Boolean;
225 | begin
226 | Result := CPUIDSupported;
227 | end;
228 |
229 | type
230 | TVendorName = array [0 .. 12] of AnsiChar;
231 |
232 | function GetVendorName(): TVendorName;
233 | var
234 | Info: PCPUIDStruct;
235 | P: PByte;
236 | begin
237 | Result := '';
238 | if not IsCPUIDSupported then
239 | Exit;
240 | Info := GetMemory(SizeOf(TCPUIDStruct));
241 | CallCPUID(0, Info^);
242 | P := PByte(NativeInt(Info) + 4); // Skip EAX !
243 | Move(P^, PByte(@Result[0])^, 12);
244 | FreeMemory(Info);
245 | end;
246 |
247 | procedure __Init__;
248 | var
249 | vn: TVendorName;
250 | Info: TCPUIDStruct;
251 | r: Cardinal;
252 | begin
253 | CPUVendor := vUnknown;
254 | {$IFDEF CPUX64}
255 | CPUEncoding := [REX];
256 | {$ELSE !CPUX64}
257 | CPUEncoding := [];
258 | {$ENDIF CPUX64}
259 | CPUInsts := [];
260 | if IsCPUIDSupported then
261 | begin
262 | vn := GetVendorName();
263 | if vn = 'GenuineIntel' then
264 | CPUVendor := vIntel
265 | else if vn = 'AuthenticAMD' then
266 | CPUVendor := vAMD
267 | else if vn = 'NexGenDriven' then
268 | CPUVendor := vNextGen;
269 | CallCPUID(1, Info);
270 | r := Info.rEAX and $F00;
271 | case r of
272 | $F00, $600:
273 | Include(CPUInsts, iMultiNop);
274 | end;
275 | if ___IsAVXSupported then
276 | Include(CPUEncoding, VEX);
277 | end;
278 | end;
279 |
280 | initialization
281 |
282 | CPUIDSupported := ___IsCPUIDSupported;
283 | __Init__;
284 |
285 | end.
286 |
--------------------------------------------------------------------------------
/Ext/VCLStyleUtils/DDetours/Source/DDetoursDefs.inc:
--------------------------------------------------------------------------------
1 | {.$DEFINE HOOK_INTERNAL_FUNCTIONS} // hook internal functions.
2 |
3 | {$IFDEF FPC}
4 | {$ASMMODE INTEL}
5 | {$ELSE !FPC}
6 |
7 | {$T-}
8 |
9 | {$IF CompilerVersion >= 17.0}
10 | {$DEFINE DELPHI_2005_UP}
11 | {$IFEND}
12 |
13 | {$IF CompilerVersion >= 18.5}
14 | {$DEFINE DELPHI_2007_UP}
15 | {$IFEND}
16 |
17 | {$IF CompilerVersion >= 20}
18 | {$DEFINE DELPHI_2009_UP}
19 | {$IFEND}
20 |
21 | {$IF CompilerVersion >= 21}
22 | {$DEFINE DELPHI_2010_UP}
23 | {$IFEND}
24 |
25 | {$IF CompilerVersion >= 22}
26 | {$DEFINE DELPHI_XE_UP}
27 | {$IFEND}
28 |
29 | {$IF CompilerVersion >= 23}
30 | {$DEFINE DELPHI_XE2_UP}
31 | {$IFEND}
32 |
33 | {$IF CompilerVersion >= 33}
34 | {$DEFINE DELPHI_RIO_UP}
35 | {$IFEND}
36 |
37 | {$IFDEF DELPHI_2005_UP}
38 | {$DEFINE SUPPORTS_INLINE}
39 | {$ENDIF}
40 |
41 | {$IFDEF DELPHI_XE2_UP}
42 | {$DEFINE SUPPORTS_RTTI}
43 | {$DEFINE SUPPORTS_GENERICS}
44 | {$DEFINE RENAMED_NAMESPACE}
45 | {$ENDIF}
46 |
47 | {$ENDIF FPC}
48 |
49 |
--------------------------------------------------------------------------------
/Ext/VCLStyleUtils/DDetours/Source/LegacyTypes.pas:
--------------------------------------------------------------------------------
1 | // **************************************************************************************************
2 | //
3 | // https://github.com/MahdiSafsafi/DDetours
4 | //
5 | // **************************************************************************************************
6 |
7 | unit LegacyTypes;
8 |
9 | interface
10 |
11 | {$I DDetoursDefs.inc}
12 |
13 | type
14 |
15 | {$IFNDEF FPC}
16 | {$IFNDEF DELPHI_XE_UP}
17 | NativeInt = Integer;
18 | NativeUInt = Cardinal;
19 | PNativeInt = ^NativeInt;
20 | PNativeUInt = ^NativeUInt;
21 | {$IFDEF MSWINDOWS}
22 | TThreadID = LongWord;
23 | {$ENDIF MSWINDOWS}
24 | {$ENDIF DELPHI_XE_UP}
25 | {$ENDIF FPC}
26 | Int8 = Shortint;
27 | Int16 = Smallint;
28 | Int32 = Integer;
29 |
30 | UInt8 = Byte;
31 | UInt16 = Word;
32 | UInt32 = Cardinal;
33 |
34 | PInt8 = ^Int8;
35 | PInt16 = ^Int16;
36 | PInt32 = ^Int32;
37 | PInt64 = ^Int64;
38 |
39 | PUInt8 = ^UInt8;
40 | PUInt16 = ^UInt16;
41 | PUInt32 = ^UInt32;
42 | PUInt64 = ^UInt64;
43 |
44 | SIZE_T = NativeUInt;
45 |
46 | implementation
47 |
48 | end.
49 |
--------------------------------------------------------------------------------
/Ext/VCLStyleUtils/DDetours/Source/ModRmFlagsTables.inc:
--------------------------------------------------------------------------------
1 | // **************************************************************************************************
2 | // Part of x86 Instruction Decode Library [InstDecode]
3 | //
4 | // https://github.com/MahdiSafsafi/DDetours
5 | //
6 | // This Source Code Form is subject to the terms of the Mozilla
7 | // Public License, v. 2.0. If a copy of the MPL was not distributed
8 | // with this file, You can obtain one at
9 | // https://mozilla.org/MPL/2.0/.
10 | // **************************************************************************************************
11 |
12 |
13 | { Reference : Intel® 64 and IA-32 Architectures Software Developer’s Manual Vol 2 }
14 |
15 | type
16 | TModRmFlagsArray = array [Byte] of Byte;
17 | PModRmFlagsArray = ^TModRmFlagsArray;
18 | {
19 | ModRMFlags :
20 | Bits:4 3 2 1 0 .
21 |
22 | Bit 0 : Set ==> Register Indirect Addressing Mode .
23 | Bit 1 : Set ==> Displacement 8 bit .
24 | Bit 2 : Set ==> Displacement 16 bit .
25 | Bit 3 : Set ==> Displacement 32 bit.
26 | Bit 4 : Set ==> SIB Used .
27 |
28 |
29 | Values:
30 |
31 | $00 ==> Register .
32 | $01 ==> Register Indirect Addressing Mode with No Displacement .
33 | $03 ==> Register Indirect Addressing Mode + 8 bit Displacement .
34 | $04 ==> 16 bit Displacement only without register .
35 | $05 ==> Register Indirect Addressing Mode + 16 bit Displacement .
36 | $08 ==> 32 bit Displacement only without register .
37 | $09 ==> Register Indirect Addressing Mode + 32 bit Displacement .
38 | $11 ==> Register Indirect Addressing Mode + SIB .
39 | $13 ==> Register Indirect Addressing Mode + SIB + 8 bit Displacement .
40 | $19 ==> Register Indirect Addressing Mode + SIB + 32 bit Displacement .
41 |
42 | }
43 |
44 | const
45 |
46 | ModRM16Flags: TModRmFlagsArray = (
47 | { => Mod=00b <= }
48 | $01, $01, $01, $01, $01, $01, $04, $01, { 00 }
49 | $01, $01, $01, $01, $01, $01, $04, $01, { 00 }
50 | $01, $01, $01, $01, $01, $01, $04, $01, { 00 }
51 | $01, $01, $01, $01, $01, $01, $04, $01, { 00 }
52 | $01, $01, $01, $01, $01, $01, $04, $01, { 00 }
53 | $01, $01, $01, $01, $01, $01, $04, $01, { 00 }
54 | $01, $01, $01, $01, $01, $01, $04, $01, { 00 }
55 | $01, $01, $01, $01, $01, $01, $04, $01, { 00 }
56 | { => Mod=01b <= }
57 | $03, $03, $03, $03, $03, $03, $03, $03, { 01 }
58 | $03, $03, $03, $03, $03, $03, $03, $03, { 01 }
59 | $03, $03, $03, $03, $03, $03, $03, $03, { 01 }
60 | $03, $03, $03, $03, $03, $03, $03, $03, { 01 }
61 | $03, $03, $03, $03, $03, $03, $03, $03, { 01 }
62 | $03, $03, $03, $03, $03, $03, $03, $03, { 01 }
63 | $03, $03, $03, $03, $03, $03, $03, $03, { 01 }
64 | $03, $03, $03, $03, $03, $03, $03, $03, { 01 }
65 | { => Mod=10b <= }
66 | $05, $05, $05, $05, $05, $05, $05, $05, { 10 }
67 | $05, $05, $05, $05, $05, $05, $05, $05, { 10 }
68 | $05, $05, $05, $05, $05, $05, $05, $05, { 10 }
69 | $05, $05, $05, $05, $05, $05, $05, $05, { 10 }
70 | $05, $05, $05, $05, $05, $05, $05, $05, { 10 }
71 | $05, $05, $05, $05, $05, $05, $05, $05, { 10 }
72 | $05, $05, $05, $05, $05, $05, $05, $05, { 10 }
73 | $05, $05, $05, $05, $05, $05, $05, $05, { 10 }
74 | { => Mod=11b <= }
75 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
76 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
77 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
78 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
79 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
80 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
81 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
82 | $00, $00, $00, $00, $00, $00, $00, $00 { 11 }
83 |
84 | );
85 | ModRM32Flags: TModRmFlagsArray = (
86 | { => Mod=00b <= }
87 | $01, $01, $01, $01, $11, $08, $01, $01, { 00 }
88 | $01, $01, $01, $01, $11, $08, $01, $01, { 00 }
89 | $01, $01, $01, $01, $11, $08, $01, $01, { 00 }
90 | $01, $01, $01, $01, $11, $08, $01, $01, { 00 }
91 | $01, $01, $01, $01, $11, $08, $01, $01, { 00 }
92 | $01, $01, $01, $01, $11, $08, $01, $01, { 00 }
93 | $01, $01, $01, $01, $11, $08, $01, $01, { 00 }
94 | $01, $01, $01, $01, $11, $08, $01, $01, { 00 }
95 | { => Mod=01b <= }
96 | $03, $03, $03, $03, $13, $03, $03, $03, { 01 }
97 | $03, $03, $03, $03, $13, $03, $03, $03, { 01 }
98 | $03, $03, $03, $03, $13, $03, $03, $03, { 01 }
99 | $03, $03, $03, $03, $13, $03, $03, $03, { 01 }
100 | $03, $03, $03, $03, $13, $03, $03, $03, { 01 }
101 | $03, $03, $03, $03, $13, $03, $03, $03, { 01 }
102 | $03, $03, $03, $03, $13, $03, $03, $03, { 01 }
103 | $03, $03, $03, $03, $13, $03, $03, $03, { 01 }
104 | { => Mod=10b <= }
105 | $09, $09, $09, $09, $19, $09, $09, $09, { 10 }
106 | $09, $09, $09, $09, $19, $09, $09, $09, { 10 }
107 | $09, $09, $09, $09, $19, $09, $09, $09, { 10 }
108 | $09, $09, $09, $09, $19, $09, $09, $09, { 10 }
109 | $09, $09, $09, $09, $19, $09, $09, $09, { 10 }
110 | $09, $09, $09, $09, $19, $09, $09, $09, { 10 }
111 | $09, $09, $09, $09, $19, $09, $09, $09, { 10 }
112 | $09, $09, $09, $09, $19, $09, $09, $09, { 10 }
113 | { => Mod=11b <= }
114 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
115 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
116 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
117 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
118 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
119 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
120 | $00, $00, $00, $00, $00, $00, $00, $00, { 11 }
121 | $00, $00, $00, $00, $00, $00, $00, $00 { 11 }
122 |
123 | );
124 |
125 | ModRmFlags: array [0 .. 3] of PModRmFlagsArray = ( //
126 | nil,
127 | @ModRM16Flags, { AddrMode 16-bits }
128 | @ModRM32Flags, { AddrMode 32-bits }
129 | @ModRM32Flags { AddrMode 64-bits }
130 | );
--------------------------------------------------------------------------------
/Ext/VCLStyleUtils/DDetours/Source/TlHelp32.inc:
--------------------------------------------------------------------------------
1 | { TlHelp32 types for fpc }
2 |
3 | const
4 | TH32CS_SNAPHEAPLIST = $00000001;
5 | TH32CS_SNAPPROCESS = $00000002;
6 | TH32CS_SNAPTHREAD = $00000004;
7 | TH32CS_SNAPMODULE = $00000008;
8 | TH32CS_SNAPALL = TH32CS_SNAPHEAPLIST or TH32CS_SNAPPROCESS or
9 | TH32CS_SNAPTHREAD or TH32CS_SNAPMODULE;
10 | TH32CS_INHERIT = $80000000;
11 |
12 | TLS_OUT_OF_INDEXES = DWORD($FFFFFFFF); // FPC does not declare TLS_OUT_OF_INDEXES.
13 |
14 | type
15 | tagTHREADENTRY32 = record
16 | dwSize: DWORD;
17 | cntUsage: DWORD;
18 | th32ThreadID: DWORD;
19 | th32OwnerProcessID: DWORD;
20 | tpBasePri: Longint;
21 | tpDeltaPri: Longint;
22 | dwFlags: DWORD;
23 | end;
24 | THREADENTRY32 = tagTHREADENTRY32;
25 | PTHREADENTRY32 = ^tagTHREADENTRY32;
26 | LPTHREADENTRY32 = ^tagTHREADENTRY32;
27 | TThreadEntry32 = tagTHREADENTRY32;
28 |
29 | TThread32First = function (hSnapshot: THandle; var lpte: TThreadEntry32): BOOL stdcall;
30 | TThread32Next = function (hSnapshot: THandle; var lpte: TThreadENtry32): BOOL stdcall;
31 | TCreateToolhelp32Snapshot = function (dwFlags, th32ProcessID: DWORD): THandle; stdcall;
32 |
--------------------------------------------------------------------------------
/Ext/VCLStyleUtils/README.md:
--------------------------------------------------------------------------------
1 | 
2 | 
3 | 
4 | 
5 | # VCL Styles Utils #
6 |
7 | The *VCL Styles Utils* is a Delphi library which extend the [RAD Studio VCL Styles](http://docwiki.embarcadero.com/RADStudio/en/VCL_Styles_Overview), adding unique features like the support for [Classic and New Common dialogs](https://github.com/RRUZ/vcl-styles-utils/wiki/VclStylesSysControls), [Task Dialogs](https://github.com/RRUZ/vcl-styles-utils/wiki/VCLStylesUxTheme), Styling of [popup and shell menus](https://github.com/RRUZ/vcl-styles-utils/wiki/VCLStylesMenus), [Non client area](https://github.com/RRUZ/vcl-styles-utils/wiki/VclStylesNC) components and much more.
8 |
9 |
10 | 
11 |
12 |
13 | ## Features ##
14 |
15 | - Works in Delphi XE2-XE8, 10 Seattle, 10.1 Berlin, 10.2 Tokyo, 10.3 Rio, 10.4 Sydney
16 | - Vcl.Styles.Ext unit extended the VCL Styles adding new properties and methods to list, remove and reload VCL Styles.
17 | - Vcl.Styles.Utils unit, allows modify the VCL Styles manipulating the visual elements and fonts colors.
18 | - TNCControls component which allow you add controls to the Non Client area of the form
19 |
20 |
21 | 
22 |
23 |
24 | - Vcl.Styles.WebBrowser unit, add support for style the scrollbars and dialogs of the TWebBrowser component.
25 |
26 |
27 | 
28 |
29 |
32 |
33 | 
34 |
35 |
38 |
39 | 
40 |
41 |
42 | - Vcl.Styles.FormStyleHooks unit add support for use images and solid colors in the title and background of the TForms.
43 |
44 |
45 | 
46 |
47 |
50 |
51 | 
52 |
53 |
60 |
61 | ## Installation ##
62 |
63 |
64 | - Unzip or checkout the files of the library in a writable folder.
65 | - Under Tools, Environment Options, Library, add the directory where the VCL Styles Utils library have been installed Example : C:\Delphi\Libs\vcl-styles-utils\Common to the Win32 and Win64 library path.
66 |
67 |
68 |
69 | **Note** : If you want to use the Vcl.Styles.Hooks unit you must also include the [Delphi Detours Library](https://github.com/MahdiSafsafi/delphi-detours-library) files in your lib/search path Example : *C:\Delphi\Libs\vcl-styles-utils\Common\delphi-detours-library*
70 |
71 |
--------------------------------------------------------------------------------
/README.htm:
--------------------------------------------------------------------------------
1 |
32 | VCLThemeSelector 
33 | Easy and elegant preview/selection of Theme (Light or Dark) for VCL apps plus HighDPI demo
34 | Related links: https://www.embarcadero.com/ - https://learndelphi.org/
35 | With VCLThemeSelector you can easily add a modern and elegant Theme selector for your Delphi VCL app. The Form shows all the VCL Styles included in your application, then arrange them in defined Rows and Columns. You can specify to include or not 'Windows' not-styled option.
36 | Preview (from Delphi 10.4 to Delphi 12 - using PerControlStyles)
37 | 
38 | Preview (before Delphi 10.3 - Without PerControlStyle)
39 | 
40 | Use the VCLThemeSelectorLauncher demo present in Demo Folder to test it, and see how it's easy to use it, like in this example:
41 | var
42 | LStyleName: string;
43 | LExcludeWindows: boolean;
44 | LMaxRows, LMaxCols: Integer;
45 | begin
46 | LStyleName := TStyleManager.ActiveStyle.Name;
47 | LExcludeWindows := False;
48 | LMaxRows := 3;
49 | LMaxCols := 4;
50 | if ShowVCLThemeSelector(LStyleName, LExcludeWindows, LMaxRows, LMaxCols) then
51 | TStyleManager.SetStyle(LStyleName);
52 | end;
53 |
54 | License: the CBVCLStylePreview is based on VCLStylePreview (Vcl.Styles.Ext) from:
55 | github.com/RRUZ/vcl-styles-utils with full High-DPI support, and released under Apache 2.0 license.
56 | High-DPI Delphi App full example
57 | Also included in this repository you can find a full example of an HighDPI - VCL Themed enabled application that uses the VCLThemeSelector to change the Theme. You can run the demo from: Demo\Bin\ModernAppDemo.exe.
58 | Preview ( Delphi 12 and Windows 11 Modern Dark Style)
59 | 
60 | Preview ( Delphi 12 and Windows 11 Modern Light Style)
61 | 
62 | Demo from 10.1 to 10.3 (with SVGIconsImageList)
63 | 
64 | Demo with Delphi 12 (with PerControlStyle and IconFontsImageList)
65 | 
66 | WARNING: to edit and compile the demo you must first download:
67 | IconFontsImageList free components here… and SVGIconImageList free components here…
68 | You can also use StyledComponents, enabling STYLEDCOMPONENTS Compiler directive in the Demo. You must first download StyledComponents here…
69 | Preview using StyledComponents with Rounded Buttons
70 | 
71 | License
72 | this Demo is inspired by TSplitView demo (original software is Copyright (c) 2015 Embarcadero Technologies, Inc.) and is released under Apache 2.0 license.
73 | 
74 | Compatibility
75 | VCLThemeSelector and VCLThemeSelectorLauncher are compatible from Delphi XE5 to 12, with some differences to High-DPI support.
76 | ModernAppDemo is compatible with Delphi Delphi 12, 11, 10.4, 10.3, 10.2 and 10.1 (notice: 10.1 png stream format of pictures inside biolife.xml are incompatible: use an old biolife.xml file).
77 | Release Notes
78 | 20 Nov 2024
79 |
80 | - Added support for Delphi 12.2
81 | - Fixed Font Loading fron Registry in DemoApp
82 |
83 | 26 Apr 2024
84 |
85 | - Added support for Delphi 12.1
86 | - Added StyledComponents integration
87 | - Added StyledComponents interposer in demo
88 |
89 | 20 Oct 2023
90 |
91 | - Added support for Delphi 12
92 | - Examples Built with Delphi 12 (beta)
93 |
94 | 04 Mar 2023
95 |
96 | - Built with Delphi 11.3
97 | - More VCL Styles supported
98 |
99 | 15 Sep 2022
100 |
101 | - Built with Delphi 11.2
102 |
103 | 10 Apr 2022
104 |
105 | - Built with Delphi 11.1
106 | - Fixed Size of menu when resize icons
107 |
108 | 16 Feb 2022
109 |
110 | - Added italian translation
111 | - SetEditorStyleAttributes to assign required/readonly attributes to edit controls
112 | - Added pixelsperinch when storing font
113 | - Added RegisterThemeAttributes to interface to add personal Styles
114 |
115 | 19 Oct 2021
116 |
117 | - Replaced “Windows11 Light” and “Windows11 Dark” Styles with “Windows11 Modern Light” and “Windows11 Modern Dark”
118 | - Updated demos to use new Windows 11 Styles available from Get-It
119 |
120 | 16 Oct 2021
121 |
122 | - Added New Windows11 Light and Dark Themes to Modern Demo (Delphi 11)
123 | - Added New Windows11 Light and Dark Themes to Launcher (Delphi 11)
124 |
125 | 23 Aug 2021
126 |
127 | - Added support for Delphi 11
128 |
129 | 24 Jan 2021
130 |
131 | - Changed preview to separate Light and Dark Themes
132 | - Added support for info about Themes:
133 | TThemeAttribute = class
134 | StyleName: String;
135 | ThemeType: TThemeType;
136 | EditRequiredColor: TColor;
137 | EditReadonlyColor: TColor;
138 | end;
139 |
140 | 30 Aug 2020
141 |
142 | - Changed demo to use new IconsFontsVirtualImageList and SVGIconVirtualImageList components
143 | - Updated external project VCLStyleUtils
144 |
145 | 19 Jun 2020
146 |
147 | - Fixed VCLThemeSelector for app in “Windows” Style for D10.4
148 | - Recompiled Demo with IconFontsImageList 2.0 (with GDI+ support)
149 |
150 | 11 Jun 2020
151 |
152 | - Added SVGIconImageList
153 | - Demo: swith icons from Fonts to SVG
154 |
155 | 09 Jun 2020
156 |
157 | - Updated Demo for Delphi 10.4
158 | - Added custom form “per-control styled” for D10.4
159 |
160 | 17 May 2020
161 |
162 | - Changed “Material Design Desktop” Font used in Demo
163 |
164 | 27 Apr 2020
165 |
166 | - Added VCLThemeSelectorLauncher
167 |
168 | 25 Apr 2020
169 |
170 | - First release of Selector and Demo App
171 |
172 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # VCLThemeSelector [](https://opensource.org/licenses/Apache-2.0)
2 |
3 | **Easy and elegant preview/selection of Theme (Light or Dark) for VCL apps plus HighDPI demo**
4 |
5 | Related links: https://www.embarcadero.com/ - https://learndelphi.org/
6 |
7 | With **VCLThemeSelector** you can easily add a modern and elegant Theme selector for your Delphi VCL app. The Form shows all the VCL Styles included in your application, then arrange them in defined Rows and Columns. You can specify to include or not 'Windows' not-styled option.
8 |
9 | ### Preview (from Delphi 10.4 to Delphi 12 - using PerControlStyles)
10 | 
11 |
12 | ### Preview (before Delphi 10.3 - Without PerControlStyle)
13 | 
14 |
15 | Use the **VCLThemeSelectorLauncher** demo present in Demo Folder to test it, and see how it's easy to use it, like in this example:
16 |
17 | ```pascal
18 | var
19 | LStyleName: string;
20 | LExcludeWindows: boolean;
21 | LMaxRows, LMaxCols: Integer;
22 | begin
23 | LStyleName := TStyleManager.ActiveStyle.Name;
24 | LExcludeWindows := False;
25 | LMaxRows := 3;
26 | LMaxCols := 4;
27 | if ShowVCLThemeSelector(LStyleName, LExcludeWindows, LMaxRows, LMaxCols) then
28 | TStyleManager.SetStyle(LStyleName);
29 | end;
30 | ```
31 |
32 | License: the CBVCLStylePreview is based on VCLStylePreview (Vcl.Styles.Ext) from:
33 | [github.com/RRUZ/vcl-styles-utils](https://github.com/RRUZ/vcl-styles-utils/) with full High-DPI support, and released under Apache 2.0 license.
34 |
35 | ## High-DPI Delphi App full example ##
36 |
37 | Also included in this repository you can find a full example of an HighDPI - VCL Themed enabled application that uses the VCLThemeSelector to change the Theme. You can run the demo from: Demo\Bin\ModernAppDemo.exe.
38 |
39 | ### Preview ( Delphi 12 and Windows 11 Modern Dark Style)
40 | 
41 |
42 | ### Preview ( Delphi 12 and Windows 11 Modern Light Style)
43 | 
44 |
45 | ### Demo from 10.1 to 10.3 (with SVGIconsImageList)
46 | 
47 |
48 | ### Demo with Delphi 12 (with PerControlStyle and IconFontsImageList)
49 | 
50 |
51 | WARNING: to edit and compile the demo you must first download:
52 | IconFontsImageList free components [here...](https://github.com/EtheaDev/IconFontsImageList/) and SVGIconImageList free components [here...](https://github.com/EtheaDev/SVGIconImageList/)
53 |
54 | You can also use StyledComponents, enabling STYLEDCOMPONENTS Compiler directive in the Demo. You must first download StyledComponents [here...](https://github.com/EtheaDev/StyledComponents/)
55 |
56 | ### Preview using StyledComponents with Rounded Buttons
57 | 
58 |
59 | ### License
60 |
61 | this Demo is inspired by TSplitView demo (original software is Copyright (c) 2015 Embarcadero Technologies, Inc.) and is released under Apache 2.0 license.
62 |
63 | 
64 |
65 | ## Compatibility ##
66 |
67 | **VCLThemeSelector** and **VCLThemeSelectorLauncher** are compatible from Delphi XE5 to 12, with some differences to High-DPI support.
68 |
69 | **ModernAppDemo** is compatible with Delphi Delphi 12, 11, 10.4, 10.3, 10.2 and 10.1 (notice: 10.1 png stream format of pictures inside biolife.xml are incompatible: use an old biolife.xml file).
70 |
71 | ## Release Notes ##
72 |
73 | 20 Nov 2024
74 | - Added support for Delphi 12.2
75 | - Fixed Font Loading fron Registry in DemoApp
76 |
77 | 26 Apr 2024
78 | - Added support for Delphi 12.1
79 | - Added StyledComponents integration
80 | - Added StyledComponents interposer in demo
81 |
82 | 20 Oct 2023
83 | - Added support for Delphi 12
84 | - Examples Built with Delphi 12 (beta)
85 |
86 | 04 Mar 2023
87 | - Built with Delphi 11.3
88 | - More VCL Styles supported
89 |
90 | 15 Sep 2022
91 | - Built with Delphi 11.2
92 |
93 | 10 Apr 2022
94 | - Built with Delphi 11.1
95 | - Fixed Size of menu when resize icons
96 |
97 | 16 Feb 2022
98 | - Added italian translation
99 | - SetEditorStyleAttributes to assign required/readonly attributes to edit controls
100 | - Added pixelsperinch when storing font
101 | - Added RegisterThemeAttributes to interface to add personal Styles
102 |
103 | 19 Oct 2021
104 | - Replaced "Windows11 Light" and "Windows11 Dark" Styles with "Windows11 Modern Light" and "Windows11 Modern Dark"
105 | - Updated demos to use new Windows 11 Styles available from Get-It
106 |
107 | 16 Oct 2021
108 | - Added New Windows11 Light and Dark Themes to Modern Demo (Delphi 11)
109 | - Added New Windows11 Light and Dark Themes to Launcher (Delphi 11)
110 |
111 | 23 Aug 2021
112 | - Added support for Delphi 11
113 |
114 | 24 Jan 2021
115 | - Changed preview to separate Light and Dark Themes
116 | - Added support for info about Themes:
117 | TThemeAttribute = class
118 | StyleName: String;
119 | ThemeType: TThemeType;
120 | EditRequiredColor: TColor;
121 | EditReadonlyColor: TColor;
122 | end;
123 |
124 | 30 Aug 2020
125 | - Changed demo to use new IconsFontsVirtualImageList and SVGIconVirtualImageList components
126 | - Updated external project VCLStyleUtils
127 |
128 | 19 Jun 2020
129 | - Fixed VCLThemeSelector for app in "Windows" Style for D10.4
130 | - Recompiled Demo with IconFontsImageList 2.0 (with GDI+ support)
131 |
132 | 11 Jun 2020
133 | - Added SVGIconImageList
134 | - Demo: swith icons from Fonts to SVG
135 |
136 | 09 Jun 2020
137 | - Updated Demo for Delphi 10.4
138 | - Added custom form "per-control styled" for D10.4
139 |
140 | 17 May 2020
141 | - Changed "Material Design Desktop" Font used in Demo
142 |
143 | 27 Apr 2020
144 | - Added VCLThemeSelectorLauncher
145 |
146 | 25 Apr 2020
147 | - First release of Selector and Demo App
148 |
--------------------------------------------------------------------------------
/Source/CBVCLStylePreviewForm.dfm:
--------------------------------------------------------------------------------
1 | object CBVCLPreviewForm: TCBVCLPreviewForm
2 | Left = 0
3 | Top = 0
4 | BorderIcons = [biSystemMenu]
5 | ClientHeight = 122
6 | ClientWidth = 354
7 | Color = clBtnFace
8 | DoubleBuffered = True
9 | Font.Charset = DEFAULT_CHARSET
10 | Font.Color = clWindowText
11 | Font.Height = -11
12 | Font.Name = 'Tahoma'
13 | Font.Style = []
14 | Menu = MainMenu
15 | OnCloseQuery = FormCloseQuery
16 | OnCreate = FormCreate
17 | OnShow = FormShow
18 | TextHeight = 13
19 | object TabControl: TTabControl
20 | Left = 0
21 | Top = 0
22 | Width = 354
23 | Height = 122
24 | Align = alClient
25 | TabOrder = 0
26 | Tabs.Strings = (
27 | 'Page1'
28 | 'Page2'
29 | 'Page3')
30 | TabIndex = 0
31 | ExplicitWidth = 350
32 | ExplicitHeight = 121
33 | object FNormalTextEdit: TEdit
34 | Left = 8
35 | Top = 32
36 | Width = 80
37 | Height = 21
38 | TabOrder = 0
39 | Text = 'Normal'
40 | end
41 | object FButtonNormal: TButton
42 | Left = 8
43 | Top = 60
44 | Width = 75
45 | Height = 25
46 | Caption = 'Normal'
47 | TabOrder = 3
48 | OnMouseDown = FButtonNormalMouseDown
49 | OnMouseEnter = FButtonNormalMouseEnter
50 | OnMouseLeave = FButtonNormalMouseLeave
51 | OnMouseUp = FButtonNormalMouseUp
52 | end
53 | object FButtonDisabled: TButton
54 | Left = 94
55 | Top = 60
56 | Width = 75
57 | Height = 25
58 | Caption = 'Disabled'
59 | Enabled = False
60 | TabOrder = 4
61 | end
62 | object FRequiredTextEdit: TEdit
63 | Left = 94
64 | Top = 32
65 | Width = 80
66 | Height = 21
67 | TabOrder = 1
68 | Text = 'Required'
69 | end
70 | object FReadOnlyTextEdit: TEdit
71 | Left = 182
72 | Top = 32
73 | Width = 80
74 | Height = 21
75 | TabOrder = 2
76 | Text = 'ReadOnly'
77 | end
78 | object CheckBox: TCheckBox
79 | Left = 182
80 | Top = 60
81 | Width = 97
82 | Height = 17
83 | Caption = 'Check'
84 | Checked = True
85 | State = cbChecked
86 | TabOrder = 5
87 | end
88 | object ScrollBar: TScrollBar
89 | Left = 4
90 | Top = 101
91 | Width = 346
92 | Height = 17
93 | Align = alBottom
94 | PageSize = 0
95 | TabOrder = 6
96 | ExplicitTop = 100
97 | ExplicitWidth = 342
98 | end
99 | end
100 | object MainMenu: TMainMenu
101 | Left = 216
102 | Top = 32
103 | object FMenu1: TMenuItem
104 | Caption = 'File'
105 | end
106 | object FMenu2: TMenuItem
107 | Caption = 'Edit'
108 | end
109 | object FMenu3: TMenuItem
110 | Caption = 'View'
111 | end
112 | object FMenu4: TMenuItem
113 | Caption = 'Help'
114 | end
115 | end
116 | end
117 |
--------------------------------------------------------------------------------
/Source/CBVCLStylePreviewForm.pas:
--------------------------------------------------------------------------------
1 | {******************************************************************************}
2 | { }
3 | { CBVCLStylePreviewForm: Example Preview of a VCL Style }
4 | { based on: VCLStylePreview Vcl.Styles.Ext }
5 | { https://github.com/RRUZ/vcl-styles-utils/ }
6 | { }
7 | { Copyright (c) 2020-2024 (Ethea S.r.l.) }
8 | { Author: Carlo Barazzetta }
9 | { }
10 | { https://github.com/EtheaDev/VCLThemeSelector }
11 | { }
12 | {******************************************************************************}
13 | { }
14 | { Licensed under the Apache License, Version 2.0 (the "License"); }
15 | { you may not use this file except in compliance with the License. }
16 | { You may obtain a copy of the License at }
17 | { }
18 | { http://www.apache.org/licenses/LICENSE-2.0 }
19 | { }
20 | { Unless required by applicable law or agreed to in writing, software }
21 | { distributed under the License is distributed on an "AS IS" BASIS, }
22 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
23 | { See the License for the specific language governing permissions and }
24 | { limitations under the License. }
25 | { }
26 | {******************************************************************************}
27 | unit CBVCLStylePreviewForm;
28 |
29 | {$Include VCLThemeSelector.inc}
30 |
31 | interface
32 |
33 | Uses
34 | System.Classes,
35 | System.Sysutils,
36 | System.Generics.Collections,
37 | System.Types,
38 | Winapi.Windows,
39 | Vcl.Styles,
40 | Vcl.Themes,
41 | Vcl.Forms,
42 | vcl.Menus,
43 | Vcl.Graphics,
44 | Vcl.Controls,
45 | Vcl.ExtCtrls,
46 | Vcl.StdCtrls,
47 | Vcl.ComCtrls;
48 |
49 | const
50 | PREVIEW_HEIGHT = 190; //At 96 DPI
51 | PREVIEW_WIDTH = 300; //At 96 DPI
52 |
53 | type
54 | TCBVCLPreviewForm = class(TForm)
55 | MainMenu: TMainMenu;
56 | FMenu1: TMenuItem;
57 | FMenu2: TMenuItem;
58 | FMenu3: TMenuItem;
59 | FMenu4: TMenuItem;
60 | TabControl: TTabControl;
61 | FNormalTextEdit: TEdit;
62 | FButtonNormal: TButton;
63 | FButtonDisabled: TButton;
64 | FRequiredTextEdit: TEdit;
65 | ScrollBar: TScrollBar;
66 | FReadOnlyTextEdit: TEdit;
67 | CheckBox: TCheckBox;
68 | procedure FormShow(Sender: TObject);
69 | procedure FormCreate(Sender: TObject);
70 | procedure FButtonNormalMouseEnter(Sender: TObject);
71 | procedure FButtonNormalMouseLeave(Sender: TObject);
72 | procedure FButtonNormalMouseDown(Sender: TObject; Button: TMouseButton;
73 | Shift: TShiftState; X, Y: Integer);
74 | procedure FButtonNormalMouseUp(Sender: TObject; Button: TMouseButton;
75 | Shift: TShiftState; X, Y: Integer);
76 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
77 | private
78 | FButtonNormalCaption: string;
79 | FButtonHotCaption: string;
80 | FButtonPressedCaption: string;
81 | FCustomStyle: TCustomStyleServices;
82 | { Private declarations }
83 | public
84 | procedure SetCaptions(const ACaptions: string);
85 | property CustomStyle: TCustomStyleServices read FCustomStyle Write FCustomStyle;
86 | end;
87 |
88 | implementation
89 |
90 | {$R *.dfm}
91 |
92 | { TCBVCLPreviewForm }
93 |
94 | procedure TCBVCLPreviewForm.FButtonNormalMouseDown(Sender: TObject;
95 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
96 | begin
97 | FButtonNormal.Caption := FButtonPressedCaption;
98 | end;
99 |
100 | procedure TCBVCLPreviewForm.FButtonNormalMouseEnter(Sender: TObject);
101 | begin
102 | FButtonNormal.Caption := FButtonHotCaption;
103 | end;
104 |
105 | procedure TCBVCLPreviewForm.FButtonNormalMouseLeave(Sender: TObject);
106 | begin
107 | FButtonNormal.Caption := FButtonNormalCaption;
108 | end;
109 |
110 | procedure TCBVCLPreviewForm.FButtonNormalMouseUp(Sender: TObject;
111 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
112 | begin
113 | FButtonNormal.Caption := FButtonHotCaption;
114 | end;
115 |
116 | procedure TCBVCLPreviewForm.FormCloseQuery(Sender: TObject;
117 | var CanClose: Boolean);
118 | begin
119 | CanClose := False;
120 | end;
121 |
122 | procedure TCBVCLPreviewForm.FormCreate(Sender: TObject);
123 | begin
124 | ;
125 | end;
126 |
127 | procedure TCBVCLPreviewForm.FormShow(Sender: TObject);
128 | begin
129 | Self.StyleName := FCustomStyle.Name;
130 | Visible := True;
131 | end;
132 |
133 | procedure TCBVCLPreviewForm.SetCaptions(const ACaptions: string);
134 | var
135 | LCaptions: TStringList;
136 | begin
137 | LCaptions := TStringList.Create;
138 | LCaptions.Text := ACaptions;
139 | try
140 | if LCaptions.Count > 0 then //File
141 | FMenu1.Caption := LCaptions.Strings[0];
142 |
143 | if LCaptions.Count > 1 then //Edit
144 | FMenu2.Caption := LCaptions.Strings[1];
145 |
146 | if LCaptions.Count > 2 then //View
147 | FMenu3.Caption := LCaptions.Strings[2];
148 |
149 | if LCaptions.Count > 3 then //Help
150 | FMenu4.Caption := LCaptions.Strings[3];
151 |
152 | if LCaptions.Count > 4 then //Text editor
153 | FNormalTextEdit.Text := LCaptions.Strings[4];
154 |
155 | if LCaptions.Count > 5 then //Normal
156 | begin
157 | FButtonNormalCaption := LCaptions.Strings[5];
158 | FButtonNormal.Caption := FButtonNormalCaption;
159 | end;
160 |
161 | if LCaptions.Count > 6 then //Hot
162 | FButtonHotCaption := LCaptions.Strings[6];
163 |
164 | if LCaptions.Count > 7 then //Pressed
165 | FButtonPressedCaption := LCaptions.Strings[7];
166 |
167 | if LCaptions.Count > 8 then //Disabled
168 | FButtonDisabled.Caption := LCaptions.Strings[8];
169 |
170 | if LCaptions.Count > 9 then //Required
171 | FRequiredTextEdit.Text := LCaptions.Strings[9];
172 |
173 | if LCaptions.Count > 10 then //Readonly
174 | FReadOnlyTextEdit.Text := LCaptions.Strings[10];
175 |
176 | if LCaptions.Count > 11 then //Check
177 | CheckBox.Caption := LCaptions.Strings[11];
178 |
179 | if LCaptions.Count > 12 then //Page 1
180 | Tabcontrol.Tabs[0] := LCaptions.Strings[12];
181 |
182 | if LCaptions.Count > 13 then //Page 2
183 | Tabcontrol.Tabs[1] := LCaptions.Strings[13];
184 |
185 | if LCaptions.Count > 14 then //Page 3
186 | Tabcontrol.Tabs[2] := LCaptions.Strings[14];
187 |
188 | finally
189 | LCaptions.Free;
190 | end;
191 | end;
192 |
193 | end.
194 |
--------------------------------------------------------------------------------
/Source/FVCLThemeSelector.dfm:
--------------------------------------------------------------------------------
1 | object VCLThemeSelectorForm: TVCLThemeSelectorForm
2 | Left = 0
3 | Top = 0
4 | Hint = 'Select theme by clicking on the name'
5 | Caption = 'Select Light or Dark theme'
6 | ClientHeight = 501
7 | ClientWidth = 1061
8 | Color = clBtnFace
9 | ParentFont = True
10 | Position = poScreenCenter
11 | ShowHint = True
12 | OnCreate = FormCreate
13 | OnResize = FormResize
14 | TextHeight = 15
15 | object paButtons: TPanel
16 | Left = 0
17 | Top = 463
18 | Width = 1061
19 | Height = 38
20 | Align = alBottom
21 | BevelOuter = bvNone
22 | TabOrder = 0
23 | object StyleLabel: TPanel
24 | AlignWithMargins = True
25 | Left = 3
26 | Top = 3
27 | Width = 859
28 | Height = 32
29 | Align = alClient
30 | Alignment = taRightJustify
31 | BevelOuter = bvNone
32 | Caption = 'New selected theme: %s'
33 | TabOrder = 1
34 | end
35 | object paRight: TPanel
36 | Left = 865
37 | Top = 0
38 | Width = 196
39 | Height = 38
40 | Align = alRight
41 | BevelOuter = bvNone
42 | TabOrder = 0
43 | object btApply: TButton
44 | Left = 3
45 | Top = 5
46 | Width = 88
47 | Height = 29
48 | Action = acApplyStyle
49 | Default = True
50 | TabOrder = 0
51 | end
52 | object btCancel: TButton
53 | Left = 97
54 | Top = 4
55 | Width = 88
56 | Height = 29
57 | Action = acCancel
58 | Cancel = True
59 | TabOrder = 1
60 | end
61 | end
62 | end
63 | object LeftScrollBox: TScrollBox
64 | Left = 0
65 | Top = 25
66 | Width = 537
67 | Height = 438
68 | Align = alLeft
69 | TabOrder = 1
70 | OnMouseWheel = ScrollBoxMouseWheel
71 | object LeftFlowPanel: TFlowPanel
72 | Left = 0
73 | Top = 0
74 | Width = 533
75 | Height = 400
76 | Align = alTop
77 | AutoSize = True
78 | BevelOuter = bvNone
79 | BiDiMode = bdLeftToRight
80 | ParentBiDiMode = False
81 | TabOrder = 0
82 | end
83 | end
84 | object RightScrollBox: TScrollBox
85 | Left = 537
86 | Top = 25
87 | Width = 524
88 | Height = 438
89 | Align = alClient
90 | TabOrder = 2
91 | OnMouseWheel = ScrollBoxMouseWheel
92 | object RightFlowPanel: TFlowPanel
93 | Left = 0
94 | Top = 0
95 | Width = 520
96 | Height = 400
97 | Align = alTop
98 | AutoSize = True
99 | BevelOuter = bvNone
100 | BiDiMode = bdLeftToRight
101 | ParentBiDiMode = False
102 | TabOrder = 0
103 | end
104 | end
105 | object TopPanel: TPanel
106 | Left = 0
107 | Top = 0
108 | Width = 1061
109 | Height = 25
110 | Align = alTop
111 | TabOrder = 3
112 | object LightPanel: TPanel
113 | Left = 1
114 | Top = 1
115 | Width = 536
116 | Height = 23
117 | Align = alLeft
118 | BevelOuter = bvLowered
119 | Caption = 'Light Themes'
120 | TabOrder = 0
121 | end
122 | object DarkPanel: TPanel
123 | Left = 537
124 | Top = 1
125 | Width = 523
126 | Height = 23
127 | Align = alClient
128 | BevelOuter = bvLowered
129 | Caption = 'Dark Themes'
130 | TabOrder = 1
131 | end
132 | end
133 | object ActionListAppereance: TActionList
134 | Left = 488
135 | Top = 168
136 | object acApplyStyle: TAction
137 | Category = 'Settings'
138 | Caption = 'Apply'
139 | Hint = 'Apply selected Theme'
140 | ImageIndex = 71
141 | OnExecute = acApplyStyleExecute
142 | OnUpdate = acApplyStyleUpdate
143 | end
144 | object acCancel: TAction
145 | Category = 'Settings'
146 | Caption = 'Cancel'
147 | Hint = 'Cancel selection'
148 | ImageIndex = 10
149 | OnExecute = acCancelExecute
150 | end
151 | end
152 | end
153 |
--------------------------------------------------------------------------------
/Source/VCLThemeSelector.inc:
--------------------------------------------------------------------------------
1 | // Delphi 10.1 Berlin
2 | {$IFDEF VER310}
3 | {$DEFINE D10_1+}
4 | {$ENDIF}
5 |
6 | // Delphi 10.2 Tokyo
7 | {$IFDEF VER320}
8 | {$DEFINE D10_1+}
9 | {$DEFINE D10_2+}
10 | {$ENDIF}
11 |
12 | // Delphi 10.3
13 | {$IFDEF VER330}
14 | {$DEFINE D10_1+}
15 | {$DEFINE D10_2+}
16 | {$DEFINE D10_3+}
17 | {$ENDIF}
18 |
19 | // Delphi 10.4
20 | {$IFDEF VER340}
21 | {$DEFINE D10_1+}
22 | {$DEFINE D10_2+}
23 | {$DEFINE D10_3+}
24 | {$DEFINE D10_4+}
25 | {$ENDIF}
26 |
27 | // Delphi 11.0
28 | {$IFDEF VER350}
29 | {$DEFINE D10_1+}
30 | {$DEFINE D10_2+}
31 | {$DEFINE D10_3+}
32 | {$DEFINE D10_4+}
33 | {$DEFINE D11+}
34 | {$ENDIF}
35 |
36 | // Delphi 12.0
37 | {$IFDEF VER360}
38 | {$DEFINE D10_1+}
39 | {$DEFINE D10_2+}
40 | {$DEFINE D10_3+}
41 | {$DEFINE D10_4+}
42 | {$DEFINE D11+}
43 | {$DEFINE D12+}
44 | {$ENDIF}
45 |
46 |
--------------------------------------------------------------------------------
/TestFontDPI/ChildUnit.dfm:
--------------------------------------------------------------------------------
1 | object ChildForm: TChildForm
2 | Left = 0
3 | Top = 0
4 | Caption = 'ChildForm'
5 | ClientHeight = 299
6 | ClientWidth = 588
7 | Color = clBtnFace
8 | Font.Charset = DEFAULT_CHARSET
9 | Font.Color = clWindowText
10 | Font.Height = -11
11 | Font.Name = 'Tahoma'
12 | Font.Style = []
13 | OldCreateOrder = False
14 | OnAfterMonitorDpiChanged = FormAfterMonitorDpiChanged
15 | OnCreate = FormCreate
16 | OnShow = FormShow
17 | PixelsPerInch = 96
18 | TextHeight = 13
19 | object Label1: TLabel
20 | Left = 0
21 | Top = 0
22 | Width = 588
23 | Height = 258
24 | Align = alClient
25 | AutoSize = False
26 | Caption = 'Label1'
27 | ExplicitWidth = 561
28 | end
29 | object Panel1: TPanel
30 | Left = 0
31 | Top = 258
32 | Width = 588
33 | Height = 41
34 | Align = alBottom
35 | BevelOuter = bvLowered
36 | TabOrder = 0
37 | DesignSize = (
38 | 588
39 | 41)
40 | object Edit1: TEdit
41 | Left = 8
42 | Top = 8
43 | Width = 281
44 | Height = 21
45 | TabOrder = 0
46 | Text = 'Edit1'
47 | end
48 | object Button1: TButton
49 | Left = 448
50 | Top = 6
51 | Width = 131
52 | Height = 25
53 | Action = acCloseChildForm
54 | Anchors = [akTop, akRight]
55 | TabOrder = 1
56 | end
57 | end
58 | object ActionList: TActionList
59 | OnUpdate = ActionListUpdate
60 | Left = 288
61 | Top = 128
62 | object acCloseChildForm: TAction
63 | Caption = 'Close Child Form'
64 | OnExecute = acCloseChildFormExecute
65 | end
66 | end
67 | end
68 |
--------------------------------------------------------------------------------
/TestFontDPI/ChildUnit.pas:
--------------------------------------------------------------------------------
1 | unit ChildUnit;
2 |
3 | interface
4 |
5 | uses
6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
8 | System.Actions, Vcl.ActnList;
9 |
10 | type
11 | TChildForm = class(TForm)
12 | Label1: TLabel;
13 | Panel1: TPanel;
14 | Edit1: TEdit;
15 | ActionList: TActionList;
16 | acCloseChildForm: TAction;
17 | Button1: TButton;
18 | procedure acCloseChildFormExecute(Sender: TObject);
19 | procedure ActionListUpdate(Action: TBasicAction; var Handled: Boolean);
20 | procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
21 | NewDPI: Integer);
22 | procedure FormCreate(Sender: TObject);
23 | procedure FormShow(Sender: TObject);
24 | private
25 | protected
26 | procedure Loaded; override;
27 | public
28 | procedure AfterConstruction; override;
29 | procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
30 | end;
31 |
32 | var
33 | ChildForm: TChildForm;
34 |
35 | implementation
36 |
37 | {$R *.dfm}
38 |
39 | uses
40 | MainUnit;
41 |
42 |
43 | procedure TChildForm.acCloseChildFormExecute(Sender: TObject);
44 | begin
45 | Close;
46 | end;
47 |
48 | procedure TChildForm.ActionListUpdate(Action: TBasicAction;
49 | var Handled: Boolean);
50 | begin
51 | UpdateLabel(Self, Label1, Edit1, Panel1);
52 | end;
53 |
54 | procedure TChildForm.AfterConstruction;
55 | begin
56 | inherited;
57 | end;
58 |
59 | procedure TChildForm.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
60 | NewDPI: Integer);
61 | begin
62 | if ParentFont and (Application.MainForm.Monitor.Handle <> Self.Monitor.Handle) then
63 | Font.Height := MulDiv(Font.Height, NewDPI, OldDPI);
64 | end;
65 |
66 | procedure TChildForm.FormCreate(Sender: TObject);
67 | begin
68 | //Change size of form for 600x400 at 96 DPI
69 | ClientWidth := MulDiv(600, Self.Monitor.PixelsPerInch, Self.PixelsPerInch);
70 | ClientHeight := MulDiv(400, Self.Monitor.PixelsPerInch, Self.PixelsPerInch);
71 | //ClientWidth := MulDiv(600, Screen.PixelsPerInch, Self.PixelsPerInch);
72 | //ClientHeight := MulDiv(400, Screen.PixelsPerInch, Self.PixelsPerInch);
73 | end;
74 |
75 | procedure TChildForm.FormShow(Sender: TObject);
76 | begin
77 | //Only after FormAfterMonitorDpiChanged you can change Font attributes, because ParentFont goes to False
78 | Font.Color := clRed;
79 | end;
80 |
81 | procedure TChildForm.Loaded;
82 | begin
83 | //Ensure ParentFont always True for Child Forms
84 | ParentFont := True;
85 |
86 | inherited;
87 | end;
88 |
89 | procedure TChildForm.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
90 | begin
91 | inherited;
92 | ;
93 | end;
94 |
95 |
96 |
97 | end.
98 |
--------------------------------------------------------------------------------
/TestFontDPI/MainUnit.dfm:
--------------------------------------------------------------------------------
1 | object MainForm: TMainForm
2 | Left = 0
3 | Top = 0
4 | Caption = 'MainForm'
5 | ClientHeight = 299
6 | ClientWidth = 588
7 | Color = clBtnFace
8 | ParentFont = True
9 | OnAfterMonitorDpiChanged = FormAfterMonitorDpiChanged
10 | OnShow = FormShow
11 | TextHeight = 15
12 | object Label1: TLabel
13 | Left = 0
14 | Top = 0
15 | Width = 588
16 | Height = 258
17 | Align = alClient
18 | AutoSize = False
19 | Caption = 'Label1'
20 | WordWrap = True
21 | ExplicitTop = 2
22 | end
23 | object Panel1: TPanel
24 | Left = 0
25 | Top = 258
26 | Width = 588
27 | Height = 41
28 | Align = alBottom
29 | BevelOuter = bvLowered
30 | TabOrder = 0
31 | ExplicitTop = 257
32 | ExplicitWidth = 584
33 | DesignSize = (
34 | 588
35 | 41)
36 | object Edit1: TEdit
37 | Left = 8
38 | Top = 8
39 | Width = 281
40 | Height = 23
41 | TabOrder = 0
42 | Text = 'Edit1'
43 | end
44 | object Button1: TButton
45 | Left = 448
46 | Top = 6
47 | Width = 131
48 | Height = 25
49 | Action = acOpenChildForm
50 | Anchors = [akTop, akRight]
51 | TabOrder = 1
52 | ExplicitLeft = 444
53 | end
54 | end
55 | object ActionList: TActionList
56 | OnUpdate = ActionListUpdate
57 | Left = 288
58 | Top = 128
59 | object acOpenChildForm: TAction
60 | Caption = 'Open Child Form'
61 | OnExecute = acOpenChildFormExecute
62 | end
63 | end
64 | end
65 |
--------------------------------------------------------------------------------
/TestFontDPI/MainUnit.pas:
--------------------------------------------------------------------------------
1 | unit MainUnit;
2 |
3 | interface
4 |
5 | uses
6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
8 | System.Actions, Vcl.ActnList;
9 |
10 | type
11 | TMainForm = class(TForm)
12 | Label1: TLabel;
13 | Panel1: TPanel;
14 | Edit1: TEdit;
15 | ActionList: TActionList;
16 | acOpenChildForm: TAction;
17 | Button1: TButton;
18 | procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
19 | NewDPI: Integer);
20 | procedure FormShow(Sender: TObject);
21 | procedure Label1Click(Sender: TObject);
22 | procedure ActionListUpdate(Action: TBasicAction; var Handled: Boolean);
23 | procedure acOpenChildFormExecute(Sender: TObject);
24 | private
25 | FStart, FEnd: TDateTime;
26 | procedure UpdateDefaultAndSystemFonts;
27 | protected
28 | procedure Loaded; override;
29 | public
30 | procedure BuildLabels;
31 | constructor Create(AOwner: TComponent); override;
32 | end;
33 |
34 | var
35 | MainForm: TMainForm;
36 |
37 | procedure UpdateLabel(AForm: TForm; ALabel: TLabel; AEdit: TEdit;
38 | APanel: TPanel);
39 |
40 | implementation
41 |
42 | {$R *.dfm}
43 |
44 | uses
45 | ChildUnit;
46 |
47 | procedure UpdateLabel(AForm: TForm; ALabel: TLabel; AEdit: TEdit;
48 | APanel: TPanel);
49 | begin
50 | ALabel.Caption := Format(
51 | 'Parent: %d%s'+
52 | 'Screen.IconFont.Height: %d%s'+
53 | 'Screen.IconFont.PixelsPerInch: %d%s'+
54 | 'App.DefaultFont.Height: %d%s'+
55 | 'App.DefaultFont.PixelsPerInch: %d%s'+
56 | 'Font.Height: %d%s'+
57 | 'Font.PixelsPerInch: %d%s'+
58 | 'Font.Size: %d%s'+
59 | 'Font.Name: %s%s'+
60 | 'Edit.Font.Height: %d%s'+
61 | 'Edit.Height: %d%s'+
62 | 'Panel.Height: %d%s'+
63 | 'Scale Factor: %1.2f - MonitorPPI. %d',
64 | [Ord(AForm.ParentFont),sLineBreak,
65 | Screen.IconFont.Height,sLineBreak,
66 | Screen.IconFont.PixelsPerInch,sLineBreak,
67 | Application.DefaultFont.Height,sLineBreak,
68 | Application.DefaultFont.PixelsPerInch,sLineBreak,
69 | AForm.Font.Height,sLineBreak,
70 | AForm.Font.pixelsperinch,sLineBreak,
71 | AForm.Font.Size,sLineBreak,
72 | AForm.Font.Name,sLineBreak,
73 | AEdit.Font.Height,sLineBreak,
74 | AEdit.Height,sLineBreak,
75 | APanel.Height,sLineBreak,
76 | AForm.ScaleFactor, AForm.Monitor.PixelsPerInch]);
77 |
78 | AForm.Caption := Format('ClientWidth:%d - ClientHeight:%d',[
79 | AForm.ClientWidth, AForm.ClientHeight]);
80 | end;
81 |
82 | procedure TMainForm.acOpenChildFormExecute(Sender: TObject);
83 | begin
84 | ChildForm := TChildForm.Create(nil);
85 | try
86 | ChildForm.ShowModal;
87 | finally
88 | ChildForm.Free;
89 | end;
90 | end;
91 |
92 | procedure TMainForm.ActionListUpdate(Action: TBasicAction;
93 | var Handled: Boolean);
94 | begin
95 | UpdateLabel(Self, Label1, Edit1, Panel1);
96 | end;
97 |
98 | procedure TMainForm.UpdateDefaultAndSystemFonts;
99 | var
100 | LHeight: Integer;
101 | begin
102 | //Update Application.DefaultFont used by ChildForms with ParentFont = True
103 | Application.DefaultFont.Assign(Font);
104 | //Update system fonts as user preferences (without using Assign!)
105 | LHeight := Muldiv(Font.Height, Screen.PixelsPerInch, Monitor.PixelsPerInch);
106 | Screen.IconFont.Name := Font.Name;
107 | Screen.IconFont.Height := LHeight;
108 | Screen.MenuFont.Name := Font.Name;
109 | Screen.MenuFont.Height := LHeight;
110 | Screen.MessageFont.Name := Font.Name;
111 | Screen.MessageFont.Height := LHeight;
112 | Screen.HintFont.Name := Font.Name;
113 | Screen.HintFont.Height := LHeight;
114 | Screen.CaptionFont.Name := Font.Name;
115 | Screen.CaptionFont.Height := LHeight;
116 | end;
117 |
118 | procedure TMainForm.BuildLabels;
119 | var
120 | i: Integer;
121 | begin
122 | inherited;
123 | for I := 0 to 1000 do
124 | begin
125 | with TLabel.Create(Self) do
126 | begin
127 | Caption := 'Label: '+IntToStr(I);
128 | Parent := Self;
129 | SetBounds(I*10,I*10,100,100);
130 | end;
131 | end;
132 | end;
133 |
134 | constructor TMainForm.Create(AOwner: TComponent);
135 | var
136 | i: Integer;
137 | begin
138 | FStart := Now;
139 | inherited;
140 | //BuildLabels;
141 | end;
142 |
143 | procedure TMainForm.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
144 | NewDPI: Integer);
145 | begin
146 | inherited;
147 | UpdateDefaultAndSystemFonts;
148 | end;
149 |
150 | procedure TMainForm.FormShow(Sender: TObject);
151 | var
152 | H,M,S,MS: Word;
153 | begin
154 | FEnd := Now;
155 | DecodeTime((FEnd - fStart),H,M,S,MS);
156 | Caption := Caption + Format('W:%d - H:%d - %d.%d sec.',[
157 | ClientWidth, ClientHeight, S, MS]);
158 | end;
159 |
160 | procedure TMainForm.Label1Click(Sender: TObject);
161 | begin
162 | acOpenChildForm.Execute;
163 | end;
164 |
165 | procedure TMainForm.Loaded;
166 | begin
167 | //Very important for HighDPI: on Main Screen ParentFont must be always be False
168 | ParentFont := False;
169 |
170 | //Acquire system font and size (eg. for windows 10 Segoe UI and 14 at 96 DPI)
171 | //but without using Assign!
172 | Font.Name := Screen.IconFont.Name;
173 | //If you want to use system font Height:
174 | Font.Height := Muldiv(Screen.IconFont.Height, 96, Screen.IconFont.PixelsPerInch);
175 |
176 | (*
177 | //Sample assign Font by user preferences:
178 | Font.Name := 'Century Gothic';
179 | Font.Color := clBlue;
180 | Font.Height := -14;
181 | *)
182 |
183 | inherited;
184 |
185 | //For Child Forms with ParentFont = True
186 | UpdateDefaultAndSystemFonts;
187 |
188 | //Test build run-time components
189 | //BuildLabels;
190 | end;
191 |
192 | end.
193 |
--------------------------------------------------------------------------------
/TestFontDPI/TestFontDPI.dpr:
--------------------------------------------------------------------------------
1 | program TestFontDPI;
2 |
3 | uses
4 | Vcl.Forms,
5 | MainUnit in 'MainUnit.pas' {MainForm},
6 | ChildUnit in 'ChildUnit.pas' {ChildForm};
7 |
8 | {$R *.res}
9 |
10 | begin
11 | Application.Initialize;
12 | Application.CreateForm(TMainForm, MainForm);
13 | Application.MainFormOnTaskbar := True;
14 | Application.Run;
15 | end.
16 |
--------------------------------------------------------------------------------
/TestFontDPI/TestFontDPI.res:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/EtheaDev/VCLThemeSelector/dc0834e7b2c6bdfb51cbc9a11ecba8c097afc364/TestFontDPI/TestFontDPI.res
--------------------------------------------------------------------------------