1
0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-06-12 22:07:39 +02:00

Issue #273 fixed

- Added TFMXChromium.ScreenScale property
This commit is contained in:
Salvador Díaz Fau
2020-04-09 18:43:03 +02:00
parent c9b2af2a5e
commit 846aeddd54
8 changed files with 57 additions and 55 deletions

View File

@ -6,24 +6,6 @@ object BrowserFrame: TBrowserFrame
Size.Width = 1000.000000000000000000 Size.Width = 1000.000000000000000000
Size.Height = 733.000000000000000000 Size.Height = 733.000000000000000000
Size.PlatformDefault = False 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 object AddressLay: TLayout
Align = Top Align = Top
Padding.Left = 5.000000000000000000 Padding.Left = 5.000000000000000000
@ -35,7 +17,7 @@ object BrowserFrame: TBrowserFrame
Size.Width = 998.000000000000000000 Size.Width = 998.000000000000000000
Size.Height = 35.000000000000000000 Size.Height = 35.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabOrder = 4 TabOrder = 3
object GoBtn: TSpeedButton object GoBtn: TSpeedButton
Align = Right Align = Right
Margins.Left = 5.000000000000000000 Margins.Left = 5.000000000000000000
@ -112,9 +94,9 @@ object BrowserFrame: TBrowserFrame
object WindowParentLay: TLayout object WindowParentLay: TLayout
Align = Client Align = Client
Size.Width = 998.000000000000000000 Size.Width = 998.000000000000000000
Size.Height = 674.000000000000000000 Size.Height = 696.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabOrder = 5 TabOrder = 4
OnResize = WindowParentLayResize OnResize = WindowParentLayResize
end end
object FMXChromium1: TFMXChromium object FMXChromium1: TFMXChromium
@ -122,7 +104,6 @@ object BrowserFrame: TBrowserFrame
OnLoadingStateChange = FMXChromium1LoadingStateChange OnLoadingStateChange = FMXChromium1LoadingStateChange
OnAddressChange = FMXChromium1AddressChange OnAddressChange = FMXChromium1AddressChange
OnTitleChange = FMXChromium1TitleChange OnTitleChange = FMXChromium1TitleChange
OnStatusMessage = FMXChromium1StatusMessage
OnBeforePopup = FMXChromium1BeforePopup OnBeforePopup = FMXChromium1BeforePopup
OnAfterCreated = FMXChromium1AfterCreated OnAfterCreated = FMXChromium1AfterCreated
OnBeforeClose = FMXChromium1BeforeClose OnBeforeClose = FMXChromium1BeforeClose

View File

@ -54,8 +54,6 @@ type
TBrowserFrame = class(TFrame) TBrowserFrame = class(TFrame)
FMXChromium1: TFMXChromium; FMXChromium1: TFMXChromium;
StatusBar: TStatusBar;
StatusLbl: TLabel;
AddressLay: TLayout; AddressLay: TLayout;
GoBtn: TSpeedButton; GoBtn: TSpeedButton;
NavButtonLay: TLayout; NavButtonLay: TLayout;
@ -81,7 +79,6 @@ type
procedure FMXChromium1AddressChange(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const url: ustring); 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 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 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); procedure FMXChromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring);
protected protected
@ -144,12 +141,14 @@ end;
function TBrowserFrame.GetFMXWindowParentRect : System.Types.TRect; function TBrowserFrame.GetFMXWindowParentRect : System.Types.TRect;
var var
TempRect : TRectF; TempRect : TRectF;
TempScale : single;
begin begin
TempRect := WindowParentLay.AbsoluteRect; TempScale := FMXChromium1.ScreenScale;
Result.Left := round(TempRect.Left); TempRect := WindowParentLay.AbsoluteRect;
Result.Top := round(TempRect.Top); Result.Left := round(TempRect.Left * TempScale);
Result.Right := round(TempRect.Right); Result.Top := round(TempRect.Top * TempScale);
Result.Bottom := round(TempREct.Bottom); Result.Right := round(TempRect.Right * TempScale) - 1;
Result.Bottom := round(TempREct.Bottom * TempScale) - 1;
end; end;
procedure TBrowserFrame.ReloadBtnClick(Sender: TObject); procedure TBrowserFrame.ReloadBtnClick(Sender: TObject);
@ -297,15 +296,6 @@ begin
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]); Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end; 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; procedure TBrowserFrame.FMXChromium1TitleChange(Sender: TObject;
const browser: ICefBrowser; const title: ustring); const browser: ICefBrowser; const title: ustring);
begin begin

View File

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

View File

@ -265,11 +265,14 @@ begin
end; end;
function TChildForm.GetFMXWindowParentRect : System.Types.TRect; function TChildForm.GetFMXWindowParentRect : System.Types.TRect;
var
TempScale : single;
begin begin
TempScale := FMXChromium1.ScreenScale;
Result.Left := 0; Result.Left := 0;
Result.Top := 0; Result.Top := 0;
Result.Right := ClientWidth - 1; Result.Right := round(ClientWidth * TempScale) - 1;
Result.Bottom := ClientHeight - 1; Result.Bottom := round(ClientHeight * TempScale) - 1;
end; end;
procedure TChildForm.ResizeChild; procedure TChildForm.ResizeChild;

View File

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

View File

@ -399,11 +399,14 @@ begin
end; end;
function TSimpleFMXBrowserFrm.GetFMXWindowParentRect : System.Types.TRect; function TSimpleFMXBrowserFrm.GetFMXWindowParentRect : System.Types.TRect;
var
TempScale : single;
begin begin
TempScale := FMXChromium1.ScreenScale;
Result.Left := 0; Result.Left := 0;
Result.Top := round(AddressPnl.Height); Result.Top := round(AddressPnl.Height * TempScale);
Result.Right := ClientWidth - 1; Result.Right := round(ClientWidth * TempScale) - 1;
Result.Bottom := ClientHeight - 1; Result.Bottom := round(ClientHeight * TempScale) - 1;
end; end;
procedure TSimpleFMXBrowserFrm.ResizeChild; procedure TSimpleFMXBrowserFrm.ResizeChild;

View File

@ -58,7 +58,9 @@ type
protected protected
function GetParentFormHandle : TCefWindowHandle; override; function GetParentFormHandle : TCefWindowHandle; override;
function GetParentForm : TCustomForm; function GetParentForm : TCustomForm;
function GetScreenScale : Single;
procedure InitializeDevToolsWindowInfo; virtual; procedure InitializeDevToolsWindowInfo; virtual;
public public
procedure ShowDevTools(inspectElementAt: TPoint); procedure ShowDevTools(inspectElementAt: TPoint);
procedure CloseDevTools; procedure CloseDevTools;
@ -73,6 +75,8 @@ type
function CreateBrowser(const aWindowName : ustring = ''; const aContext : ICefRequestContext = nil; const aExtraInfo : ICefDictionaryValue = nil) : boolean; overload; virtual; 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 SaveAsBitmapStream(var aStream : TStream; const aRect : System.Types.TRect) : boolean;
function TakeSnapshot(var aBitmap : TBitmap; const aRect : System.Types.TRect) : boolean; function TakeSnapshot(var aBitmap : TBitmap; const aRect : System.Types.TRect) : boolean;
property ScreenScale : single read GetScreenScale;
end; end;
// ********************************************************* // *********************************************************
@ -105,7 +109,9 @@ type
implementation implementation
uses uses
System.SysUtils, System.Math; {$IFDEF MSWINDOWS}FMX.Helpers.Win,{$ENDIF}
System.SysUtils, System.Math,
uCEFApplicationCore;
function TFMXChromium.CreateBrowser(const aWindowName : ustring; function TFMXChromium.CreateBrowser(const aWindowName : ustring;
const aContext : ICefRequestContext; const aContext : ICefRequestContext;
@ -150,6 +156,25 @@ begin
TempComp := TempComp.owner; TempComp := TempComp.owner;
end; 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; function TFMXChromium.GetParentFormHandle : TCefWindowHandle;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
var var

View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [ "UpdateLazPackages" : [
{ {
"ForceNotify" : true, "ForceNotify" : true,
"InternalVersion" : 115, "InternalVersion" : 116,
"Name" : "cef4delphi_lazarus.lpk", "Name" : "cef4delphi_lazarus.lpk",
"Version" : "80.1.15.0" "Version" : "80.1.15.0"
} }