1
0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2024-11-24 08:02:15 +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.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,9 +94,9 @@ 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
@ -122,7 +104,6 @@ object BrowserFrame: TBrowserFrame
OnLoadingStateChange = FMXChromium1LoadingStateChange
OnAddressChange = FMXChromium1AddressChange
OnTitleChange = FMXChromium1TitleChange
OnStatusMessage = FMXChromium1StatusMessage
OnBeforePopup = FMXChromium1BeforePopup
OnAfterCreated = FMXChromium1AfterCreated
OnBeforeClose = FMXChromium1BeforeClose

View File

@ -54,8 +54,6 @@ type
TBrowserFrame = class(TFrame)
FMXChromium1: TFMXChromium;
StatusBar: TStatusBar;
StatusLbl: TLabel;
AddressLay: TLayout;
GoBtn: TSpeedButton;
NavButtonLay: TLayout;
@ -81,7 +79,6 @@ type
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 @@ end;
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 @@ begin
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

View File

@ -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

View File

@ -265,11 +265,14 @@ begin
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;

View File

@ -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

View File

@ -399,11 +399,14 @@ begin
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;

View File

@ -58,7 +58,9 @@ type
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 @@ type
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 @@ type
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 @@ begin
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

View File

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