ダークモード対応

unit DarkModeClasses;

interface

uses {$IF CompilerVersion > 22.9}

 Winapi.Windows, System.SysUtils;

{$ELSE}

 Windows, SysUtils;

{$IFEND}

resourcestring

 SDllLoadError = '%s をロードできません';

const

 THEME_LIB = 'uxtheme.dll';

type

 TShouldAppsUseDarkMode = function: BOOL; cdecl;
 TAllowDarkModeForWindow = function(hwnd: HWND; allow: BOOL): BOOL; cdecl;
 TAllowDarkModeForApp = function(allow: BOOL): BOOL; cdecl;
 TFlushMenuThemes = procedure; cdecl;
 TRefreshImmersiveColorPolicyState = procedure; cdecl;

var

 FHandle: THandle;
 FLoaded: Boolean;
 RefreshImmersiveColorPolicyState: TRefreshImmersiveColorPolicyState;
 ShouldAppsUseDarkMode: TShouldAppsUseDarkMode;
 AllowDarkModeForWindow: TAllowDarkModeForWindow;
 AllowDarkModeForApp: TAllowDarkModeForApp;
 FlushMenuThemes: TFlushMenuThemes;
 DarkModeSupported: Boolean;

implementation

function DarkModeLoadLibrary: Boolean; begin

 if CheckWin32Version(10) and (TOSVersion.Build >= 17763) then
   FHandle := LoadLibrary(PChar(THEME_LIB));
 Result := FHandle <> 0;
 if Result then
 begin
   @RefreshImmersiveColorPolicyState := GetProcAddress(FHandle, MakeIntResource(104));
   @ShouldAppsUseDarkMode := GetProcAddress(FHandle, MakeIntResource(132));
   @AllowDarkModeForWindow := GetProcAddress(FHandle, MakeIntResource(133));
   @AllowDarkModeForApp := GetProcAddress(FHandle, MakeIntResource(135));
   @FlushMenuThemes := GetProcAddress(FHandle, MakeIntResource(136));
   if (@RefreshImmersiveColorPolicyState <> nil) and
     (@ShouldAppsUseDarkMode <> nil) and (@AllowDarkModeForWindow <> nil) and
     (@AllowDarkModeForApp <> nil) and (@FlushMenuThemes <> nil) then
     DarkModeSupported := True;
 end;

end;

procedure DarkModeFreeLibrary; begin

 if FHandle <> 0 then
   FreeLibrary(FHandle);
 FHandle := 0;

end;

initialization

if not FLoaded then

 FLoaded := DarkModeLoadLibrary;

finalization

if FLoaded then

 DarkModeFreeLibrary;

end.