Changeset 341 for trunk/Packages/Common

Timestamp:

Dec 21, 2024, 12:47:18 PM (36 hours ago)

Author:

chronos

Message:

• Modified: Improved dark theme support on Windows.

Location:

trunk/Packages/Common

Files:

• FormEx.pas (modified) (2 diffs)
• MetaCanvas.pas (modified) (2 diffs)
• RegistryEx.pas (modified) (2 diffs)
• Theme.pas (modified) (12 diffs)

trunk/Packages/Common/FormEx.pas

@@ -50 +50 @@
     PersistentForm.Load(Self);
     FullScreen := PersistentForm.FormFullScreen;
+    ThemeManager.UseTheme(Self);
   end;
 end;
@@ -75 +76 @@
 
   Translator.TranslateComponentRecursive(Self);
-  ThemeManager.UseTheme(Self);
   Inc(FCounter);
   inherited;

trunk/Packages/Common/MetaCanvas.pas

@@ -150 +150 @@
     procedure SetWidth(AValue: Integer); override;
     function GetWidth: Integer; override;
-    procedure DoLine (x1,y1,x2,y2:integer); override;
+    procedure DoLine(X1, Y1, X2, Y2: Integer); override;
     procedure DoTextOut(X, Y: Integer; Text: string); override;
     procedure DoRectangle(const Bounds: TRect); override;
@@ -563 +563 @@
 end;
 
-procedure TMetaCanvas.DoLine(x1, y1, x2, y2: integer);
+procedure TMetaCanvas.DoLine(X1, Y1, X2, Y2: integer);
 var
   NewObj: TCanvasLine;

trunk/Packages/Common/RegistryEx.pas

@@ -36 +36 @@
     function ReadFloatWithDefault(const Name: string;
       DefaultValue: Double): Double;
+    function ReadDateTimeWithDefault(const Name: string; DefaultValue: TDateTime): TDateTime;
     function DeleteKeyRecursive(const Key: string): Boolean;
     function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
@@ -110 +111 @@
 end;
 
+function TRegistryEx.ReadDateTimeWithDefault(const Name: string;
+  DefaultValue: TDateTime): TDateTime;
+begin
+  if ValueExists(Name) then Result := ReadDateTime(Name)
+    else begin
+      WriteDateTime(Name, DefaultValue);
+      Result := DefaultValue;
+    end;
+end;
+
 function TRegistryEx.DeleteKeyRecursive(const Key: string): Boolean;
 var

trunk/Packages/Common/Theme.pas

@@ -5 +5 @@
 uses
   Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls,
-  Spin, Forms, Generics.Collections, Grids;
+  Spin, Forms, Generics.Collections, Grids, Registry, LCLType;
 
 type
@@ -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;
+    property ActualTheme: TTheme read FActualTheme;
   end;
 
@@ -46 +56 @@
   ThemeNameLight = 'Light';
   ThemeNameDark = 'Dark';
+  DwmapiLibName = 'dwmapi.dll';
+  DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1 = 19;
+  DWMWA_USE_IMMERSIVE_DARK_MODE = 20;
 
 procedure Register;
@@ -95 +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;
 
@@ -110 +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(ThemeNameSystem) do begin
@@ -118 +204 @@
     ColorControlSelected := clWindow;
   end;
-  Theme := TTheme(Themes.First);
   with Themes.AddNew(ThemeNameDark) do begin
     ColorWindow := RGBToColor($20, $20, $20);
@@ -133 +218 @@
     ColorControlSelected := RGBToColor(196, 225, 255);
   end;
+  Theme := TTheme(Themes.First);
 end;
 
@@ -138 +224 @@
 begin
   FreeAndNil(Themes);
+  {$IFDEF WINDOWS}
+  if DwmapiLib <> 0 then FreeLibrary(DwmapiLib);
+  {$ENDIF}
   inherited;
 end;
@@ -156 +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;
 
@@ -181 +270 @@
 procedure TThemeManager.UseTheme(Form: TForm);
 begin
-  if not Used and (FTheme.Name = ThemeNameSystem) then Exit;
+  if not Used and (FActualTheme.Name = ThemeNameSystem) then Exit;
   ApplyTheme(Form);
+  SetThemedTitleBar(Form, FActualTheme.Name = ThemeNameDark);
   Used := True;
 end;