unit UWSystem.DarkTheme;
// -----------------------------------------------------------------------------
{$mode ObjFPC}{$H+}
interface
uses
Windows, Forms, Classes, SysUtils, Controls, StdCtrls, Menus;
const
dwmapi_lib = 'dwmapi.dll';
DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1 = 19;
DWMWA_USE_IMMERSIVE_DARK_MODE = 20;
uxtheme_lib = 'uxtheme.dll';
BackColor: Integer = $1E1E1E;
TextColor: Integer = $F0F0F0;
InputBackColor: Integer = $303030;
type
// 1903 18362
TPreferredAppMode =
(
Default,
AllowDark,
ForceDark,
ForceLight,
Max
);
// 1809 17763
TShouldAppsUseDarkMode = function(): bool; stdcall; // ordinal 132
TAllowDarkModeForWindow = function(hWnd: HWND; allow: bool): bool; stdcall; // ordinal 133
TAllowDarkModeForApp = function(allow: bool): bool; stdcall; // ordinal 135, in 1809
TFlushMenuThemes = procedure(); stdcall; // ordinal 136
TRefreshImmersiveColorPolicyState = procedure(); stdcall; // ordinal 104
// 18334
TSetPreferredAppMode = function(appMode: TPreferredAppMode): TPreferredAppMode; stdcall; // ordinal 135, 1903
TDwmSetWindowAttribute = function(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HRESULT; stdcall;
TSetWindowTheme = function(hwnd: HWND; pszSubAppName: LPCWSTR; pszSubIdList: LPCWSTR): HRESULT; stdcall;
{ TUWDarkMode }
TUWDarkMode = class
private
hLibDWM: TLibHandle;
DwmSetWindowAttribute: TDwmSetWindowAttribute;
hLibUX: HMODULE;
SetWindowTheme: TSetWindowTheme;
ShouldAppsUseDarkMode: TShouldAppsUseDarkMode;
AllowDarkModeForWindow: TAllowDarkModeForWindow;
AllowDarkModeForApp: TAllowDarkModeForApp;
FlushMenuThemes: TFlushMenuThemes;
RefreshImmersiveColorPolicyState: TRefreshImmersiveColorPolicyState;
SetPreferredAppMode: TSetPreferredAppMode;
procedure MyAllowDarkModeForApp(const allow: Bool);
public
constructor Create(const AForm: TForm);
destructor Destroy; override;
function Loaded: Boolean;
function SetDarkMode(const AForm: TForm; const AValue: Bool = True): Boolean;
end;
procedure MyFillMenuBkg(const AMenu: TMenu);
function IsWindows10OrGreater(const ABuild: Integer = 0): Boolean;
// -----------------------------------------------------------------------------
implementation
// -----------------------------------------------------------------------------
{ TUWDarkMode }
// -----------------------------------------------------------------------------
constructor TUWDarkMode.Create(const AForm: TForm);
begin
DwmSetWindowAttribute := NIL;
SetWindowTheme := NIL;
hLibDWM := LoadLibraryExW(dwmapi_lib, 0, LOAD_LIBRARY_SEARCH_SYSTEM32);
if hLibDWM <> 0 then Pointer(DwmSetWindowAttribute) := GetProcAddress(hLibDWM, 'DwmSetWindowAttribute');
hLibUX := LoadLibraryExW(uxtheme_lib, 0, LOAD_LIBRARY_SEARCH_SYSTEM32);
if hLibUX <> 0 then
begin
Pointer(SetWindowTheme) := GetProcAddress(hLibUX, 'SetWindowTheme');
Pointer(RefreshImmersiveColorPolicyState) := GetProcAddress(hLibUX, MakeIntResource(104));
Pointer(ShouldAppsUseDarkMode) := GetProcAddress(hLibUX, MakeIntResource(132));
Pointer(AllowDarkModeForWindow) := GetProcAddress(hLibUX, MakeIntResource(133));
Pointer(FlushMenuThemes) := GetProcAddress(hLibUX, MakeIntResource(136));
if not IsWindows10OrGreater(18362) then
Pointer(AllowDarkModeForApp) := GetProcAddress(hLibUX, MakeIntResource(135))
else
Pointer(SetPreferredAppMode) := GetProcAddress(hLibUX, MakeIntResource(135));
end;
SetDarkMode(AForm);
end;
// -----------------------------------------------------------------------------
destructor TUWDarkMode.Destroy;
begin
if Pointer(DwmSetWindowAttribute) <> NIL then DwmSetWindowAttribute := NIL;
if hLibDWM <> 0 then FreeLibrary(hLibDWM);
if Pointer(SetWindowTheme) <> NIL then SetWindowTheme := NIL;
if Pointer(ShouldAppsUseDarkMode) <> NIL then ShouldAppsUseDarkMode := NIL;
if Pointer(AllowDarkModeForWindow) <> NIL then AllowDarkModeForWindow := NIL;
if Pointer(AllowDarkModeForApp) <> NIL then AllowDarkModeForApp := NIL;
if Pointer(FlushMenuThemes) <> NIL then FlushMenuThemes := NIL;
if Pointer(RefreshImmersiveColorPolicyState) <> NIL then RefreshImmersiveColorPolicyState := NIL;
if hLibUX <> 0 then FreeLibrary(hLibUX);
inherited Destroy;
end;
// -----------------------------------------------------------------------------
function TUWDarkMode.Loaded: Boolean;
begin
Result := (hLibDWM <> 0) and (hLibUX <> 0)
and Assigned(DwmSetWindowAttribute) and Assigned(SetWindowTheme);
end;
// -----------------------------------------------------------------------------
procedure TUWDarkMode.MyAllowDarkModeForApp(const allow: Bool);
begin
if Assigned(AllowDarkModeForApp) then
AllowDarkModeForApp(allow)
else if Assigned(SetPreferredAppMode) then
begin
if allow then
SetPreferredAppMode(ForceDark)
else
SetPreferredAppMode(Default);
end;
end;
// -----------------------------------------------------------------------------
function TUWDarkMode.SetDarkMode(const AForm: TForm; const AValue: Bool = True): Boolean;
var
attr: DWord;
C: TComponent;
begin
Result := False;
if (AForm = NIL) or not Loaded then Exit;
MyAllowDarkModeForApp(AValue);
AllowDarkModeForWindow(AForm.Handle, AValue);
RefreshImmersiveColorPolicyState;
FlushMenuThemes;
SetWindowTheme(AForm.Handle, 'DarkMode_Explorer', NIL);
if 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, @AValue, SizeOf(AValue));
end;
with AForm do
begin
Color := BackColor;
Font.Color := TextColor;
end;
for C in AForm do
begin
if (C is TWinControl) then
begin
if not TWinControl(C).IsParentColor then
TWinControl(C).Color := InputBackColor;
if (C is TComboBox) or (C is TEdit) or (C is TMemo) then
SetWindowTheme(TWinControl(C).Handle, 'DarkMode_CFD', NIL)
else
SetWindowTheme(TWinControl(C).Handle, 'DarkMode_Explorer', NIL);
end
else if (C is TMenu) then
MyFillMenuBkg(TMenu(C));
end;
Result := True;
end;
// -----------------------------------------------------------------------------
procedure MyFillMenuBkg(const AMenu: TMenu);
var
MenuInfo: TMenuInfo;
begin
if AMenu <> NIL then
begin
FillByte(MenuInfo, SizeOf(TMenuInfo), 0);
MenuInfo.cbSize := SizeOf(TMenuInfo);
MenuInfo.fMask := MIM_BACKGROUND or MIM_APPLYTOSUBMENUS or MIM_STYLE;
MenuInfo.hbrBack := CreateSolidBrush(InputBackColor);
SetMenuInfo(AMenu.Handle, @MenuInfo);
end;
end;
// -----------------------------------------------------------------------------
function IsWindows10OrGreater(const ABuild: Integer = 0): Boolean;
begin
Result := (Win32MajorVersion >= 10) and (Win32BuildNumber >= ABuild);
end;
// -----------------------------------------------------------------------------
end.