Changeset 582
- Timestamp:
- Dec 21, 2024, 12:42:18 PM (7 hours ago)
- Location:
- Common
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
Common/FormEx.pas
r577 r582 50 50 PersistentForm.Load(Self); 51 51 FullScreen := PersistentForm.FormFullScreen; 52 ThemeManager.UseTheme(Self); 52 53 end; 53 54 end; … … 75 76 76 77 Translator.TranslateComponentRecursive(Self); 77 ThemeManager.UseTheme(Self);78 78 Inc(FCounter); 79 79 inherited; -
Common/Theme.pas
r581 r582 5 5 uses 6 6 Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls, 7 Spin, Forms, Generics.Collections, Grids ;7 Spin, Forms, Generics.Collections, Grids, Registry, LCLType; 8 8 9 9 type … … 25 25 end; 26 26 27 TDwmSetWindowAttribute = function(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HRESULT; stdcall; 28 27 29 { TThemeManager } 28 30 … … 30 32 private 31 33 FTheme: TTheme; 34 FActualTheme: TTheme; 35 DwmapiLib: TLibHandle; 36 DwmSetWindowAttribute: TDwmSetWindowAttribute; 32 37 function Gray(C: TColor): Byte; 33 38 procedure SetTheme(AValue: TTheme); 34 procedure SetThemeName(AValue: TTheme); 39 procedure SetThemeName(Name: string); 40 procedure SetThemedTitleBar(AForm: TForm; Active: Bool); 41 function IsWindows10OrGreater(BuildNumber: Integer): Boolean; 35 42 public 36 43 Used: Boolean; … … 42 49 procedure UseTheme(Form: TForm); 43 50 property Theme: TTheme read FTheme write SetTheme; 51 property ActualTheme: TTheme read FActualTheme; 44 52 end; 45 53 … … 48 56 ThemeNameLight = 'Light'; 49 57 ThemeNameDark = 'Dark'; 58 DwmapiLibName = 'dwmapi.dll'; 59 DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1 = 19; 60 DWMWA_USE_IMMERSIVE_DARK_MODE = 20; 50 61 51 62 procedure Register; … … 105 116 106 117 function TThemeManager.IsDarkTheme: Boolean; 107 begin 108 Result := Gray(ColorToRGB(clWindow)) < Gray(ColorToRGB(clWindowText)); 109 end; 110 111 procedure TThemeManager.SetThemeName(AValue: TTheme); 118 {$IFDEF WINDOWS} 119 var 120 LightKey: Boolean; 121 Registry: TRegistry; 122 const 123 KeyPath = '\Software\Microsoft\Windows\CurrentVersion\Themes\Personalize'; 124 KeyName = 'AppsUseLightTheme'; 125 {$ELSE} 126 var 127 ColorWindow: TColor; 128 ColorWindowText: TColor; 129 {$ENDIF} 130 begin 131 Result := False; 132 {$IFDEF WINDOWS} 133 Registry := TRegistry.Create; 134 try 135 Registry.RootKey := HKEY_CURRENT_USER; 136 if Registry.OpenKeyReadOnly(KeyPath) then begin 137 if Registry.ValueExists(KeyName) then 138 LightKey := Registry.ReadBool(KeyName) 139 else LightKey := True; 140 end else LightKey := True; 141 Result := not LightKey; 142 finally 143 Registry.Free; 144 end; 145 {$ELSE} 146 ColorWindow := ColorToRGB(clWindow); 147 ColorWindowText := ColorToRGB(clWindowText); 148 Result := Gray(ColorWindow) < Gray(ColorWindowText); 149 {$ENDIF} 150 end; 151 152 procedure TThemeManager.SetThemeName(Name: string); 153 begin 154 Theme := Themes.FindByName(Name); 155 end; 156 157 function TThemeManager.IsWindows10OrGreater(BuildNumber: Integer): Boolean; 158 begin 159 {$IFDEF WINDOWS} 160 Result := (Win32MajorVersion >= 10) and (Win32BuildNumber >= BuildNumber); 161 {$ELSE} 162 Result := False; 163 {$ENDIF} 164 end; 165 166 procedure TThemeManager.SetThemedTitleBar(AForm: TForm; Active: Bool); 167 var 168 Attr: DWord; 169 begin 170 if Assigned(DwmSetWindowAttribute) and IsWindows10OrGreater(17763) then begin 171 Attr := DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1; 172 if IsWindows10OrGreater(18985) then Attr := DWMWA_USE_IMMERSIVE_DARK_MODE; 173 174 DwmSetWindowAttribute(AForm.Handle, Attr, @Active, SizeOf(Active)); 175 end; 176 end; 177 178 procedure TThemeManager.SetTheme(AValue: TTheme); 112 179 begin 113 180 if FTheme = AValue then Exit; 114 181 FTheme := AValue; 115 end; 116 117 procedure TThemeManager.SetTheme(AValue: TTheme); 118 begin 119 if FTheme = AValue then Exit; 120 FTheme := AValue; 182 FActualTheme := FTheme; 183 {$IFDEF WINDOWS} 184 if Assigned(FTheme) and (FTheme = Themes.FindByName(ThemeNameSystem)) and IsDarkTheme then 185 FActualTheme := Themes.FindByName(ThemeNameDark); 186 {$ENDIF} 121 187 end; 122 188 … … 124 190 begin 125 191 inherited; 192 {$IFDEF WINDOWS} 193 DwmapiLib := LoadLibrary(DwmapiLibName); 194 if DwmapiLib <> 0 then DwmSetWindowAttribute := GetProcAddress(DwmapiLib, 'DwmSetWindowAttribute') 195 else DwmSetWindowAttribute := nil; 196 {$ENDIF} 197 126 198 Themes := TThemes.Create; 127 199 with Themes.AddNew(ThemeNameSystem) do begin … … 132 204 ColorControlSelected := clWindow; 133 205 end; 134 Theme := TTheme(Themes.First);135 206 with Themes.AddNew(ThemeNameDark) do begin 136 207 ColorWindow := RGBToColor($20, $20, $20); … … 147 218 ColorControlSelected := RGBToColor(196, 225, 255); 148 219 end; 220 Theme := TTheme(Themes.First); 149 221 end; 150 222 … … 152 224 begin 153 225 FreeAndNil(Themes); 226 {$IFDEF WINDOWS} 227 if DwmapiLib <> 0 then FreeLibrary(DwmapiLib); 228 {$ENDIF} 154 229 inherited; 155 230 end; … … 170 245 (Control is TMemo) or (Control is TListView) or (Control is TCustomDrawGrid) or 171 246 (Control is TCheckBox) or (Control is TPageControl) or (Control is TRadioButton) then begin 172 Control.Color := F Theme.ColorWindow;173 Control.Font.Color := F Theme.ColorWindowText;247 Control.Color := FActualTheme.ColorWindow; 248 Control.Font.Color := FActualTheme.ColorWindowText; 174 249 end else begin 175 Control.Color := F Theme.ColorControl;176 Control.Font.Color := F Theme.ColorControlText;250 Control.Color := FActualTheme.ColorControl; 251 Control.Font.Color := FActualTheme.ColorControlText; 177 252 end; 178 253 179 254 if Control is TCustomDrawGrid then begin 180 (Control as TCustomDrawGrid).Editor.Color := F Theme.ColorWindow;181 (Control as TCustomDrawGrid).Editor.Font.Color := F Theme.ColorWindowText;255 (Control as TCustomDrawGrid).Editor.Color := FActualTheme.ColorWindow; 256 (Control as TCustomDrawGrid).Editor.Font.Color := FActualTheme.ColorWindowText; 182 257 end; 183 258 … … 195 270 procedure TThemeManager.UseTheme(Form: TForm); 196 271 begin 197 if not Used and (F Theme.Name = ThemeNameSystem) then Exit;272 if not Used and (FActualTheme.Name = ThemeNameSystem) then Exit; 198 273 ApplyTheme(Form); 274 SetThemedTitleBar(Form, FActualTheme.Name = ThemeNameDark); 199 275 Used := True; 200 276 end;
Note:
See TracChangeset
for help on using the changeset viewer.