Improved functions to read the screen scale in FMX

Fixed FMXExternalPumpBrowser2 initialization issue in Linux
salvadordf · Jun 26, 2022 · 63d5156 · 63d5156
1 parent 1239c09
commit 63d5156
Show file tree

Hide file tree

Showing 7 changed files with 68 additions and 8 deletions.
diff --git a/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/FMUX.Config.pas b/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/FMUX.Config.pas
@@ -0,0 +1,22 @@
+{*******************************************************}
+{                                                       }
+{              Linux FireMonkey Platform                }
+{                                                       }
+{          Copyright(c) 2017-2019 Eugene Kryukov. 	}
+{              All rights reserved                      }
+{                                                       }
+{*******************************************************}
+
+unit FMUX.Config;
+
+interface
+
+// Chromium requires that the process has only one thread when it's initialized.
+// FmuxInit must be called after the Chromium initialization.
+// Setting DoNotCallFmuxInit to True allows us to call FmuxInit after that.
+var
+  DoNotCallFmuxInit: Boolean = True;
+
+implementation
+end.
+
diff --git a/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/FMXExternalPumpBrowser2.dpr b/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/FMXExternalPumpBrowser2.dpr
@@ -38,6 +38,9 @@
 program FMXExternalPumpBrowser2;
 
 uses
+  // FMUX.Config.pas belongs to the FMXLinux project but we need to override it.
+  // Read the comments in that unit for more details.
+  FMUX.Config in 'FMUX.Config.pas',
   // FMX initializes GTK in the initialization section of some of its units and
   // that means that GTK is already initialized when the code in the DPR is
   // executed.
@@ -58,6 +61,8 @@ uses
 {$R *.res}
 
 begin
+  // At this point it's safe to initialize GTK
+  InitializeGTK;
   Application.Initialize;
   Application.CreateForm(TFMXExternalPumpBrowserFrm, FMXExternalPumpBrowserFrm);
   Application.Run;

diff --git a/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/FMXExternalPumpBrowser2.dproj b/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/FMXExternalPumpBrowser2.dproj
@@ -142,6 +142,7 @@
         <DelphiCompile Include="$(MainSource)">
             <MainSource>MainSource</MainSource>
         </DelphiCompile>
+        <DCCReference Include="FMUX.Config.pas"/>
         <DCCReference Include="uCEFLoader.pas"/>
         <DCCReference Include="uFMXExternalPumpBrowser2.pas">
             <Form>FMXExternalPumpBrowserFrm</Form>

diff --git a/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uCEFLoader.pas b/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uCEFLoader.pas
@@ -48,9 +48,12 @@ interface
   // Read the answer to this question for more more information :
   // https://stackoverflow.com/questions/52103407/changing-the-initialization-order-of-the-unit-in-delphi
   System.IOUtils,
+  FMUX.Api, // FMUX.Api is part of the FMXLinux project
   uCEFApplication, uCEFConstants, uCEFTimerWorkScheduler, uCEFLinuxFunctions,
   uCEFLinuxTypes;
 
+procedure InitializeGTK;
+
 implementation
 
 function CustomX11ErrorHandler(Display:PDisplay; ErrorEv:PXErrorEvent):longint;cdecl;
@@ -107,11 +110,25 @@ procedure InitializeGlobalCEFApp;
   GlobalCEFApp.DisableFeatures := 'HardwareMediaKeyHandling';
 
   GlobalCEFApp.StartMainProcess;
+end;
+
+procedure FmuxLog(S: PChar); cdecl;
+begin
+  Writeln(S);
+end;
+
+procedure InitializeGTK;
+begin
+  FmuxSetLog(FmuxLog);
+  FmuxInit(FMUX_INIT_NOWAYLAND);
 
   // Install xlib error handlers so that the application won't be terminated
   // on non-fatal errors. Must be done after initializing GTK.
   XSetErrorHandler(@CustomX11ErrorHandler);
   XSetIOErrorHandler(@CustomXIOErrorHandler);
+
+  // GTK is now initialized and we can read the screen scale.
+  GlobalCEFApp.UpdateDeviceScaleFactor;
 end;
 
 initialization

diff --git a/source/uCEFFMXBufferPanel.pas b/source/uCEFFMXBufferPanel.pas
@@ -417,9 +417,12 @@ function TFMXBufferPanel.GetRealScreenScale(var aResultScale : single) : boolean
   {$ENDIF}
 
   {$IFDEF LINUX}
-  // TODO: Get the scale of the screen where the parent form is located in FMXLinux
-  Result       := False;
-  aResultScale := 1;
+  if (Screen.DisplayCount = 1) then
+    aResultScale := Screen.Displays[0].Scale
+   else
+    aResultScale := Screen.DisplayFromForm(GetParentForm).Scale;
+
+  Result := True;
   {$ENDIF}
 
   {$IFDEF MACOS}

diff --git a/source/uCEFMiscFunctions.pas b/source/uCEFMiscFunctions.pas
@@ -2369,7 +2369,8 @@ function GetScreenDPI : integer;
 {$ELSE}
 {$IFDEF FMX}
 var
-  TempService: IFMXScreenService;
+  TempService : IFMXScreenService;
+  TempWidth, TempWidthMM : integer;
 {$ENDIF}
 {$ENDIF}
 begin
@@ -2396,13 +2397,24 @@ function GetScreenDPI : integer;
          else
           Result := USER_DEFAULT_SCREEN_DPI;
     {$ELSE}
+    Result := -1;
     if TPlatformServices.Current.SupportsPlatformService(IFMXScreenService, TempService) then
-      Result := round(TempService.GetScreenScale * USER_DEFAULT_SCREEN_DPI)
-     else
+      Result := round(TempService.GetScreenScale * USER_DEFAULT_SCREEN_DPI);
+
+    if (Result < 0) then
       begin
         Result := round(gdk_screen_get_resolution(gdk_screen_get_default));
+
         if (Result < 0) then
-          Result := round(gdk_screen_width / (gdk_screen_width_mm / 25.4));
+          begin
+            TempWidthMM := gdk_screen_width_mm;
+            TempWidth   := gdk_screen_width;
+
+            if (TempWidthMM > 0) and (TempWidth > 0) then
+              Result := round(TempWidth / (TempWidthMM / 25.4))
+             else
+              Result := USER_DEFAULT_SCREEN_DPI;
+          end;
       end;
     {$ENDIF}
   {$ENDIF}

diff --git a/update_CEF4Delphi.json b/update_CEF4Delphi.json
@@ -2,7 +2,7 @@
   "UpdateLazPackages" : [
     {
       "ForceNotify" : true,
-      "InternalVersion" : 406,
+      "InternalVersion" : 407,
       "Name" : "cef4delphi_lazarus.lpk",
       "Version" : "102.0.10.0"
     }