Changeset 219 for trunk/Packages/Common/Theme.pas

Timestamp:

Jan 17, 2025, 9:05:54 PM (4 days ago)

Author:

chronos

Message:

• Modified: Updated Common package.
• Modified: Remove U prefix from unit names.
• Modified: Use Gneeric.Collections instead of fgl.
• Modified: Do not use global form variables.

File:

• trunk/Packages/Common/Theme.pas (moved) (moved from trunk/Packages/Common/UTheme.pas ) (14 diffs)

trunk/Packages/Common/Theme.pas

@@ -1 @@
-unit UTheme;
+unit Theme;
 
 interface
@@ -5 +5 @@
 uses
   Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls,
-  Spin, Forms, fgl, Grids;
+  Spin, Forms, Generics.Collections, Grids, Registry, LCLType;
 
 type
@@ -19 +19 @@
   { TThemes }
 
-  TThemes = class(TFPGObjectList<TTheme>)
+  TThemes = class(TObjectList<TTheme>)
     function AddNew(Name: string): TTheme;
     function FindByName(Name: string): TTheme;
@@ -25 +25 @@
   end;
 
+  TDwmSetWindowAttribute = function(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HRESULT; stdcall;
+
   { TThemeManager }
 
@@ -30 +32 @@
   private
     FTheme: TTheme;
+    FActualTheme: TTheme;
+    DwmapiLib: TLibHandle;
+    DwmSetWindowAttribute: TDwmSetWindowAttribute;
+    function Gray(C: TColor): Byte;
     procedure SetTheme(AValue: TTheme);
-    procedure SetThemeName(AValue: TTheme);
+    procedure SetThemeName(Name: string);
+    procedure SetThemedTitleBar(AForm: TForm; Active: Bool);
+    function IsWindows10OrGreater(BuildNumber: Integer): Boolean;
   public
     Used: Boolean;
     Themes: TThemes;
+    function IsDarkTheme: Boolean;
     procedure ApplyTheme(Component: TComponent);
     constructor Create(AOwner: TComponent); override;
@@ -40 +49 @@
     procedure UseTheme(Form: TForm);
     property Theme: TTheme read FTheme write SetTheme;
-  end;
+    property ActualTheme: TTheme read FActualTheme;
+  end;
+
+const
+  ThemeNameSystem = 'System';
+  ThemeNameLight = 'Light';
+  ThemeNameDark = 'Dark';
+  DwmapiLibName = 'dwmapi.dll';
+  DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1 = 19;
+  DWMWA_USE_IMMERSIVE_DARK_MODE = 20;
 
 procedure Register;
+
 
 implementation
@@ -89 +108 @@
 end;
 
-procedure TThemeManager.SetThemeName(AValue: TTheme);
+{ TThemeManager }
+
+function TThemeManager.Gray(C: TColor): Byte;
+begin
+  Result := Trunc(Red(C) * 0.3 + Green(C) * 0.59 + Blue(C) * 0.11);
+end;
+
+function TThemeManager.IsDarkTheme: Boolean;
+{$IFDEF WINDOWS}
+var
+  LightKey: Boolean;
+  Registry: TRegistry;
+const
+  KeyPath = '\Software\Microsoft\Windows\CurrentVersion\Themes\Personalize';
+  KeyName = 'AppsUseLightTheme';
+{$ELSE}
+var
+  ColorWindow: TColor;
+  ColorWindowText: TColor;
+{$ENDIF}
+begin
+  Result := False;
+  {$IFDEF WINDOWS}
+  Registry := TRegistry.Create;
+  try
+    Registry.RootKey := HKEY_CURRENT_USER;
+    if Registry.OpenKeyReadOnly(KeyPath) then begin
+      if Registry.ValueExists(KeyName) then
+        LightKey := Registry.ReadBool(KeyName)
+      else LightKey := True;
+    end else LightKey := True;
+    Result := not LightKey;
+  finally
+    Registry.Free;
+  end;
+  {$ELSE}
+  ColorWindow := ColorToRGB(clWindow);
+  ColorWindowText := ColorToRGB(clWindowText);
+  Result := Gray(ColorWindow) < Gray(ColorWindowText);
+  {$ENDIF}
+end;
+
+procedure TThemeManager.SetThemeName(Name: string);
+begin
+  Theme := Themes.FindByName(Name);
+end;
+
+function TThemeManager.IsWindows10OrGreater(BuildNumber: Integer): Boolean;
+begin
+  {$IFDEF WINDOWS}
+  Result := (Win32MajorVersion >= 10) and (Win32BuildNumber >= BuildNumber);
+  {$ELSE}
+  Result := False;
+  {$ENDIF}
+end;
+
+procedure TThemeManager.SetThemedTitleBar(AForm: TForm; Active: Bool);
+var
+  Attr: DWord;
+begin
+  if Assigned(DwmSetWindowAttribute) and IsWindows10OrGreater(17763) then begin
+    Attr := DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1;
+    if IsWindows10OrGreater(18985) then Attr := DWMWA_USE_IMMERSIVE_DARK_MODE;
+
+    DwmSetWindowAttribute(AForm.Handle, Attr, @Active, SizeOf(Active));
+  end;
+end;
+
+procedure TThemeManager.SetTheme(AValue: TTheme);
 begin
   if FTheme = AValue then Exit;
   FTheme := AValue;
-end;
-
-procedure TThemeManager.SetTheme(AValue: TTheme);
-begin
-  if FTheme = AValue then Exit;
-  FTheme := AValue;
+  FActualTheme := FTheme;
+  {$IFDEF WINDOWS}
+  if Assigned(FTheme) and (FTheme = Themes.FindByName(ThemeNameSystem)) and IsDarkTheme then
+    FActualTheme := Themes.FindByName(ThemeNameDark);
+  {$ENDIF}
 end;
 
@@ -104 +190 @@
 begin
   inherited;
+  {$IFDEF WINDOWS}
+  DwmapiLib := LoadLibrary(DwmapiLibName);
+  if DwmapiLib <> 0 then DwmSetWindowAttribute := GetProcAddress(DwmapiLib, 'DwmSetWindowAttribute')
+    else DwmSetWindowAttribute := nil;
+  {$ENDIF}
+
   Themes := TThemes.Create;
-  with Themes.AddNew('System') do begin
+  with Themes.AddNew(ThemeNameSystem) do begin
     ColorWindow := clWindow;
     ColorWindowText := clWindowText;
@@ -112 +204 @@
     ColorControlSelected := clWindow;
   end;
-  Theme := TTheme(Themes.First);
-  with Themes.AddNew('Dark') do begin
+  with Themes.AddNew(ThemeNameDark) do begin
     ColorWindow := RGBToColor($20, $20, $20);
     ColorWindowText := clWhite;
@@ -120 +211 @@
     ColorControlSelected := RGBToColor(96, 125, 155);
   end;
-  with Themes.AddNew('Light') do begin
+  with Themes.AddNew(ThemeNameLight) do begin
     ColorWindow := clWhite;
     ColorWindowText := clBlack;
@@ -127 +218 @@
     ColorControlSelected := RGBToColor(196, 225, 255);
   end;
+  Theme := TTheme(Themes.First);
 end;
 
@@ -132 +224 @@
 begin
   FreeAndNil(Themes);
+  {$IFDEF WINDOWS}
+  if DwmapiLib <> 0 then FreeLibrary(DwmapiLib);
+  {$ENDIF}
   inherited;
 end;
@@ -150 +245 @@
     (Control is TMemo) or (Control is TListView) or (Control is TCustomDrawGrid) or
     (Control is TCheckBox) or (Control is TPageControl) or (Control is TRadioButton) then begin
-      Control.Color := FTheme.ColorWindow;
-      Control.Font.Color := FTheme.ColorWindowText;
+      Control.Color := FActualTheme.ColorWindow;
+      Control.Font.Color := FActualTheme.ColorWindowText;
     end else begin
-      Control.Color := FTheme.ColorControl;
-      Control.Font.Color := FTheme.ColorControlText;
+      Control.Color := FActualTheme.ColorControl;
+      Control.Font.Color := FActualTheme.ColorControlText;
     end;
 
     if Control is TCustomDrawGrid then begin
-      (Control as TCustomDrawGrid).Editor.Color := FTheme.ColorWindow;
-      (Control as TCustomDrawGrid).Editor.Font.Color := FTheme.ColorWindowText;
+      (Control as TCustomDrawGrid).Editor.Color := FActualTheme.ColorWindow;
+      (Control as TCustomDrawGrid).Editor.Font.Color := FActualTheme.ColorWindowText;
     end;
 
@@ -175 +270 @@
 procedure TThemeManager.UseTheme(Form: TForm);
 begin
-  if not Used and (FTheme.Name = 'System') then Exit;
+  if not Used and (FActualTheme.Name = ThemeNameSystem) then Exit;
   ApplyTheme(Form);
+  SetThemedTitleBar(Form, FActualTheme.Name = ThemeNameDark);
   Used := True;
 end;
 
-
 end.