Changeset 582


Ignore:
Timestamp:
Dec 21, 2024, 12:42:18 PM (7 hours ago)
Author:
chronos
Message:
  • Modified: Improved dark theme support.
Location:
Common
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • Common/FormEx.pas

    r577 r582  
    5050    PersistentForm.Load(Self);
    5151    FullScreen := PersistentForm.FormFullScreen;
     52    ThemeManager.UseTheme(Self);
    5253  end;
    5354end;
     
    7576
    7677  Translator.TranslateComponentRecursive(Self);
    77   ThemeManager.UseTheme(Self);
    7878  Inc(FCounter);
    7979  inherited;
  • Common/Theme.pas

    r581 r582  
    55uses
    66  Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls,
    7   Spin, Forms, Generics.Collections, Grids;
     7  Spin, Forms, Generics.Collections, Grids, Registry, LCLType;
    88
    99type
     
    2525  end;
    2626
     27  TDwmSetWindowAttribute = function(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HRESULT; stdcall;
     28
    2729  { TThemeManager }
    2830
     
    3032  private
    3133    FTheme: TTheme;
     34    FActualTheme: TTheme;
     35    DwmapiLib: TLibHandle;
     36    DwmSetWindowAttribute: TDwmSetWindowAttribute;
    3237    function Gray(C: TColor): Byte;
    3338    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;
    3542  public
    3643    Used: Boolean;
     
    4249    procedure UseTheme(Form: TForm);
    4350    property Theme: TTheme read FTheme write SetTheme;
     51    property ActualTheme: TTheme read FActualTheme;
    4452  end;
    4553
     
    4856  ThemeNameLight = 'Light';
    4957  ThemeNameDark = 'Dark';
     58  DwmapiLibName = 'dwmapi.dll';
     59  DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1 = 19;
     60  DWMWA_USE_IMMERSIVE_DARK_MODE = 20;
    5061
    5162procedure Register;
     
    105116
    106117function 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}
     119var
     120  LightKey: Boolean;
     121  Registry: TRegistry;
     122const
     123  KeyPath = '\Software\Microsoft\Windows\CurrentVersion\Themes\Personalize';
     124  KeyName = 'AppsUseLightTheme';
     125{$ELSE}
     126var
     127  ColorWindow: TColor;
     128  ColorWindowText: TColor;
     129{$ENDIF}
     130begin
     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}
     150end;
     151
     152procedure TThemeManager.SetThemeName(Name: string);
     153begin
     154  Theme := Themes.FindByName(Name);
     155end;
     156
     157function TThemeManager.IsWindows10OrGreater(BuildNumber: Integer): Boolean;
     158begin
     159  {$IFDEF WINDOWS}
     160  Result := (Win32MajorVersion >= 10) and (Win32BuildNumber >= BuildNumber);
     161  {$ELSE}
     162  Result := False;
     163  {$ENDIF}
     164end;
     165
     166procedure TThemeManager.SetThemedTitleBar(AForm: TForm; Active: Bool);
     167var
     168  Attr: DWord;
     169begin
     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;
     176end;
     177
     178procedure TThemeManager.SetTheme(AValue: TTheme);
    112179begin
    113180  if FTheme = AValue then Exit;
    114181  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}
    121187end;
    122188
     
    124190begin
    125191  inherited;
     192  {$IFDEF WINDOWS}
     193  DwmapiLib := LoadLibrary(DwmapiLibName);
     194  if DwmapiLib <> 0 then DwmSetWindowAttribute := GetProcAddress(DwmapiLib, 'DwmSetWindowAttribute')
     195    else DwmSetWindowAttribute := nil;
     196  {$ENDIF}
     197
    126198  Themes := TThemes.Create;
    127199  with Themes.AddNew(ThemeNameSystem) do begin
     
    132204    ColorControlSelected := clWindow;
    133205  end;
    134   Theme := TTheme(Themes.First);
    135206  with Themes.AddNew(ThemeNameDark) do begin
    136207    ColorWindow := RGBToColor($20, $20, $20);
     
    147218    ColorControlSelected := RGBToColor(196, 225, 255);
    148219  end;
     220  Theme := TTheme(Themes.First);
    149221end;
    150222
     
    152224begin
    153225  FreeAndNil(Themes);
     226  {$IFDEF WINDOWS}
     227  if DwmapiLib <> 0 then FreeLibrary(DwmapiLib);
     228  {$ENDIF}
    154229  inherited;
    155230end;
     
    170245    (Control is TMemo) or (Control is TListView) or (Control is TCustomDrawGrid) or
    171246    (Control is TCheckBox) or (Control is TPageControl) or (Control is TRadioButton) then begin
    172       Control.Color := FTheme.ColorWindow;
    173       Control.Font.Color := FTheme.ColorWindowText;
     247      Control.Color := FActualTheme.ColorWindow;
     248      Control.Font.Color := FActualTheme.ColorWindowText;
    174249    end else begin
    175       Control.Color := FTheme.ColorControl;
    176       Control.Font.Color := FTheme.ColorControlText;
     250      Control.Color := FActualTheme.ColorControl;
     251      Control.Font.Color := FActualTheme.ColorControlText;
    177252    end;
    178253
    179254    if Control is TCustomDrawGrid then begin
    180       (Control as TCustomDrawGrid).Editor.Color := FTheme.ColorWindow;
    181       (Control as TCustomDrawGrid).Editor.Font.Color := FTheme.ColorWindowText;
     255      (Control as TCustomDrawGrid).Editor.Color := FActualTheme.ColorWindow;
     256      (Control as TCustomDrawGrid).Editor.Font.Color := FActualTheme.ColorWindowText;
    182257    end;
    183258
     
    195270procedure TThemeManager.UseTheme(Form: TForm);
    196271begin
    197   if not Used and (FTheme.Name = ThemeNameSystem) then Exit;
     272  if not Used and (FActualTheme.Name = ThemeNameSystem) then Exit;
    198273  ApplyTheme(Form);
     274  SetThemedTitleBar(Form, FActualTheme.Name = ThemeNameDark);
    199275  Used := True;
    200276end;
Note: See TracChangeset for help on using the changeset viewer.