Beppe Magistro 1 Posted March 4, 2021 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 Share this post Link to post
Wil van Antwerpen 25 Posted March 7, 2021 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 Share this post Link to post
Beppe Magistro 1 Posted March 8, 2021 thank you Wil , do you have a small code example ? Beppe Share this post Link to post
Wil van Antwerpen 25 Posted March 8, 2021 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. Share this post Link to post
gaddlord 2 Posted October 31 In which unit the RawStr() function is defined please? Share this post Link to post
gaddlord 2 Posted October 31 Searching the Internet I found function RawStr(const Str: string): Pointer; begin Result := TNSString.OCClass.stringWithUTF8String(PAnsiChar(UTF8String(Str))); end; at https://stackoverflow.com/questions/17499819/control-mplayer-via-pipe-in-macos-with-xe4 Share this post Link to post
Dave Nottage 557 Posted October 31 On 3/5/2021 at 5:09 AM, Beppe Magistro said: there is in delphi 10.4.2 a way to understand if MAC is in dark mode and switch theme ? Not sure if you are still using 10.4.2, or if this will compile in 10.4.2, but: function IsDarkMode: Boolean; var LStyle: string; LDefaults: NSUserDefaults; begin LDefaults := TNSUserDefaults.Wrap(TNSUserDefaults.OCClass.standardUserDefaults); LStyle := NSStrToStr(LDefaults.stringForKey(StrToNSStr('AppleInterfaceStyle'))); Result := False; if LStyle.Equals('Dark') then Result := True; end; Share this post Link to post