Initial commit
This commit is contained in:
alinvip22@gmail.com
@@ -0,0 +1,2 @@
|
||||
# Auto detect text files and perform LF normalization
|
||||
* text=auto
|
||||
+69
@@ -0,0 +1,69 @@
|
||||
# Uncomment these types if you want even more clean repository. But be careful.
|
||||
# It can make harm to an existing project source. Read explanations below.
|
||||
#
|
||||
# Resource files are binaries containing manifest, project icon and version info.
|
||||
# They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files.
|
||||
#*.res
|
||||
#
|
||||
# Type library file (binary). In old Delphi versions it should be stored.
|
||||
# Since Delphi 2009 it is produced from .ridl file and can safely be ignored.
|
||||
#*.tlb
|
||||
#
|
||||
# Diagram Portfolio file. Used by the diagram editor up to Delphi 7.
|
||||
# Uncomment this if you are not using diagrams or use newer Delphi version.
|
||||
#*.ddp
|
||||
#
|
||||
# Visual LiveBindings file. Added in Delphi XE2.
|
||||
# Uncomment this if you are not using LiveBindings Designer.
|
||||
#*.vlb
|
||||
#
|
||||
# Deployment Manager configuration file for your project. Added in Delphi XE2.
|
||||
# Uncomment this if it is not mobile development and you do not use remote debug feature.
|
||||
#*.deployproj
|
||||
#
|
||||
# C++ object files produced when C/C++ Output file generation is configured.
|
||||
# Uncomment this if you are not using external objects (zlib library for example).
|
||||
#*.obj
|
||||
#
|
||||
|
||||
# Delphi compiler-generated binaries (safe to delete)
|
||||
*.exe
|
||||
*.dll
|
||||
*.bpl
|
||||
*.bpi
|
||||
*.dcp
|
||||
*.so
|
||||
*.apk
|
||||
*.drc
|
||||
*.map
|
||||
*.dres
|
||||
*.rsm
|
||||
*.tds
|
||||
*.dcu
|
||||
*.lib
|
||||
*.a
|
||||
*.o
|
||||
*.ocx
|
||||
|
||||
# Delphi autogenerated files (duplicated info)
|
||||
*.cfg
|
||||
*.hpp
|
||||
*Resource.rc
|
||||
|
||||
# Delphi local files (user-specific info)
|
||||
*.local
|
||||
*.identcache
|
||||
*.projdata
|
||||
*.tvsconfig
|
||||
*.dsk
|
||||
|
||||
# Delphi history and backups
|
||||
__history/
|
||||
__recovery/
|
||||
*.~*
|
||||
|
||||
# Castalia statistics file (since XE7 Castalia is distributed with Delphi)
|
||||
*.stat
|
||||
|
||||
# Boss dependency manager vendor folder https://github.com/HashLoad/boss
|
||||
modules/
|
||||
@@ -0,0 +1,35 @@
|
||||
unit DarkModeApi.Consts;
|
||||
|
||||
interface
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
|
||||
uses
|
||||
System.UITypes;
|
||||
|
||||
const
|
||||
BackColor: TColor = $1E1E1E;
|
||||
TextColor: TColor = $F0F0F0;
|
||||
InputBackColor: TColor = $303030;
|
||||
Dwmapi = 'DWMAPI.DLL';
|
||||
CDarkModeExplorer = 'DarkMode_Explorer';
|
||||
CModeExplorer = 'Explorer';
|
||||
CDarkModeControlCFD = 'DarkMode_CFD';
|
||||
DWM_CLOAKED_APP = $0000001;
|
||||
DWM_CLOAKED_SHELL = $0000002;
|
||||
DWM_CLOAKED_INHERITED = $0000004;
|
||||
ODS_NOACCEL = $0100;
|
||||
WM_UAHDESTROYWINDOW = $0090; // handled by DefWindowProc
|
||||
WM_UAHDRAWMENU = $0091; // lParam is UAHMENU
|
||||
WM_UAHDRAWMENUITEM = $0092; // lParam is UAHDRAWMENUITEM
|
||||
WM_UAHINITMENU = $0093; // handled by DefWindowProc
|
||||
WM_UAHMEASUREMENUITEM = $0094; // lParam is UAHMEASUREMENUITEM
|
||||
WM_UAHNCPAINTMENUPOPUP = $0095; // handled by DefWindowProc
|
||||
WM_UAHUPDATE = $0096;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,75 @@
|
||||
unit DarkModeApi.FMX;
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
interface
|
||||
|
||||
uses
|
||||
FMX.Forms, FMX.Types;
|
||||
|
||||
type
|
||||
TFormHelper = class helper for TForm
|
||||
procedure SetWindowColorModeAsSystem;
|
||||
procedure SetWindowColorMode(IsDark: Boolean);
|
||||
class function SystemIsDarkMode: Boolean;
|
||||
end;
|
||||
|
||||
procedure SetWindowColorModeAsSystemFor(Handle: TWindowHandle);
|
||||
|
||||
procedure SetWindowColorModeFor(Handle: TWindowHandle; IsDark: Boolean);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
DarkModeApi, FMX.Platform.Win, Winapi.Windows;
|
||||
|
||||
procedure SetWindowColorModeAsSystemFor(Handle: TWindowHandle);
|
||||
var
|
||||
Value: LongBool;
|
||||
WinHandle: HWND;
|
||||
begin
|
||||
Value := IsDarkMode;
|
||||
WinHandle := FmxHandleToHWND(Handle);
|
||||
DwmSetWindowAttribute(WinHandle, ImmersiveDarkMode, Value, SizeOf(Value));
|
||||
AllowDarkModeForWindow(WinHandle, Value);
|
||||
AllowDarkModeForApp(Value);
|
||||
end;
|
||||
|
||||
procedure SetWindowColorModeFor(Handle: TWindowHandle; IsDark: Boolean);
|
||||
var
|
||||
Value: LongBool;
|
||||
WinHandle: HWND;
|
||||
begin
|
||||
Value := IsDark;
|
||||
WinHandle := FmxHandleToHWND(Handle);
|
||||
DwmSetWindowAttribute(WinHandle, ImmersiveDarkMode, Value, SizeOf(Value));
|
||||
AllowDarkModeForWindow(WinHandle, Value);
|
||||
AllowDarkModeForApp(Value);
|
||||
end;
|
||||
|
||||
{ TFormHelper }
|
||||
|
||||
procedure TFormHelper.SetWindowColorMode(IsDark: Boolean);
|
||||
begin
|
||||
SetWindowColorModeFor(handle, IsDark);
|
||||
end;
|
||||
|
||||
procedure TFormHelper.SetWindowColorModeAsSystem;
|
||||
begin
|
||||
SetWindowColorModeAsSystemFor(Handle);
|
||||
end;
|
||||
|
||||
class function TFormHelper.SystemIsDarkMode: Boolean;
|
||||
begin
|
||||
Result := IsDarkMode;
|
||||
end;
|
||||
|
||||
{$ELSE}
|
||||
|
||||
interface
|
||||
|
||||
implementation
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,101 @@
|
||||
unit DarkModeApi.Types;
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
{$ALIGN ON}
|
||||
{$MINENUMSIZE 4}
|
||||
{$WEAKPACKAGEUNIT}
|
||||
{$WARN SYMBOL_PLATFORM OFF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Winapi.Windows;
|
||||
|
||||
type
|
||||
TWinRoundType = (wrtDEFAULT = 0, wrtDONOTROUND = 1, wrtROUND = 2, wrtROUNDSMALL = 3);
|
||||
|
||||
TDwmWindowAttribute = (DWMWA_NCRENDERING_ENABLED = 1, DWMWA_NCRENDERING_POLICY, DWMWA_TRANSITIONS_FORCEDISABLED, DWMWA_ALLOW_NCPAINT, DWMWA_CAPTION_BUTTON_BOUNDS, DWMWA_NONCLIENT_RTL_LAYOUT, DWMWA_FORCE_ICONIC_REPRESENTATION, DWMWA_FLIP3D_POLICY, DWMWA_EXTENDED_FRAME_BOUNDS, DWMWA_HAS_ICONIC_BITMAP, DWMWA_DISALLOW_PEEK, DWMWA_EXCLUDED_FROM_PEEK, DWMWA_CLOAK, DWMWA_CLOAKED, DWMWA_FREEZE_REPRESENTATION, DWMWA_PASSIVE_UPDATE_MODE, DWMWA_USE_HOSTBACKDROPBRUSH, DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1 = 19, DWMWA_USE_IMMERSIVE_DARK_MODE = 20, DWMWA_WINDOW_CORNER_PREFERENCE = 33, DWMWA_BORDER_COLOR, DWMWA_CAPTION_COLOR, DWMWA_TEXT_COLOR, DWMWA_VISIBLE_FRAME_BORDER_THICKNESS, DWMWA_SYSTEMBACKDROP_TYPE, DWMWA_LAST);
|
||||
|
||||
TDWMWindowCornerPreference = (DWMWCP_DEFAULT = 0, DWMWCP_DONOTROUND = 1, DWMWCP_ROUND = 2, DWMWCP_ROUNDSMALL = 3);
|
||||
|
||||
TImmersiveHCCacheMode = (IHCM_USE_CACHED_VALUE, IHCM_REFRESH);
|
||||
|
||||
TPreferredAppMode = (DefaultMode, AllowDarkMode, ForceDarkMode, ForceLightMode, ModeMax);
|
||||
|
||||
TWindowCompositionAttribute = (WCA_UNDEFINED = 0, //
|
||||
WCA_NCRENDERING_ENABLED = 1, //
|
||||
WCA_NCRENDERING_POLICY = 2, //
|
||||
WCA_TRANSITIONS_FORCEDISABLED = 3, //
|
||||
WCA_ALLOW_NCPAINT = 4, //
|
||||
WCA_CAPTION_BUTTON_BOUNDS = 5, //
|
||||
WCA_NONCLIENT_RTL_LAYOUT = 6, //
|
||||
WCA_FORCE_ICONIC_REPRESENTATION = 7, //
|
||||
WCA_EXTENDED_FRAME_BOUNDS = 8, //
|
||||
WCA_HAS_ICONIC_BITMAP = 9, //
|
||||
WCA_THEME_ATTRIBUTES = 10, //
|
||||
WCA_NCRENDERING_EXILED = 11, //
|
||||
WCA_NCADORNMENTINFO = 12, //
|
||||
WCA_EXCLUDED_FROM_LIVEPREVIEW = 13, //
|
||||
WCA_VIDEO_OVERLAY_ACTIVE = 14, //
|
||||
WCA_FORCE_ACTIVEWINDOW_APPEARANCE = 15, //
|
||||
WCA_DISALLOW_PEEK = 16, //
|
||||
WCA_CLOAK = 17, //
|
||||
WCA_CLOAKED = 18, //
|
||||
WCA_ACCENT_POLICY = 19, //
|
||||
WCA_FREEZE_REPRESENTATION = 20, //
|
||||
WCA_EVER_UNCLOAKED = 21, //
|
||||
WCA_VISUAL_OWNER = 22, //
|
||||
WCA_HOLOGRAPHIC = 23, //
|
||||
WCA_EXCLUDED_FROM_DDA = 24, //
|
||||
WCA_PASSIVEUPDATEMODE = 25, //
|
||||
WCA_USEDARKMODECOLORS = 26, //
|
||||
WCA_LAST = 27);
|
||||
|
||||
TWindowCompositionAttrib = TWindowCompositionAttribute;
|
||||
|
||||
WINDOWCOMPOSITIONATTRIBDATA = record
|
||||
Attrib: TWindowCompositionAttribute;
|
||||
pvData: Pointer;
|
||||
cbData: SIZE_T;
|
||||
end;
|
||||
|
||||
TWindowCompositionAttribData = WINDOWCOMPOSITIONATTRIBDATA;
|
||||
|
||||
PWindowCompositionAttribData = ^TWindowCompositionAttribData;
|
||||
|
||||
TRtlGetNtVersionNumbers = procedure(var major, minor, build: DWORD); stdcall;
|
||||
|
||||
TSetWindowCompositionAttribute = function(hWnd: HWND; pData: PWindowCompositionAttribData): BOOL; stdcall;
|
||||
|
||||
TShouldAppsUseDarkMode = function: BOOL; stdcall;
|
||||
|
||||
TAllowDarkModeForWindow = function(hWnd: HWND; allow: BOOL): BOOL; stdcall;
|
||||
|
||||
TAllowDarkModeForApp = function(allow: BOOL): BOOL; stdcall;
|
||||
|
||||
TRefreshImmersiveColorPolicyState = procedure; stdcall;
|
||||
|
||||
TIsDarkModeAllowedForWindow = function(hWnd: HWND): BOOL; stdcall;
|
||||
|
||||
TGetIsImmersiveColorUsingHighContrast = function(mode: TImmersiveHCCacheMode): BOOL; stdcall;
|
||||
|
||||
TOpenNcThemeData = function(hWnd: HWND; pszClassList: LPCWSTR): THandle; stdcall;
|
||||
|
||||
TShouldSystemUseDarkMode = function: BOOL; stdcall;
|
||||
|
||||
TSetPreferredAppMode = function(appMode: TPreferredAppMode): TPreferredAppMode; stdcall;
|
||||
|
||||
TIsDarkModeAllowedForApp = function: BOOL; stdcall;
|
||||
|
||||
implementation
|
||||
|
||||
{$ELSE}
|
||||
|
||||
interface
|
||||
|
||||
implementation
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,62 @@
|
||||
unit DarkModeApi.Vcl;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Vcl.Forms;
|
||||
|
||||
type
|
||||
TFormHelper = class helper for TForm
|
||||
procedure SetWindowColorModeAsSystem;
|
||||
procedure SetWindowColorMode(IsDark: Boolean);
|
||||
class function SystemIsDarkMode: Boolean;
|
||||
end;
|
||||
|
||||
procedure SetWindowColorModeAsSystemFor(Handle: THandle);
|
||||
|
||||
procedure SetWindowColorModeFor(Handle: THandle; IsDark: Boolean);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
DarkModeApi, FMX.Platform.Win, Winapi.Windows;
|
||||
|
||||
procedure SetWindowColorModeAsSystemFor(Handle: THandle);
|
||||
var
|
||||
Value: LongBool;
|
||||
begin
|
||||
Value := IsDarkMode;
|
||||
DwmSetWindowAttribute(Handle, ImmersiveDarkMode, Value, SizeOf(Value));
|
||||
AllowDarkModeForWindow(Handle, Value);
|
||||
AllowDarkModeForApp(Value);
|
||||
end;
|
||||
|
||||
procedure SetWindowColorModeFor(Handle: THandle; IsDark: Boolean);
|
||||
var
|
||||
Value: LongBool;
|
||||
begin
|
||||
Value := IsDark;
|
||||
DwmSetWindowAttribute(Handle, ImmersiveDarkMode, Value, SizeOf(Value));
|
||||
AllowDarkModeForWindow(Handle, Value);
|
||||
AllowDarkModeForApp(Value);
|
||||
end;
|
||||
|
||||
{ TFormHelper }
|
||||
|
||||
procedure TFormHelper.SetWindowColorMode(IsDark: Boolean);
|
||||
begin
|
||||
SetWindowColorModeFor(handle, IsDark);
|
||||
end;
|
||||
|
||||
procedure TFormHelper.SetWindowColorModeAsSystem;
|
||||
begin
|
||||
SetWindowColorModeAsSystemFor(Handle);
|
||||
end;
|
||||
|
||||
class function TFormHelper.SystemIsDarkMode: Boolean;
|
||||
begin
|
||||
Result := IsDarkMode;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
+255
@@ -0,0 +1,255 @@
|
||||
unit DarkModeApi;
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
|
||||
{$WARN SYMBOL_PLATFORM OFF}
|
||||
|
||||
interface
|
||||
|
||||
// See also https://github.com/adzm/win32-custom-menubar-aero-theme
|
||||
|
||||
uses
|
||||
Winapi.Windows, DarkModeApi.Types;
|
||||
|
||||
function DwmSetWindowAttribute(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HResult; stdcall; overload;
|
||||
|
||||
function DwmSetWindowAttribute(hwnd: HWND; dwAttribute: TDwmWindowAttribute; var pvAttribute; cbAttribute: DWORD): HResult; stdcall; overload;
|
||||
|
||||
function DwmSetWindowAttribute(hwnd: HWND; dwAttribute: TDwmWindowAttribute; var pvAttribute: TDWMWindowCornerPreference; cbAttribute: DWORD): HResult; stdcall; overload;
|
||||
|
||||
/// <summary>
|
||||
/// Enables dark context menus which change automatically depending on the theme.
|
||||
/// </summary>
|
||||
procedure AllowDarkModeForApp(allow: BOOL); stdcall;
|
||||
|
||||
function AllowDarkModeForWindow(hWnd: HWND; allow: Boolean): Boolean; stdcall;
|
||||
|
||||
// See https://en.wikipedia.org/wiki/Windows_10_version_history
|
||||
function CheckBuildNumber(buildNumber: DWORD): Boolean;
|
||||
|
||||
function IsWindows10OrGreater(buildNumber: DWORD = 10000): Boolean;
|
||||
|
||||
function IsWindows11OrGreater(buildNumber: DWORD = 22000): Boolean;
|
||||
|
||||
function IsDarkModeAllowedForWindow(hWnd: HWND): BOOL; stdcall;
|
||||
|
||||
procedure RefreshImmersiveColorPolicyState; stdcall;
|
||||
|
||||
procedure RefreshTitleBarThemeColor(hWnd: HWND);
|
||||
|
||||
function ShouldAppsUseDarkMode: BOOL; stdcall;
|
||||
|
||||
function ShouldSystemUseDarkMode: BOOL; stdcall;
|
||||
|
||||
function ImmersiveDarkMode: TDwmWindowAttribute;
|
||||
|
||||
/// <summary>
|
||||
/// Checks the system registry to see if Dark mode is enabled
|
||||
/// </summary>
|
||||
function IsDarkMode: Boolean;
|
||||
|
||||
const
|
||||
LOAD_LIBRARY_SEARCH_SYSTEM32 = $00000800;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Classes, System.SysUtils, DarkModeApi.Consts, System.Win.Registry;
|
||||
|
||||
var
|
||||
_AllowDarkModeForApp: TAllowDarkModeForApp = nil;
|
||||
_AllowDarkModeForWindow: TAllowDarkModeForWindow = nil;
|
||||
_GetIsImmersiveColorUsingHighContrast: TGetIsImmersiveColorUsingHighContrast = nil;
|
||||
_IsDarkModeAllowedForWindow: TIsDarkModeAllowedForWindow = nil;
|
||||
_OpenNcThemeData: TOpenNcThemeData = nil;
|
||||
_RefreshImmersiveColorPolicyState: TRefreshImmersiveColorPolicyState = nil;
|
||||
_SetPreferredAppMode: TSetPreferredAppMode = nil;
|
||||
_SetWindowCompositionAttribute: TSetWindowCompositionAttribute = nil;
|
||||
_ShouldAppsUseDarkMode: TShouldAppsUseDarkMode = nil;
|
||||
_ShouldSystemUseDarkMode: TShouldSystemUseDarkMode = nil;
|
||||
GDarkModeSupported: BOOL = False; // changed type to BOOL
|
||||
GDarkModeEnabled: BOOL = False;
|
||||
GUxTheme: HMODULE = 0;
|
||||
|
||||
function DwmSetWindowAttribute(hwnd: hwnd; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HResult; stdcall; overload; external Dwmapi name 'DwmSetWindowAttribute' delayed;
|
||||
|
||||
function DwmSetWindowAttribute(hwnd: hwnd; dwAttribute: TDwmWindowAttribute; var pvAttribute: TDWMWindowCornerPreference; cbAttribute: DWORD): HResult; stdcall; overload; external Dwmapi name 'DwmSetWindowAttribute' delayed;
|
||||
|
||||
procedure AllowDarkModeForApp(allow: BOOL);
|
||||
begin
|
||||
if Assigned(_AllowDarkModeForApp) then
|
||||
_AllowDarkModeForApp(allow)
|
||||
else if Assigned(_SetPreferredAppMode) then
|
||||
begin
|
||||
if allow then
|
||||
_SetPreferredAppMode(TPreferredAppMode.AllowDarkMode)
|
||||
else
|
||||
_SetPreferredAppMode(TPreferredAppMode.DefaultMode);
|
||||
end;
|
||||
end;
|
||||
|
||||
function DwmSetWindowAttribute(hwnd: hwnd; dwAttribute: TDwmWindowAttribute; var pvAttribute; cbAttribute: DWORD): HResult;
|
||||
begin
|
||||
Result := DwmSetWindowAttribute(hwnd, Ord(dwAttribute), @pvAttribute, cbAttribute);
|
||||
end;
|
||||
|
||||
function IsDarkModeAllowedForWindow(hWnd: hWnd): BOOL;
|
||||
begin
|
||||
Result := Assigned(_IsDarkModeAllowedForWindow) and _IsDarkModeAllowedForWindow(hWnd);
|
||||
end;
|
||||
|
||||
function GetIsImmersiveColorUsingHighContrast(mode: TImmersiveHCCacheMode): BOOL;
|
||||
begin
|
||||
Result := Assigned(_GetIsImmersiveColorUsingHighContrast) and _GetIsImmersiveColorUsingHighContrast(mode);
|
||||
end;
|
||||
|
||||
function ImmersiveDarkMode: TDwmWindowAttribute;
|
||||
begin
|
||||
if IsWindows10OrGreater(18985) then
|
||||
Result := DWMWA_USE_IMMERSIVE_DARK_MODE
|
||||
else
|
||||
Result := DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1;
|
||||
end;
|
||||
|
||||
procedure RefreshImmersiveColorPolicyState;
|
||||
begin
|
||||
if Assigned(_RefreshImmersiveColorPolicyState) then
|
||||
_RefreshImmersiveColorPolicyState;
|
||||
end;
|
||||
|
||||
function IsDarkMode: Boolean;
|
||||
var
|
||||
LRegistry: TRegistry;
|
||||
begin
|
||||
LRegistry := TRegistry.Create;
|
||||
try
|
||||
LRegistry.RootKey := HKEY_CURRENT_USER;
|
||||
LRegistry.OpenKeyReadOnly('\SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize');
|
||||
Result := not LRegistry.ReadBool('AppsUseLightTheme');
|
||||
finally
|
||||
LRegistry.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ShouldSystemUseDarkMode: BOOL;
|
||||
begin
|
||||
Result := Assigned(_ShouldSystemUseDarkMode) and _ShouldSystemUseDarkMode;
|
||||
end;
|
||||
function CheckBuildNumber(buildNumber: DWORD): Boolean;
|
||||
begin
|
||||
Result :=
|
||||
IsWindows10OrGreater(20348) or
|
||||
IsWindows10OrGreater(19045) or //
|
||||
IsWindows10OrGreater(19044) or //
|
||||
IsWindows10OrGreater(19043) or //
|
||||
IsWindows10OrGreater(19042) or //
|
||||
IsWindows10OrGreater(19041) or // 2004
|
||||
IsWindows10OrGreater(18363) or // 1909
|
||||
IsWindows10OrGreater(18362) or // 1903
|
||||
IsWindows10OrGreater(17763); // 1809
|
||||
end;
|
||||
|
||||
function IsWindows10OrGreater(buildNumber: DWORD): Boolean;
|
||||
begin
|
||||
Result := (TOSVersion.Major > 10) or ((TOSVersion.Major = 10) and (TOSVersion.Minor = 0) and (DWORD(TOSVersion.Build) >= buildNumber));
|
||||
end;
|
||||
|
||||
function IsWindows11OrGreater(buildNumber: DWORD): Boolean;
|
||||
begin
|
||||
Result := IsWindows10OrGreater(22000) or IsWindows10OrGreater(buildNumber);
|
||||
end;
|
||||
|
||||
function AllowDarkModeForWindow(hWnd: hWnd; allow: Boolean): Boolean;
|
||||
begin
|
||||
Result := GDarkModeSupported and _AllowDarkModeForWindow(hWnd, allow);
|
||||
end;
|
||||
|
||||
function IsHighContrast: Boolean;
|
||||
var
|
||||
highContrast: HIGHCONTRASTW;
|
||||
begin
|
||||
highContrast.cbSize := SizeOf(highContrast);
|
||||
if SystemParametersInfo(SPI_GETHIGHCONTRAST, SizeOf(highContrast), @highContrast, Ord(False)) then
|
||||
Result := highContrast.dwFlags and HCF_HIGHCONTRASTON <> 0
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure RefreshTitleBarThemeColor(hWnd: hWnd);
|
||||
var
|
||||
LUseDark: BOOL;
|
||||
LData: TWindowCompositionAttribData;
|
||||
begin
|
||||
LUseDark := _IsDarkModeAllowedForWindow(hWnd) and _ShouldAppsUseDarkMode and not IsHighContrast;
|
||||
if TOSVersion.Build < 18362 then
|
||||
SetProp(hWnd, 'UseImmersiveDarkModeColors', THandle(LUseDark))
|
||||
else if Assigned(_SetWindowCompositionAttribute) then
|
||||
begin
|
||||
LData.Attrib := WCA_USEDARKMODECOLORS;
|
||||
LData.pvData := @LUseDark;
|
||||
LData.cbData := SizeOf(LUseDark);
|
||||
_SetWindowCompositionAttribute(hWnd, @LData);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ShouldAppsUseDarkMode: BOOL;
|
||||
begin
|
||||
Result := Assigned(_ShouldAppsUseDarkMode) and _ShouldAppsUseDarkMode;
|
||||
end;
|
||||
|
||||
procedure InitDarkMode;
|
||||
begin
|
||||
if ((TOSVersion.Major = 10) and (TOSVersion.Minor = 0) and CheckBuildNumber(TOSVersion.Build)) then
|
||||
begin
|
||||
GUxTheme := LoadLibraryEx('uxtheme.dll', 0, LOAD_LIBRARY_SEARCH_SYSTEM32);
|
||||
if GUxTheme <> 0 then
|
||||
begin
|
||||
@_AllowDarkModeForWindow := GetProcAddress(GUxTheme, MAKEINTRESOURCEA(133));
|
||||
@_GetIsImmersiveColorUsingHighContrast := GetProcAddress(GUxTheme, MAKEINTRESOURCEA(106));
|
||||
@_IsDarkModeAllowedForWindow := GetProcAddress(GUxTheme, MAKEINTRESOURCEA(137));
|
||||
@_RefreshImmersiveColorPolicyState := GetProcAddress(GUxTheme, MAKEINTRESOURCEA(104));
|
||||
@_SetWindowCompositionAttribute := GetProcAddress(GetModuleHandle(user32), 'SetWindowCompositionAttribute');
|
||||
@_ShouldAppsUseDarkMode := GetProcAddress(GUxTheme, MAKEINTRESOURCEA(132));
|
||||
|
||||
var P := GetProcAddress(GUxTheme, MAKEINTRESOURCEA(135));
|
||||
if TOSVersion.Build < 18362 then
|
||||
@_AllowDarkModeForApp := P
|
||||
else
|
||||
@_SetPreferredAppMode := P;
|
||||
|
||||
if Assigned(_RefreshImmersiveColorPolicyState) and
|
||||
Assigned(_ShouldAppsUseDarkMode) and Assigned(_AllowDarkModeForWindow) and
|
||||
(Assigned(_AllowDarkModeForApp) or Assigned(_SetPreferredAppMode)) and
|
||||
Assigned(_IsDarkModeAllowedForWindow) then
|
||||
begin
|
||||
GDarkModeSupported := True;
|
||||
AllowDarkModeForApp(True);
|
||||
_RefreshImmersiveColorPolicyState;
|
||||
GDarkModeEnabled := ShouldAppsUseDarkMode and not IsHighContrast;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoneDarkMode;
|
||||
begin
|
||||
if GUxTheme <> 0 then
|
||||
FreeLibrary(GUxTheme);
|
||||
end;
|
||||
|
||||
initialization
|
||||
InitDarkMode;
|
||||
|
||||
finalization
|
||||
DoneDarkMode;
|
||||
|
||||
{$ELSE}
|
||||
|
||||
interface
|
||||
|
||||
implementation
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,21 @@
|
||||
MIT License
|
||||
|
||||
Copyright (c) 2023 alinvip22@gmail.com
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in all
|
||||
copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
SOFTWARE.
|
||||
Reference in New Issue
Block a user