Recent

Author Topic: Dark mode class...  (Read 797 times)

Espectr0

  • New Member
  • *
  • Posts: 44
Dark mode class...
« on: May 15, 2022, 04:59:25 pm »
Hola,

I was thinking of making a class to implement "dark mode" in our applications in Windows 10 as I show in the images below (first image normal, second image dark mode).

For controls that don't support dark mode, maybe a custom paint can be implemented?

I await your comments, Greetings.

Code: Pascal  [Select][+][-]
  1. unit UWSystem.DarkTheme;
  2.  
  3. // -----------------------------------------------------------------------------
  4.  
  5. {$mode ObjFPC}{$H+}
  6.  
  7. interface
  8.  
  9. uses
  10.   Windows, Forms, Classes, SysUtils, dynlibs, Controls, StdCtrls;
  11.  
  12. const
  13.   dwmapi = 'dwmapi.dll';
  14.   DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1 = 19;
  15.   DWMWA_USE_IMMERSIVE_DARK_MODE = 20;
  16.  
  17.   uxtheme = 'uxtheme.dll';
  18.  
  19.   BackColor: Integer = $1E1E1E;
  20.   TextColor: Integer = $9B9B9B;
  21.  
  22. type
  23.  
  24.   { TUWDarkMode }
  25.  
  26.   TUWDarkMode = class
  27.   private
  28.     FDWMlib  : TLibHandle;
  29.     FDWMfunc : function(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HRESULT; stdcall;
  30.     FUXlib   : TLibHandle;
  31.     FUXfunc  : function(hwnd: HWND; pszSubAppName: LPCWSTR; pszSubIdList: LPCWSTR): HRESULT; stdcall;
  32.  
  33.     function IsWindows10OrGreater(const ABuild: Integer = -1): Boolean;
  34.   public
  35.     constructor Create(const AForm: TForm);
  36.     destructor Destroy; override;
  37.     function Loaded: Boolean;
  38.     function SetDarkMode(const AForm: TForm; const AValue: Bool = True): Boolean;
  39.   end;
  40.  
  41. // -----------------------------------------------------------------------------
  42.  
  43. implementation
  44.  
  45. // -----------------------------------------------------------------------------
  46.  
  47. { TUWDarkMode }
  48.  
  49. // -----------------------------------------------------------------------------
  50.  
  51. constructor TUWDarkMode.Create(const AForm: TForm);
  52. begin
  53.   FDWMfunc := NIL;
  54.   FUXfunc  := NIL;
  55.  
  56.   FDWMlib := LoadLibrary(dwmapi);
  57.   if FDWMlib <> 0 then Pointer(FDWMfunc) := GetProcAddress(FDWMlib, 'DwmSetWindowAttribute');
  58.  
  59.   FUXlib := LoadLibrary(uxtheme);
  60.   if FUXlib <> 0 then Pointer(FUXfunc) := GetProcAddress(FUXlib, 'SetWindowTheme');
  61.  
  62.   SetDarkMode(AForm);
  63. end;
  64.  
  65. // -----------------------------------------------------------------------------
  66.  
  67. destructor TUWDarkMode.Destroy;
  68. begin
  69.   if FDWMfunc <> NIL then FDWMfunc := NIL;
  70.   if FDWMlib <> 0 then FreeLibrary(FDWMlib);
  71.  
  72.   if FUXfunc <> NIL then FUXfunc := NIL;
  73.   if FUXlib <> 0 then FreeLibrary(FUXlib);
  74.  
  75.   inherited Destroy;
  76. end;
  77.  
  78. // -----------------------------------------------------------------------------
  79.  
  80. function TUWDarkMode.Loaded: Boolean;
  81. begin
  82.   Result := (FDWMlib <> 0) and (FUXlib <> 0)
  83.     and Assigned(FDWMfunc) and Assigned(FUXfunc);
  84. end;
  85.  
  86. // -----------------------------------------------------------------------------
  87.  
  88. function TUWDarkMode.SetDarkMode(const AForm: TForm; const AValue: Bool = True): Boolean;
  89. var
  90.   attr: DWord;
  91.   i: Integer;
  92. begin
  93.   Result := False;
  94.   if AForm = NIL then Exit;
  95.  
  96.   if IsWindows10OrGreater(17763) then
  97.   begin
  98.     attr := DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1;
  99.     if IsWindows10OrGreater(18985) then attr := DWMWA_USE_IMMERSIVE_DARK_MODE;
  100.  
  101.     FDWMfunc(AForm.Handle, attr, @AValue, SizeOf(AValue));
  102.   end;
  103.  
  104.   with AForm do
  105.   begin
  106.     Color := BackColor;
  107.     Font.Color := TextColor;
  108.   end;
  109.  
  110.   for i := 0 to AForm.ComponentCount-1 do
  111.   begin
  112.     if AForm.Components[i] is TWinControl then
  113.       FUXfunc((AForm.Components[i] as TWinControl).Handle, 'DarkMode_Explorer', NIL);
  114.   end;
  115.  
  116.   Result := True;
  117. end;
  118.  
  119. // -----------------------------------------------------------------------------
  120.  
  121. function TUWDarkMode.IsWindows10OrGreater(const ABuild: Integer = -1): Boolean;
  122. begin
  123.   Result := (Win32MajorVersion >= 10) and (Win32BuildNumber >= ABuild);
  124. end;
  125.  
  126. // -----------------------------------------------------------------------------
  127.  
  128. end.
  129.  

AlexTP

  • Hero Member
  • *****
  • Posts: 1808
    • UVviewsoft
Re: Dark mode class...
« Reply #1 on: May 15, 2022, 06:21:29 pm »

Espectr0

  • New Member
  • *
  • Posts: 44
Re: Dark mode class...
« Reply #2 on: May 15, 2022, 10:42:54 pm »
Gracias @AlexTP, I will check it later.

Thinking about the other controls (not menu), I have modified the class a bit and managed more colors except the CheckBox and RadioButton, can't change the font color?



Wallaby

  • New Member
  • *
  • Posts: 42
Re: Dark mode class...
« Reply #4 on: May 16, 2022, 02:29:05 pm »
I was able to implement nearly full dark mode support for my applications.

For certain theme-drawn controls such as CheckBox/Radio, GroupBox, TabSeet, StatusBar and Progress bar you will need to go deeper and subclass them with SetWindowSubclass.

In the subclass routine you'd need to intercept WM_PAINT and WM_ERASEBKGND and custom-draw these controls.

Espectr0

  • New Member
  • *
  • Posts: 44
Re: Dark mode class...
« Reply #5 on: May 16, 2022, 07:57:10 pm »
playing a little more I managed to paint the menu using TMenuInfo, except main menu form :S
Also system menu is dark tool.

Wallaby

  • New Member
  • *
  • Posts: 42
Re: Dark mode class...
« Reply #6 on: May 16, 2022, 11:51:29 pm »
Use this:
Code: Pascal  [Select][+][-]
  1. MenuInfo := Default(TMenuinfo);
  2. MenuInfo.cbSize := SizeOf(TMenuinfo);
  3. MenuInfo.fMask := MIM_BACKGROUND or MIM_APPLYTOSUBMENUS;
  4. MenuInfo.hbrBack := CreateSolidBrush(clBlack);
  5. Win32Check(SetMenuInfo(TMenu(Component).Handle, @MenuInfo));

Espectr0

  • New Member
  • *
  • Posts: 44
Re: Dark mode class...
« Reply #7 on: May 18, 2022, 11:57:02 pm »
@Wallaby, I have it implemented but it doesn't paint the main menu bar...
Anyway, I paste the code in case someone finds it useful and wants to improve it :)

Code: Pascal  [Select][+][-]
  1. unit UWSystem.DarkTheme;
  2.  
  3. // -----------------------------------------------------------------------------
  4.  
  5. {$mode ObjFPC}{$H+}
  6.  
  7. interface
  8.  
  9. uses
  10.   Windows, Forms, Classes, SysUtils, Controls, StdCtrls, Menus;
  11.  
  12. const
  13.   dwmapi_lib = 'dwmapi.dll';
  14.   DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1 = 19;
  15.   DWMWA_USE_IMMERSIVE_DARK_MODE = 20;
  16.  
  17.   uxtheme_lib = 'uxtheme.dll';
  18.  
  19.   BackColor: Integer = $1E1E1E;
  20.   TextColor: Integer = $F0F0F0;
  21.   InputBackColor: Integer = $303030;
  22.  
  23. type
  24.  
  25.   // 1903 18362
  26.   TPreferredAppMode =
  27.   (
  28.     Default,
  29.     AllowDark,
  30.     ForceDark,
  31.     ForceLight,
  32.     Max
  33.   );
  34.  
  35.   // 1809 17763
  36.   TShouldAppsUseDarkMode = function(): bool; stdcall; // ordinal 132
  37.   TAllowDarkModeForWindow = function(hWnd: HWND; allow: bool): bool; stdcall; // ordinal 133
  38.   TAllowDarkModeForApp = function(allow: bool): bool; stdcall; // ordinal 135, in 1809
  39.   TFlushMenuThemes = procedure(); stdcall; // ordinal 136
  40.   TRefreshImmersiveColorPolicyState = procedure(); stdcall; // ordinal 104
  41.   // 18334
  42.   TSetPreferredAppMode = function(appMode: TPreferredAppMode): TPreferredAppMode; stdcall; // ordinal 135, 1903
  43.  
  44.   TDwmSetWindowAttribute = function(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HRESULT; stdcall;
  45.   TSetWindowTheme = function(hwnd: HWND; pszSubAppName: LPCWSTR; pszSubIdList: LPCWSTR): HRESULT; stdcall;
  46.  
  47.   { TUWDarkMode }
  48.  
  49.   TUWDarkMode = class
  50.   private
  51.     hLibDWM: TLibHandle;
  52.     DwmSetWindowAttribute: TDwmSetWindowAttribute;
  53.     hLibUX: HMODULE;
  54.     SetWindowTheme: TSetWindowTheme;
  55.  
  56.     ShouldAppsUseDarkMode: TShouldAppsUseDarkMode;
  57.     AllowDarkModeForWindow: TAllowDarkModeForWindow;
  58.     AllowDarkModeForApp: TAllowDarkModeForApp;
  59.     FlushMenuThemes: TFlushMenuThemes;
  60.     RefreshImmersiveColorPolicyState: TRefreshImmersiveColorPolicyState;
  61.     SetPreferredAppMode: TSetPreferredAppMode;
  62.  
  63.     procedure MyAllowDarkModeForApp(const allow: Bool);
  64.   public
  65.     constructor Create(const AForm: TForm);
  66.     destructor Destroy; override;
  67.     function Loaded: Boolean;
  68.     function SetDarkMode(const AForm: TForm; const AValue: Bool = True): Boolean;
  69.   end;
  70.  
  71. procedure MyFillMenuBkg(const AMenu: TMenu);
  72. function IsWindows10OrGreater(const ABuild: Integer = 0): Boolean;
  73.  
  74. // -----------------------------------------------------------------------------
  75.  
  76. implementation
  77.  
  78. // -----------------------------------------------------------------------------
  79.  
  80. { TUWDarkMode }
  81.  
  82. // -----------------------------------------------------------------------------
  83.  
  84. constructor TUWDarkMode.Create(const AForm: TForm);
  85. begin
  86.   DwmSetWindowAttribute := NIL;
  87.   SetWindowTheme  := NIL;
  88.  
  89.   hLibDWM := LoadLibraryExW(dwmapi_lib, 0, LOAD_LIBRARY_SEARCH_SYSTEM32);
  90.   if hLibDWM <> 0 then Pointer(DwmSetWindowAttribute) := GetProcAddress(hLibDWM, 'DwmSetWindowAttribute');
  91.  
  92.   hLibUX := LoadLibraryExW(uxtheme_lib, 0, LOAD_LIBRARY_SEARCH_SYSTEM32);
  93.   if hLibUX <> 0 then
  94.   begin
  95.     Pointer(SetWindowTheme) := GetProcAddress(hLibUX, 'SetWindowTheme');
  96.     Pointer(RefreshImmersiveColorPolicyState) := GetProcAddress(hLibUX, MakeIntResource(104));
  97.     Pointer(ShouldAppsUseDarkMode) := GetProcAddress(hLibUX, MakeIntResource(132));
  98.     Pointer(AllowDarkModeForWindow) := GetProcAddress(hLibUX, MakeIntResource(133));
  99.     Pointer(FlushMenuThemes) := GetProcAddress(hLibUX, MakeIntResource(136));
  100.  
  101.     if not IsWindows10OrGreater(18362) then
  102.       Pointer(AllowDarkModeForApp) := GetProcAddress(hLibUX, MakeIntResource(135))
  103.     else
  104.       Pointer(SetPreferredAppMode) := GetProcAddress(hLibUX, MakeIntResource(135));
  105.   end;
  106.  
  107.   SetDarkMode(AForm);
  108. end;
  109.  
  110. // -----------------------------------------------------------------------------
  111.  
  112. destructor TUWDarkMode.Destroy;
  113. begin
  114.   if Pointer(DwmSetWindowAttribute) <> NIL then DwmSetWindowAttribute := NIL;
  115.   if hLibDWM <> 0 then FreeLibrary(hLibDWM);
  116.  
  117.   if Pointer(SetWindowTheme) <> NIL then SetWindowTheme := NIL;
  118.  
  119.   if Pointer(ShouldAppsUseDarkMode) <> NIL then ShouldAppsUseDarkMode := NIL;
  120.   if Pointer(AllowDarkModeForWindow) <> NIL then AllowDarkModeForWindow := NIL;
  121.   if Pointer(AllowDarkModeForApp) <> NIL then AllowDarkModeForApp := NIL;
  122.   if Pointer(FlushMenuThemes) <> NIL then FlushMenuThemes := NIL;
  123.   if Pointer(RefreshImmersiveColorPolicyState) <> NIL then RefreshImmersiveColorPolicyState := NIL;
  124.  
  125.   if hLibUX <> 0 then FreeLibrary(hLibUX);
  126.  
  127.   inherited Destroy;
  128. end;
  129.  
  130. // -----------------------------------------------------------------------------
  131.  
  132. function TUWDarkMode.Loaded: Boolean;
  133. begin
  134.   Result := (hLibDWM <> 0) and (hLibUX <> 0)
  135.     and Assigned(DwmSetWindowAttribute) and Assigned(SetWindowTheme);
  136. end;
  137.  
  138. // -----------------------------------------------------------------------------
  139.  
  140. procedure TUWDarkMode.MyAllowDarkModeForApp(const allow: Bool);
  141. begin
  142.   if Assigned(AllowDarkModeForApp) then
  143.      AllowDarkModeForApp(allow)
  144.    else if Assigned(SetPreferredAppMode) then
  145.    begin
  146.      if allow then
  147.        SetPreferredAppMode(ForceDark)
  148.      else
  149.        SetPreferredAppMode(Default);
  150.    end;
  151. end;
  152.  
  153. // -----------------------------------------------------------------------------
  154.  
  155. function TUWDarkMode.SetDarkMode(const AForm: TForm; const AValue: Bool = True): Boolean;
  156. var
  157.   attr: DWord;
  158.   C: TComponent;
  159. begin
  160.   Result := False;
  161.   if (AForm = NIL) or not Loaded then Exit;
  162.  
  163.   MyAllowDarkModeForApp(AValue);
  164.   AllowDarkModeForWindow(AForm.Handle, AValue);
  165.   RefreshImmersiveColorPolicyState;
  166.   FlushMenuThemes;
  167.   SetWindowTheme(AForm.Handle, 'DarkMode_Explorer', NIL);
  168.  
  169.   if IsWindows10OrGreater(17763) then
  170.   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, @AValue, SizeOf(AValue));
  175.   end;
  176.  
  177.   with AForm do
  178.   begin
  179.     Color      := BackColor;
  180.     Font.Color := TextColor;
  181.   end;
  182.  
  183.   for C in AForm do
  184.   begin
  185.     if (C is TWinControl) then
  186.     begin
  187.       if not TWinControl(C).IsParentColor then
  188.         TWinControl(C).Color := InputBackColor;
  189.  
  190.       if (C is TComboBox) or (C is TEdit) or (C is TMemo) then
  191.         SetWindowTheme(TWinControl(C).Handle, 'DarkMode_CFD', NIL)
  192.       else
  193.         SetWindowTheme(TWinControl(C).Handle, 'DarkMode_Explorer', NIL);
  194.     end
  195.     else if (C is TMenu) then
  196.       MyFillMenuBkg(TMenu(C));
  197.   end;
  198.  
  199.   Result := True;
  200. end;
  201.  
  202. // -----------------------------------------------------------------------------
  203.  
  204. procedure MyFillMenuBkg(const AMenu: TMenu);
  205. var
  206.   MenuInfo: TMenuInfo;
  207. begin
  208.   if AMenu <> NIL then
  209.   begin
  210.     FillByte(MenuInfo, SizeOf(TMenuInfo), 0);
  211.     MenuInfo.cbSize  := SizeOf(TMenuInfo);
  212.     MenuInfo.fMask   := MIM_BACKGROUND or MIM_APPLYTOSUBMENUS or MIM_STYLE;
  213.     MenuInfo.hbrBack := CreateSolidBrush(InputBackColor);
  214.     SetMenuInfo(AMenu.Handle, @MenuInfo);
  215.   end;
  216. end;
  217.  
  218. // -----------------------------------------------------------------------------
  219.  
  220. function IsWindows10OrGreater(const ABuild: Integer = 0): Boolean;
  221. begin
  222.   Result := (Win32MajorVersion >= 10) and (Win32BuildNumber >= ABuild);
  223. end;
  224.  
  225. // -----------------------------------------------------------------------------
  226.  
  227. end.
  228.  

 

TinyPortal © 2005-2018