osx dark mode 10.4.2

[Beppe Magistro 1]

Hi all ,

there is in delphi 10.4.2 a way to understand if MAC is in dark mode and switch theme ?

Thanks in advance

Beppe

 

[Wil van Antwerpen 25]

You can run this:

defaults read -g AppleInterfaceStyle

and if it returns "Dark" then you're in dark mode and can switch to a dark theme.

 

It's what I"m using in Vimalin, not sure if there's anything better for macOS so far.

--
Wil

[Beppe Magistro 1]

thank you Wil ,

 

do you have a small code example ?

 

Beppe

[Wil van Antwerpen 25]

Sure..

 

unit ShellCommands;

interface

uses
{$IFDEF MSWINDOWS}
  FMX.DialogService.Sync,  // for confirmation / showmessage dialogs
  System.UITypes,          // same ^^
  FMX.Types,               // same ^^
  Windows,
  ShlObj,
  WinShortCut,
  Winapi.ShellAPI,
{$ENDIF MSWINDOWS}
{$IFDEF POSIX}
  Posix.Stdlib, Macapi.ObjectiveC, Macapi.CocoaTypes, Macapi.Foundation, Macapi.AppKit, Macapi.Helpers,
  Posix.SysSysctl,
{$ENDIF POSIX}
  System.SysUtils, System.StrUtils, System.Types, System.Classes;

type
  TScriptArguments = array of string;
  TShell = class
    class function RunScript(sCommand: string; sArguments: TScriptArguments; out stdOut : string): integer;
  end;


implementation


class function TShell.RunScript(sCommand: string; sArguments: TScriptArguments; out stdOut : string): integer;
{$IFDEF POSIX}
var
  LTask: NSTask;
  LArgs: NSArray;
  LArray: array of Pointer;
  LPipe: NSPipe;
  fileHandler : NSFileHandle;
  data : NSData;
  i       : Integer;
  iCount  : Integer;
  nsText : NSString;
begin
  sCommand := trim(sCommand);
  If sCommand <> '' then
  begin
    LArgs := TNSArray.Create;
    iCount := Length(sArguments);
    if iCount > 0 then
    begin
      //Create and init the arguments the correct way...
      setlength(LArray, iCount);
      for i := 0 to iCount-1 do
      Begin
        LArray[i] := RawStr(sArguments[i]);
      End;
    end;
    LArgs:=TNSArray.Wrap(TNSArray.Alloc.initWithObjects(@(LArray[0]), iCount));

    //Create the task the correct way.
    LTask:=TNSTask.Wrap(TNSTask.Alloc.init);

    LPipe := TNSPipe.Create;
    fileHandler := TNSFileHandle.Create;

    LTask.setLaunchPath(StrToNSStr(sCommand));
    LTask.setArguments(LArgs);

    LTask.setStandardOutput((LPipe as ILocalObject).GetObjectID);
    fileHandler := LPipe.fileHandleForReading;

    LTask.launch;
    LTask.waitUntilExit;
    data := TNSData.Create;
    data := fileHandler.readDataToEndOfFile;
    nsText := TNSString.Wrap(TNSString.Alloc.initWithData(data, NSUTF8StringEncoding));
    stdOut := NSStrToStr(nsText);
  end; // sCommand <> ''
  Result := 0;
end; // RunScript
{$ENDIF POSIX}
{$IFDEF MSWINDOWS}
var
  commandLine: string;
  i       : Integer;
  iCount  : Integer;
  Success : Boolean;
  ExitCode : Longword;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  SA: TSecurityAttributes;
  si: TStartupInfo;
  ProcInfo: TProcessInformation;
begin
  stdOut := '';
  ExitCode := 0;
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    si := Default(TStartupInfo);
    si.cb := SizeOf(si);
    si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    si.wShowWindow := SW_HIDE;
    si.hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
    si.hStdOutput := StdOutPipeWrite;
    si.hStdError := StdOutPipeWrite;

    commandLine := sCommand;
    commandLine := '"'+commandLine+'"';
    iCount := Length(sArguments);
    if iCount > 0 then
    begin
      for i := 0 to iCount-1 do
      Begin
        commandLine := commandLine + ' ' + QuoteScriptParam(sArguments[i]);
      End;
    end;
    
    uniquestring(commandline);

    Success := CreateProcess(
        nil,                //no module name (use command line)
        PChar(commandLine), //Command Line
        nil,                //Process handle not inheritable
        nil,                //Thread handle not inheritable
        True,               //Do inherit handles
        0,                  //No creation flags
        nil,                //Use parent's environment block
        nil,                //Use parent's starting directory
        si,                 //Startup Info
        ProcInfo            //Process Info
    );
    CloseHandle(StdOutPipeWrite);
    if Success then
    begin
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            stdOut := stdOut + string(Buffer);
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(ProcInfo.hProcess, INFINITE);
        GetExitCodeProcess(ProcInfo.hProcess,ExitCode);
      finally
        CloseHandle(ProcInfo.hThread);
        CloseHandle(ProcInfo.hProcess);
      end;
    end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
  if stdOut <> '' then
  begin
    stdOut := stringReplace(stdOut,#$0D,'',[rfReplaceAll]); // strip all CR from the CRLF so that it is the same as for our code from macOS
  end;
  result := ExitCode;
end;
{$ENDIF MSWINDOWS}

end.



// Then from another part in my code I call it like this:

function IsDarkModeEnabled: Boolean;
{$IFDEF POSIX}
var
  bDarkMode   : boolean;
  sCmd        : string;
  stdOut      : string;
  iErr        : integer;
  Params      : TScriptArguments;
begin
  bDarkMode := false;
  sCmd := '/usr/bin/defaults';
  If sCmd<>'' then
  begin
    If FileExists(sCmd)=true then
    begin
      stdOut := '';
  
      SetLength(Params,3);  // defaults read -g AppleInterfaceStyle -> returns "Dark" if dark mode is enabled
      
      Params[0] := 'read';
      Params[1] := '-g';
      Params[2] := 'AppleInterfaceStyle';
    
      iErr := TShell.RunScript(sCmd,Params,stdOut);
      //if iErr > 0 then
      //  ErrorHandling;
      //WriteLog('Dark Mode '+trim(stdOut));
  
      stdOut := trim(stdOut);
      if (lowercase(stdOut)='dark') then
        bDarkMode := true;
    end
    else Begin
      TDialogServiceSync.MessageDialog('File ' + sCmd + ' does not exist.',mtConfirmation, [mbOK], mbOK, 0);
      sCmd := '';
    End;
  End;
  Result := bDarkMode;
end;
{$ENDIF POSIX}
{$IFDEF MSWINDOWS}
//Computer\HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Themes\Personalize
// if DWORD AppsUseLightTheme does not exist -> light theme
// if DWORD AppsUseLightTheme exists and is 0 -> dark theme
// if DWORD AppsUseLightTheme exists and is 1 -> light theme
var
  bDarkMode     : boolean;
  sName         : string;
  UseLightTheme : integer;
  Reg: TRegistry;
begin
  bDarkMode := false;
  UseLightTheme := 1; // default is to use the light theme.
  Reg := TRegistry.Create(KEY_READ);
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Themes\Personalize', false) then
    begin
      sName := 'AppsUseLightTheme';
      If Reg.ValueExists(sName)=true then
        UseLightTheme := Reg.ReadInteger(sName);
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
  if UseLightTheme = 0 then
    bDarkMode := true;
  Result := bDarkMode;
end;
{$ENDIF MSWINDOWS}

Hopefully I got all the dependencies and commented out the stuff that is specific for my apps.

I left the Windows dark/light theme logic in as well, just in case somebody wants that too.

[Beppe Magistro 1]

thank you very much !!!!