Issue #273 fixed

- Added TFMXChromium.ScreenScale property
salvadordf · Apr 9, 2020 · 846aedd · 846aedd
1 parent c9b2af2
commit 846aedd
Show file tree

Hide file tree

Showing 8 changed files with 57 additions and 55 deletions.
diff --git a/demos/Delphi_FMX/FMXTabbedBrowser/uBrowserFrame.fmx b/demos/Delphi_FMX/FMXTabbedBrowser/uBrowserFrame.fmx
@@ -6,24 +6,6 @@ object BrowserFrame: TBrowserFrame
   Size.Width = 1000.000000000000000000
   Size.Height = 733.000000000000000000
   Size.PlatformDefault = False
-  object StatusBar: TStatusBar
-    Padding.Left = 5.000000000000000000
-    Padding.Right = 5.000000000000000000
-    Position.X = 1.000000000000000000
-    Position.Y = 710.000000000000000000
-    ShowSizeGrip = False
-    Size.Width = 998.000000000000000000
-    Size.Height = 22.000000000000000000
-    Size.PlatformDefault = False
-    TabOrder = 2
-    object StatusLbl: TLabel
-      Align = Client
-      Size.Width = 988.000000000000000000
-      Size.Height = 22.000000000000000000
-      Size.PlatformDefault = False
-      TabOrder = 0
-    end
-  end
   object AddressLay: TLayout
     Align = Top
     Padding.Left = 5.000000000000000000
@@ -35,7 +17,7 @@ object BrowserFrame: TBrowserFrame
     Size.Width = 998.000000000000000000
     Size.Height = 35.000000000000000000
     Size.PlatformDefault = False
-    TabOrder = 4
+    TabOrder = 3
     object GoBtn: TSpeedButton
       Align = Right
       Margins.Left = 5.000000000000000000
@@ -112,17 +94,16 @@ object BrowserFrame: TBrowserFrame
   object WindowParentLay: TLayout
     Align = Client
     Size.Width = 998.000000000000000000
-    Size.Height = 674.000000000000000000
+    Size.Height = 696.000000000000000000
     Size.PlatformDefault = False
-    TabOrder = 5
+    TabOrder = 4
     OnResize = WindowParentLayResize
   end
   object FMXChromium1: TFMXChromium
     OnLoadError = FMXChromium1LoadError
     OnLoadingStateChange = FMXChromium1LoadingStateChange
     OnAddressChange = FMXChromium1AddressChange
     OnTitleChange = FMXChromium1TitleChange
-    OnStatusMessage = FMXChromium1StatusMessage
     OnBeforePopup = FMXChromium1BeforePopup
     OnAfterCreated = FMXChromium1AfterCreated
     OnBeforeClose = FMXChromium1BeforeClose

diff --git a/demos/Delphi_FMX/FMXTabbedBrowser/uBrowserFrame.pas b/demos/Delphi_FMX/FMXTabbedBrowser/uBrowserFrame.pas
@@ -54,8 +54,6 @@ interface
 
   TBrowserFrame = class(TFrame)
       FMXChromium1: TFMXChromium;
-      StatusBar: TStatusBar;
-      StatusLbl: TLabel;
       AddressLay: TLayout;
       GoBtn: TSpeedButton;
       NavButtonLay: TLayout;
@@ -81,7 +79,6 @@   TBrowserFrame = class(TFrame)
       procedure FMXChromium1AddressChange(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const url: ustring);
       procedure FMXChromium1LoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring);
       procedure FMXChromium1LoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
-      procedure FMXChromium1StatusMessage(Sender: TObject; const browser: ICefBrowser; const value: ustring);
       procedure FMXChromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring);
 
     protected
@@ -144,12 +141,14 @@ constructor TBrowserFrame.Create(AOwner : TComponent);
 function TBrowserFrame.GetFMXWindowParentRect : System.Types.TRect;
 var
   TempRect : TRectF;
+  TempScale : single;
 begin
-  TempRect      := WindowParentLay.AbsoluteRect;
-  Result.Left   := round(TempRect.Left);
-  Result.Top    := round(TempRect.Top);
-  Result.Right  := round(TempRect.Right);
-  Result.Bottom := round(TempREct.Bottom);
+  TempScale       := FMXChromium1.ScreenScale;
+  TempRect        := WindowParentLay.AbsoluteRect;
+  Result.Left     := round(TempRect.Left   * TempScale);
+  Result.Top      := round(TempRect.Top    * TempScale);
+  Result.Right    := round(TempRect.Right  * TempScale) - 1;
+  Result.Bottom   := round(TempREct.Bottom * TempScale) - 1;
 end;
 
 procedure TBrowserFrame.ReloadBtnClick(Sender: TObject);
@@ -297,15 +296,6 @@ procedure TBrowserFrame.FMXChromium1OpenUrlFromTab(Sender: TObject;
   Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
 end;
 
-procedure TBrowserFrame.FMXChromium1StatusMessage(Sender: TObject;
-  const browser: ICefBrowser; const value: ustring);
-begin
-  TThread.Queue(nil, procedure
-                     begin
-                       StatusLbl.Text := value;
-                     end);
-end;
-
 procedure TBrowserFrame.FMXChromium1TitleChange(Sender: TObject;
   const browser: ICefBrowser; const title: ustring);
 begin

diff --git a/demos/Delphi_FMX/FMXTabbedBrowser/uMainForm.fmx b/demos/Delphi_FMX/FMXTabbedBrowser/uMainForm.fmx
@@ -2,8 +2,8 @@ object MainForm: TMainForm
   Left = 0
   Top = 0
   Caption = 'Initializing. Please, wait...'
-  ClientHeight = 716
-  ClientWidth = 979
+  ClientHeight = 700
+  ClientWidth = 1032
   Position = ScreenCenter
   FormFactor.Width = 320
   FormFactor.Height = 480
@@ -19,7 +19,7 @@ object MainForm: TMainForm
     Padding.Left = 5.000000000000000000
     Padding.Right = 5.000000000000000000
     Size.Width = 32.000000000000000000
-    Size.Height = 716.000000000000000000
+    Size.Height = 700.000000000000000000
     Size.PlatformDefault = False
     TabOrder = 0
     object AddTabBtn: TSpeedButton
@@ -51,8 +51,8 @@ object MainForm: TMainForm
   end
   object BrowserTabCtrl: TTabControl
     Align = Client
-    Size.Width = 947.000000000000000000
-    Size.Height = 716.000000000000000000
+    Size.Width = 1000.000000000000000000
+    Size.Height = 700.000000000000000000
     Size.PlatformDefault = False
     TabOrder = 1
     TabPosition = PlatformDefault

diff --git a/demos/Delphi_FMX/FMXToolBoxBrowser/uChildForm.pas b/demos/Delphi_FMX/FMXToolBoxBrowser/uChildForm.pas
@@ -265,11 +265,14 @@ procedure TChildForm.CreateFMXWindowParent;
 end;
 
 function TChildForm.GetFMXWindowParentRect : System.Types.TRect;
+var
+  TempScale : single;
 begin
+  TempScale     := FMXChromium1.ScreenScale;
   Result.Left   := 0;
   Result.Top    := 0;
-  Result.Right  := ClientWidth  - 1;
-  Result.Bottom := ClientHeight - 1;
+  Result.Right  := round(ClientWidth  * TempScale) - 1;
+  Result.Bottom := round(ClientHeight * TempScale) - 1;
 end;
 
 procedure TChildForm.ResizeChild;

diff --git a/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.fmx b/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.fmx
@@ -3,7 +3,7 @@ object SimpleFMXBrowserFrm: TSimpleFMXBrowserFrm
   Top = 0
   Caption = 'Initializing browser. Please wait...'
   ClientHeight = 600
-  ClientWidth = 917
+  ClientWidth = 1000
   Position = ScreenCenter
   FormFactor.Width = 320
   FormFactor.Height = 480
@@ -20,7 +20,7 @@ object SimpleFMXBrowserFrm: TSimpleFMXBrowserFrm
     Padding.Top = 5.000000000000000000
     Padding.Right = 5.000000000000000000
     Padding.Bottom = 5.000000000000000000
-    Size.Width = 917.000000000000000000
+    Size.Width = 1000.000000000000000000
     Size.Height = 35.000000000000000000
     Size.PlatformDefault = False
     TabOrder = 1
@@ -29,14 +29,14 @@ object SimpleFMXBrowserFrm: TSimpleFMXBrowserFrm
       Align = Client
       TabOrder = 0
       Text = 'https://www.google.com'
-      Size.Width = 825.000000000000000000
+      Size.Width = 908.000000000000000000
       Size.Height = 25.000000000000000000
       Size.PlatformDefault = False
     end
     object Layout1: TLayout
       Align = Right
       Padding.Left = 5.000000000000000000
-      Position.X = 830.000000000000000000
+      Position.X = 913.000000000000000000
       Position.Y = 5.000000000000000000
       Size.Width = 82.000000000000000000
       Size.Height = 25.000000000000000000

diff --git a/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.pas b/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.pas
@@ -399,11 +399,14 @@ procedure TSimpleFMXBrowserFrm.FormResize(Sender: TObject);
 end;
 
 function TSimpleFMXBrowserFrm.GetFMXWindowParentRect : System.Types.TRect;
+var
+  TempScale : single;
 begin
+  TempScale     := FMXChromium1.ScreenScale;
   Result.Left   := 0;
-  Result.Top    := round(AddressPnl.Height);
-  Result.Right  := ClientWidth  - 1;
-  Result.Bottom := ClientHeight - 1;
+  Result.Top    := round(AddressPnl.Height * TempScale);
+  Result.Right  := round(ClientWidth  * TempScale) - 1;
+  Result.Bottom := round(ClientHeight * TempScale) - 1;
 end;
 
 procedure TSimpleFMXBrowserFrm.ResizeChild;

diff --git a/source/uCEFFMXChromium.pas b/source/uCEFFMXChromium.pas
@@ -58,7 +58,9 @@   TFMXChromium = class(TChromiumCore, IChromiumEvents)
     protected
       function  GetParentFormHandle : TCefWindowHandle; override;
       function  GetParentForm : TCustomForm;
+      function  GetScreenScale : Single;
       procedure InitializeDevToolsWindowInfo; virtual;
+
     public
       procedure ShowDevTools(inspectElementAt: TPoint);
       procedure CloseDevTools;
@@ -73,6 +75,8 @@   TFMXChromium = class(TChromiumCore, IChromiumEvents)
       function  CreateBrowser(const aWindowName : ustring = ''; const aContext : ICefRequestContext = nil; const aExtraInfo : ICefDictionaryValue = nil) : boolean; overload; virtual;
       function  SaveAsBitmapStream(var aStream : TStream; const aRect : System.Types.TRect) : boolean;
       function  TakeSnapshot(var aBitmap : TBitmap; const aRect : System.Types.TRect) : boolean;
+
+      property  ScreenScale    : single             read GetScreenScale;
   end;
 
 // *********************************************************
@@ -105,7 +109,9 @@   TFMXChromium = class(TChromiumCore, IChromiumEvents)
 implementation
 
 uses
-  System.SysUtils, System.Math;
+  {$IFDEF MSWINDOWS}FMX.Helpers.Win,{$ENDIF}
+  System.SysUtils, System.Math,
+  uCEFApplicationCore;
 
 function TFMXChromium.CreateBrowser(const aWindowName  : ustring;
                                     const aContext     : ICefRequestContext;
@@ -150,6 +156,25 @@ function TFMXChromium.GetParentForm : TCustomForm;
       TempComp := TempComp.owner;
 end;
 
+function TFMXChromium.GetScreenScale : Single;
+{$IFDEF MSWINDOWS}
+var
+  TempHandle : TCefWindowHandle;
+{$ENDIF}
+begin
+  {$IFDEF MSWINDOWS}
+  TempHandle := GetParentFormHandle;
+
+  if (TempHandle <> 0) then
+    Result := GetWndScale(TempHandle)
+   else
+  {$ENDIF}
+    if (GlobalCEFApp <> nil) then
+      Result := GlobalCEFApp.DeviceScaleFactor
+     else
+      Result := 1;
+end;
+
 function TFMXChromium.GetParentFormHandle : TCefWindowHandle;
 {$IFDEF MSWINDOWS}
 var

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