Changeset 115 for trunk

Timestamp:

Dec 11, 2024, 10:26:02 AM (5 weeks ago)

Author:

chronos

Message:

• Modified: Automatically detect and use dark mode on Windows.
• Modified: Use dark mode title bar on Windows 10.

Location:

trunk

Files:

• Core.pas (modified) (1 diff)
• Game.pas (modified) (5 diffs)
• Packages/Common/Theme.pas (modified) (8 diffs)

trunk/Core.pas

@@ -118 +118 @@
       FormMain.FormMain.Redraw;
       FormMain.FormMain.UpdateInterface;
+      ThemeManager1.UseTheme(FormMain.FormMain);
       UpdateInterface;
     end;

trunk/Game.pas

@@ -409 +409 @@
   // Clear background
   MetaCanvas.Brush.Style := bsSolid;
-  MetaCanvas.Brush.Color := Core.Core.ThemeManager1.Theme.ColorControl;
+  MetaCanvas.Brush.Color := Core.Core.ThemeManager1.ActualTheme.ColorControl;
   MetaCanvas.FillRect(0, 0, MetaCanvas.Width, MetaCanvas.Height);
 
@@ -663 +663 @@
 begin
   with Canvas do begin
-    Font.Color := Core.Core.ThemeManager1.Theme.ColorControlText;
+    Font.Color := Core.Core.ThemeManager1.ActualTheme.ColorControlText;
     Font.Size := Trunc(ScaleX(BoxFontSize, 96));
 
@@ -671 +671 @@
 
     Brush.Style := bsSolid;
-    Brush.Color := Core.Core.ThemeManager1.Theme.ColorWindow;
+    Brush.Color := Core.Core.ThemeManager1.ActualTheme.ColorWindow;
     FillRect(Pos.X, Pos.Y, Pos.X + BoxSize.Width, Pos.Y + BoxSize.Height);
 
@@ -678 +678 @@
 
     Brush.Style := bsClear;
-    Font.Color := Core.Core.ThemeManager1.Theme.ColorControlText;
+    Font.Color := Core.Core.ThemeManager1.ActualTheme.ColorControlText;
     Font.Size := Trunc(ScaleX(BoxFontSize, 96));
     TextOut(Pos.X + (BoxSize.Width - TextWidth(Value)) div 2,
@@ -1146 +1146 @@
   Color: TPixel32;
 begin
-  if (Core.Core.ThemeManager1.Theme.Name = ThemeNameDark) or
-  ((Core.Core.ThemeManager1.Theme.Name = ThemeNameSystem) and
+  if (Core.Core.ThemeManager1.ActualTheme.Name = ThemeNameDark) or
+  ((Core.Core.ThemeManager1.ActualTheme.Name = ThemeNameSystem) and
   Core.Core.ThemeManager1.IsDarkTheme)
   then begin

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
@@ -30 +30 @@
   private
     FTheme: TTheme;
+    FActualTheme: TTheme;
     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;
@@ -42 +45 @@
     procedure UseTheme(Form: TForm);
     property Theme: TTheme read FTheme write SetTheme;
+    property ActualTheme: TTheme read FActualTheme;
   end;
 
@@ -105 +109 @@
 
 function TThemeManager.IsDarkTheme: Boolean;
-begin
-  Result := Gray(ColorToRGB(clWindow)) < Gray(ColorToRGB(clWindowText));
-end;
-
-procedure TThemeManager.SetThemeName(AValue: TTheme);
+{$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);
+type
+  TDwmSetWindowAttribute = function(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HRESULT; stdcall;
+const
+  DwmapiLibName = 'dwmapi.dll';
+  DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1 = 19;
+  DWMWA_USE_IMMERSIVE_DARK_MODE = 20;
+var
+  DwmapiLib: TLibHandle;
+  DwmSetWindowAttribute: TDwmSetWindowAttribute;
+  Attr: DWord;
+begin
+  DwmapiLib := LoadLibrary(DwmapiLibName);
+  if DwmapiLib <> 0 then DwmSetWindowAttribute := GetProcAddress(DwmapiLib, 'DwmSetWindowAttribute')
+    else DwmSetWindowAttribute := nil;
+
+  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;
+  if DwmapiLib <> 0 then FreeLibrary(DwmapiLib);
+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;
 
@@ -132 +204 @@
     ColorControlSelected := clWindow;
   end;
-  Theme := TTheme(Themes.First);
   with Themes.AddNew(ThemeNameDark) do begin
     ColorWindow := RGBToColor($20, $20, $20);
@@ -147 +218 @@
     ColorControlSelected := RGBToColor(196, 225, 255);
   end;
+  Theme := TTheme(Themes.First);
 end;
 
@@ -170 +242 @@
     (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;
 
@@ -195 +267 @@
 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;