pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-08-14 21:42:50 +02:00
Code Issues Actions 1 Releases Activity

Update to CEF 80.0.5

Browse Source 
- Added overloaded ScreenToClient and ClientToScreen functions to TFMXBufferPanel
- Modified TFMXBufferPanel.GetScreenScale to read the current DPI
- Modified FMXExternalPumpBrowser and FMXTabbedOSRBrowser demos to read TFMXBufferPanel.ScreenScale and removed some pointer checks.
This commit is contained in:
Salvador Díaz Fau
2020-03-05 11:15:47 +01:00
parent f4dd3e69a3
commit e1f3fb5ee3
7 changed files with 176 additions and 145 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
README.md
View File

@@ -3,10 +3,10 @@ CEF4Delphi is an open source project created by Salvador D
CEF4Delphi is based on DCEF3, made by Henri Gourvest. The original license of DCEF3 still applies to CEF4Delphi. Read the license terms in the first lines of any *.pas file. CEF4Delphi is based on DCEF3, made by Henri Gourvest. The original license of DCEF3 still applies to CEF4Delphi. Read the license terms in the first lines of any *.pas file.
CEF4Delphi uses CEF 80.0.4 which includes Chromium 80.0.3987.122. CEF4Delphi uses CEF 80.0.5 which includes Chromium 80.0.3987.132.
The CEF binaries used by CEF4Delphi are available for download at spotify : The CEF binaries used by CEF4Delphi are available for download at spotify :
* [32 bits](http://opensource.spotify.com/cefbuilds/cef_binary_80.0.4%2Bg74f7b0c%2Bchromium-80.0.3987.122_windows32.tar.bz2) * [32 bits](http://opensource.spotify.com/cefbuilds/cef_binary_80.0.5%2Bgdf7fb8e%2Bchromium-80.0.3987.132_windows32.tar.bz2)
* [64 bits](http://opensource.spotify.com/cefbuilds/cef_binary_80.0.4%2Bg74f7b0c%2Bchromium-80.0.3987.122_windows64.tar.bz2) * [64 bits](http://opensource.spotify.com/cefbuilds/cef_binary_80.0.5%2Bgdf7fb8e%2Bchromium-80.0.3987.132_windows64.tar.bz2)
CEF4Delphi was developed and tested on Delphi 10.3 Rio and it has been tested in Delphi 7, Delphi XE, Delphi 10, Delphi 10.2 and Lazarus 2.0.6/FPC 3.0.4. CEF4Delphi includes VCL, FireMonkey (FMX) and Lazarus components. CEF4Delphi was developed and tested on Delphi 10.3 Rio and it has been tested in Delphi 7, Delphi XE, Delphi 10, Delphi 10.2 and Lazarus 2.0.6/FPC 3.0.4. CEF4Delphi includes VCL, FireMonkey (FMX) and Lazarus components.

65
demos/Delphi_FMX/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas
View File

@@ -326,7 +326,7 @@ procedure TFMXExternalPumpBrowserFrm.Panel1KeyDown( Sender : TObject;
var var
TempKeyEvent : TCefKeyEvent; TempKeyEvent : TCefKeyEvent;
begin begin
if not(Panel1.IsFocused) or (chrmosr = nil) then exit; if not(Panel1.IsFocused) then exit;
if (Key <> 0) and (KeyChar = #0) then if (Key <> 0) and (KeyChar = #0) then
begin begin
@@ -352,7 +352,7 @@ procedure TFMXExternalPumpBrowserFrm.Panel1KeyUp( Sender : TObject;
var var
TempKeyEvent : TCefKeyEvent; TempKeyEvent : TCefKeyEvent;
begin begin
if not(Panel1.IsFocused) or (chrmosr = nil) then exit; if not(Panel1.IsFocused) then exit;
if (Key = 0) and (KeyChar <> #0) then if (Key = 0) and (KeyChar <> #0) then
begin begin
@@ -408,7 +408,7 @@ var
TempEvent : TCefMouseEvent; TempEvent : TCefMouseEvent;
TempTime : integer; TempTime : integer;
begin begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then if not(ssTouch in Shift) then
begin begin
Panel1.SetFocus; Panel1.SetFocus;
@@ -454,20 +454,17 @@ end;
procedure TFMXExternalPumpBrowserFrm.Panel1MouseLeave(Sender: TObject); procedure TFMXExternalPumpBrowserFrm.Panel1MouseLeave(Sender: TObject);
var var
TempEvent : TCefMouseEvent; TempEvent : TCefMouseEvent;
TempPoint : TPoint; TempPoint : TPointF;
TempPointF : TPointF;
TempTime : integer; TempTime : integer;
begin begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and GetMousePosition(TempPointF) then if GetMousePosition(TempPoint) then
begin begin
TempPoint.x := round(TempPointF.x);
TempPoint.y := round(TempPointF.y);
TempPoint := Panel1.ScreenToClient(TempPoint); TempPoint := Panel1.ScreenToClient(TempPoint);
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick; if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
TempEvent.x := TempPoint.x; TempEvent.x := round(TempPoint.x);
TempEvent.y := TempPoint.y; TempEvent.y := round(TempPoint.y);
TempEvent.modifiers := GetCefMouseModifiers; TempEvent.modifiers := GetCefMouseModifiers;
chrmosr.SendMouseMoveEvent(@TempEvent, True); chrmosr.SendMouseMoveEvent(@TempEvent, True);
end; end;
@@ -480,12 +477,12 @@ var
TempEvent : TCefMouseEvent; TempEvent : TCefMouseEvent;
TempTime : integer; TempTime : integer;
begin begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then if not(ssTouch in Shift) then
begin begin
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick; if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
TempEvent.x := round(X); TempEvent.x := round(x);
TempEvent.y := round(Y); TempEvent.y := round(y);
TempEvent.modifiers := getModifiers(Shift); TempEvent.modifiers := getModifiers(Shift);
chrmosr.SendMouseMoveEvent(@TempEvent, False); chrmosr.SendMouseMoveEvent(@TempEvent, False);
end; end;
@@ -498,7 +495,7 @@ procedure TFMXExternalPumpBrowserFrm.Panel1MouseUp(Sender : TObject;
var var
TempEvent : TCefMouseEvent; TempEvent : TCefMouseEvent;
begin begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then if not(ssTouch in Shift) then
begin begin
TempEvent.x := round(X); TempEvent.x := round(X);
TempEvent.y := round(Y); TempEvent.y := round(Y);
@@ -513,17 +510,13 @@ procedure TFMXExternalPumpBrowserFrm.Panel1MouseWheel( Sender : TObject;
var Handled : Boolean); var Handled : Boolean);
var var
TempEvent : TCefMouseEvent; TempEvent : TCefMouseEvent;
TempPoint : TPoint; TempPoint : TPointF;
TempPointF : TPointF;
begin begin
if Panel1.IsFocused and (GlobalCEFApp <> nil) and (chrmosr <> nil) and GetMousePosition(TempPointF) then if Panel1.IsFocused and GetMousePosition(TempPoint) then
begin begin
TempPoint.x := round(TempPointF.x);
TempPoint.y := round(TempPointF.y);
TempPoint := Panel1.ScreenToClient(TempPoint); TempPoint := Panel1.ScreenToClient(TempPoint);
TempEvent.x := round(TempPoint.x);
TempEvent.x := TempPoint.x; TempEvent.y := round(TempPoint.y);
TempEvent.y := TempPoint.y;
TempEvent.modifiers := getModifiers(Shift); TempEvent.modifiers := getModifiers(Shift);
chrmosr.SendMouseWheelEvent(@TempEvent, 0, WheelDelta); chrmosr.SendMouseWheelEvent(@TempEvent, 0, WheelDelta);
end; end;
@@ -552,8 +545,7 @@ begin
chrmosr.SendFocusEvent(False); chrmosr.SendFocusEvent(False);
end; end;
procedure TFMXExternalPumpBrowserFrm.chrmosrAfterCreated(Sender: TObject; procedure TFMXExternalPumpBrowserFrm.chrmosrAfterCreated(Sender: TObject; const browser: ICefBrowser);
const browser: ICefBrowser);
begin begin
// Now the browser is fully initialized we can enable the UI. // Now the browser is fully initialized we can enable the UI.
Caption := 'FMX External Pump Browser'; Caption := 'FMX External Pump Browser';
@@ -610,15 +602,13 @@ procedure TFMXExternalPumpBrowserFrm.chrmosrGetScreenInfo( Sender : TOb
out Result : Boolean); out Result : Boolean);
var var
TempRect : TCEFRect; TempRect : TCEFRect;
begin
if (GlobalCEFApp <> nil) then
begin begin
TempRect.x := 0; TempRect.x := 0;
TempRect.y := 0; TempRect.y := 0;
TempRect.width := round(Panel1.Width); TempRect.width := round(Panel1.Width);
TempRect.height := round(Panel1.Height); TempRect.height := round(Panel1.Height);
screenInfo.device_scale_factor := GlobalCEFApp.DeviceScaleFactor; screenInfo.device_scale_factor := Panel1.ScreenScale;
screenInfo.depth := 0; screenInfo.depth := 0;
screenInfo.depth_per_component := 0; screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False); screenInfo.is_monochrome := Ord(False);
@@ -626,9 +616,6 @@ begin
screenInfo.available_rect := TempRect; screenInfo.available_rect := TempRect;
Result := True; Result := True;
end
else
Result := False;
end; end;
procedure TFMXExternalPumpBrowserFrm.chrmosrGetScreenPoint( Sender : TObject; procedure TFMXExternalPumpBrowserFrm.chrmosrGetScreenPoint( Sender : TObject;
@@ -640,8 +627,6 @@ procedure TFMXExternalPumpBrowserFrm.chrmosrGetScreenPoint( Sender : TObje
out Result : Boolean); out Result : Boolean);
var var
TempScreenPt, TempViewPt : TPoint; TempScreenPt, TempViewPt : TPoint;
begin
if (GlobalCEFApp <> nil) then
begin begin
// TFMXBufferPanel.ClientToScreen applies the scale factor. No need to call LogicalToDevice to set TempViewPt. // TFMXBufferPanel.ClientToScreen applies the scale factor. No need to call LogicalToDevice to set TempViewPt.
TempViewPt.x := viewX; TempViewPt.x := viewX;
@@ -650,23 +635,17 @@ begin
screenX := TempScreenPt.x; screenX := TempScreenPt.x;
screenY := TempScreenPt.y; screenY := TempScreenPt.y;
Result := True; Result := True;
end
else
Result := False;
end; end;
procedure TFMXExternalPumpBrowserFrm.chrmosrGetViewRect( Sender : TObject; procedure TFMXExternalPumpBrowserFrm.chrmosrGetViewRect( Sender : TObject;
const browser : ICefBrowser; const browser : ICefBrowser;
var rect : TCefRect); var rect : TCefRect);
begin
if (GlobalCEFApp <> nil) then
begin begin
rect.x := 0; rect.x := 0;
rect.y := 0; rect.y := 0;
rect.width := round(Panel1.Width); rect.width := round(Panel1.Width);
rect.height := round(Panel1.Height); rect.height := round(Panel1.Height);
end; end;
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrPaint( Sender : TObject; procedure TFMXExternalPumpBrowserFrm.chrmosrPaint( Sender : TObject;
const browser : ICefBrowser; const browser : ICefBrowser;
@@ -827,22 +806,19 @@ begin
FShowPopUp := False; FShowPopUp := False;
FPopUpRect := rect(0, 0, 0, 0); FPopUpRect := rect(0, 0, 0, 0);
if (chrmosr <> nil) then chrmosr.Invalidate(PET_VIEW); chrmosr.Invalidate(PET_VIEW);
end; end;
end; end;
procedure TFMXExternalPumpBrowserFrm.chrmosrPopupSize( Sender : TObject; procedure TFMXExternalPumpBrowserFrm.chrmosrPopupSize( Sender : TObject;
const browser : ICefBrowser; const browser : ICefBrowser;
const rect : PCefRect); const rect : PCefRect);
begin
if (GlobalCEFApp <> nil) then
begin begin
FPopUpRect.Left := rect.x; FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y; FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1; FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1; FPopUpRect.Bottom := rect.y + rect.height - 1;
end; end;
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrTooltip( Sender : TObject; procedure TFMXExternalPumpBrowserFrm.chrmosrTooltip( Sender : TObject;
const browser : ICefBrowser; const browser : ICefBrowser;
@@ -882,9 +858,10 @@ var
PositionChanged: Boolean; PositionChanged: Boolean;
begin begin
PositionChanged := (ALeft <> Left) or (ATop <> Top); PositionChanged := (ALeft <> Left) or (ATop <> Top);
inherited SetBounds(ALeft, ATop, AWidth, AHeight); inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if PositionChanged then
NotifyMoveOrResizeStarted; if PositionChanged then NotifyMoveOrResizeStarted;
end; end;
procedure TFMXExternalPumpBrowserFrm.NotifyMoveOrResizeStarted; procedure TFMXExternalPumpBrowserFrm.NotifyMoveOrResizeStarted;

28
demos/Delphi_FMX/FMXTabbedOSRBrowser/uBrowserFrame.pas
View File

@@ -339,7 +339,7 @@ procedure TBrowserFrame.FMXBufferPanel1KeyDown(Sender: TObject; var Key: Word;
var var
TempKeyEvent : TCefKeyEvent; TempKeyEvent : TCefKeyEvent;
begin begin
if not(FMXBufferPanel1.IsFocused) or (FMXChromium1 = nil) then exit; if not(FMXBufferPanel1.IsFocused) then exit;
if (Key <> 0) and (KeyChar = #0) then if (Key <> 0) and (KeyChar = #0) then
begin begin
@@ -363,7 +363,7 @@ procedure TBrowserFrame.FMXBufferPanel1KeyUp(Sender: TObject; var Key: Word;
var var
TempKeyEvent : TCefKeyEvent; TempKeyEvent : TCefKeyEvent;
begin begin
if not(FMXBufferPanel1.IsFocused) or (FMXChromium1 = nil) then exit; if not(FMXBufferPanel1.IsFocused) then exit;
if (Key = 0) and (KeyChar <> #0) then if (Key = 0) and (KeyChar <> #0) then
begin begin
@@ -566,15 +566,13 @@ procedure TBrowserFrame.FMXChromium1GetScreenInfo(Sender: TObject;
out Result: Boolean); out Result: Boolean);
var var
TempRect : TCEFRect; TempRect : TCEFRect;
begin
if (GlobalCEFApp <> nil) then
begin begin
TempRect.x := 0; TempRect.x := 0;
TempRect.y := 0; TempRect.y := 0;
TempRect.width := round(FMXBufferPanel1.Width); TempRect.width := round(FMXBufferPanel1.Width);
TempRect.height := round(FMXBufferPanel1.Height); TempRect.height := round(FMXBufferPanel1.Height);
screenInfo.device_scale_factor := GlobalCEFApp.DeviceScaleFactor; screenInfo.device_scale_factor := FMXBufferPanel1.ScreenScale;
screenInfo.depth := 0; screenInfo.depth := 0;
screenInfo.depth_per_component := 0; screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False); screenInfo.is_monochrome := Ord(False);
@@ -582,9 +580,6 @@ begin
screenInfo.available_rect := TempRect; screenInfo.available_rect := TempRect;
Result := True; Result := True;
end
else
Result := False;
end; end;
procedure TBrowserFrame.FMXChromium1GetScreenPoint(Sender: TObject; procedure TBrowserFrame.FMXChromium1GetScreenPoint(Sender: TObject;
@@ -592,8 +587,6 @@ procedure TBrowserFrame.FMXChromium1GetScreenPoint(Sender: TObject;
screenY: Integer; out Result: Boolean); screenY: Integer; out Result: Boolean);
var var
TempScreenPt, TempViewPt : TPoint; TempScreenPt, TempViewPt : TPoint;
begin
if (GlobalCEFApp <> nil) then
begin begin
// TFMXBufferPanel.ClientToScreen applies the scale factor. No need to call LogicalToDevice to set TempViewPt. // TFMXBufferPanel.ClientToScreen applies the scale factor. No need to call LogicalToDevice to set TempViewPt.
TempViewPt.x := viewX; TempViewPt.x := viewX;
@@ -602,22 +595,16 @@ begin
screenX := TempScreenPt.x; screenX := TempScreenPt.x;
screenY := TempScreenPt.y; screenY := TempScreenPt.y;
Result := True; Result := True;
end
else
Result := False;
end; end;
procedure TBrowserFrame.FMXChromium1GetViewRect(Sender: TObject; procedure TBrowserFrame.FMXChromium1GetViewRect(Sender: TObject;
const browser: ICefBrowser; var rect: TCefRect); const browser: ICefBrowser; var rect: TCefRect);
begin
if (GlobalCEFApp <> nil) then
begin begin
rect.x := 0; rect.x := 0;
rect.y := 0; rect.y := 0;
rect.width := round(FMXBufferPanel1.Width); rect.width := round(FMXBufferPanel1.Width);
rect.height := round(FMXBufferPanel1.Height); rect.height := round(FMXBufferPanel1.Height);
end; end;
end;
procedure TBrowserFrame.FMXChromium1LoadError(Sender: TObject; procedure TBrowserFrame.FMXChromium1LoadError(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer;
@@ -811,20 +798,17 @@ begin
FShowPopUp := False; FShowPopUp := False;
FPopUpRect := rect(0, 0, 0, 0); FPopUpRect := rect(0, 0, 0, 0);
if (FMXChromium1 <> nil) then FMXChromium1.Invalidate(PET_VIEW); FMXChromium1.Invalidate(PET_VIEW);
end; end;
end; end;
procedure TBrowserFrame.FMXChromium1PopupSize(Sender: TObject; procedure TBrowserFrame.FMXChromium1PopupSize(Sender: TObject;
const browser: ICefBrowser; const rect: PCefRect); const browser: ICefBrowser; const rect: PCefRect);
begin
if (GlobalCEFApp <> nil) then
begin begin
FPopUpRect.Left := rect.x; FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y; FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + LogicalToDevice(rect.width, GlobalCEFApp.DeviceScaleFactor) - 1; FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + LogicalToDevice(rect.height, GlobalCEFApp.DeviceScaleFactor) - 1; FPopUpRect.Bottom := rect.y + rect.height - 1;
end;
end; end;
procedure TBrowserFrame.FMXChromium1StatusMessage(Sender: TObject; procedure TBrowserFrame.FMXChromium1StatusMessage(Sender: TObject;

2
packages/cef4delphi_lazarus.lpk
View File

@@ -21,7 +21,7 @@
</CompilerOptions> </CompilerOptions>
<Description Value="CEF4Delphi is an open source project created by Salvador Díaz Fau to embed Chromium-based browsers in applications made with Delphi or Lazarus/FPC."/> <Description Value="CEF4Delphi is an open source project created by Salvador Díaz Fau to embed Chromium-based browsers in applications made with Delphi or Lazarus/FPC."/>
<License Value="MPL 1.1"/> <License Value="MPL 1.1"/>
<Version Major="80" Release="4"/> <Version Major="80" Release="5"/>
<Files Count="147"> <Files Count="147">
<Item1> <Item1>
<Filename Value="..\source\uCEFAccessibilityHandler.pas"/> <Filename Value="..\source\uCEFAccessibilityHandler.pas"/>

4
source/uCEFApplicationCore.pas
View File

@@ -62,13 +62,13 @@ uses
const const
CEF_SUPPORTED_VERSION_MAJOR = 80; CEF_SUPPORTED_VERSION_MAJOR = 80;
CEF_SUPPORTED_VERSION_MINOR = 0; CEF_SUPPORTED_VERSION_MINOR = 0;
CEF_SUPPORTED_VERSION_RELEASE = 4; CEF_SUPPORTED_VERSION_RELEASE = 5;
CEF_SUPPORTED_VERSION_BUILD = 0; CEF_SUPPORTED_VERSION_BUILD = 0;
CEF_CHROMEELF_VERSION_MAJOR = 80; CEF_CHROMEELF_VERSION_MAJOR = 80;
CEF_CHROMEELF_VERSION_MINOR = 0; CEF_CHROMEELF_VERSION_MINOR = 0;
CEF_CHROMEELF_VERSION_RELEASE = 3987; CEF_CHROMEELF_VERSION_RELEASE = 3987;
CEF_CHROMEELF_VERSION_BUILD = 122; CEF_CHROMEELF_VERSION_BUILD = 132;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
LIBCEF_DLL = 'libcef.dll'; LIBCEF_DLL = 'libcef.dll';

92
source/uCEFFMXBufferPanel.pas
View File

@@ -43,7 +43,7 @@ interface
uses uses
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
Winapi.Windows, Winapi.Windows, FMX.Platform.Win,
{$ELSE} {$ELSE}
System.SyncObjs, System.SyncObjs,
{$ENDIF} {$ENDIF}
@@ -51,7 +51,8 @@ uses
{$IFDEF DELPHI17_UP} {$IFDEF DELPHI17_UP}
FMX.Graphics, FMX.Graphics,
{$ENDIF} {$ENDIF}
FMX.Types, FMX.Controls; FMX.Types, FMX.Controls, FMX.Forms,
uCEFTypes;
type type
TDialogKeyEvent = procedure(Sender: TObject; var Key: Word; Shift: TShiftState) of object; TDialogKeyEvent = procedure(Sender: TObject; var Key: Word; Shift: TShiftState) of object;
@@ -79,6 +80,8 @@ type
function GetScreenScale : Single; function GetScreenScale : Single;
function GetBufferWidth : integer; function GetBufferWidth : integer;
function GetBufferHeight : integer; function GetBufferHeight : integer;
function GetParentForm : TCustomForm;
function GetParentFormHandle : TCefWindowHandle;
function CopyBuffer : boolean; function CopyBuffer : boolean;
function SaveBufferToFile(const aFilename : string) : boolean; function SaveBufferToFile(const aFilename : string) : boolean;
@@ -97,8 +100,10 @@ type
procedure BufferDraw(x, y : integer; const aBitmap : TBitmap); procedure BufferDraw(x, y : integer; const aBitmap : TBitmap);
function UpdateBufferDimensions(aWidth, aHeight : integer) : boolean; function UpdateBufferDimensions(aWidth, aHeight : integer) : boolean;
function BufferIsResized(aUseMutex : boolean = True) : boolean; function BufferIsResized(aUseMutex : boolean = True) : boolean;
function ScreenToClient(aPoint : TPoint) : TPoint; function ScreenToClient(aPoint : TPoint) : TPoint; overload;
function ClientToScreen(aPoint : TPoint) : TPoint; function ScreenToClient(aPoint : TPointF) : TPointF; overload;
function ClientToScreen(aPoint : TPoint) : TPoint; overload;
function ClientToScreen(aPoint : TPointF) : TPointF; overload;
property Buffer : TBitmap read FBuffer; property Buffer : TBitmap read FBuffer;
property ScanlineSize : integer read FScanlineSize; property ScanlineSize : integer read FScanlineSize;
@@ -155,6 +160,7 @@ implementation
uses uses
System.SysUtils, System.Math, System.SysUtils, System.Math,
{$IFDEF MSWINDOWS}FMX.Helpers.Win,{$ENDIF}
FMX.Platform, uCEFMiscFunctions, uCEFApplicationCore; FMX.Platform, uCEFMiscFunctions, uCEFApplicationCore;
constructor TFMXBufferPanel.Create(AOwner: TComponent); constructor TFMXBufferPanel.Create(AOwner: TComponent);
@@ -281,6 +287,7 @@ var
TempSrc, TempDst, TempClip : TRectF; TempSrc, TempDst, TempClip : TRectF;
TempState : TCanvasSaveState; TempState : TCanvasSaveState;
TempWrongSize : boolean; TempWrongSize : boolean;
TempScale : single;
begin begin
Result := False; Result := False;
TempWrongSize := False; TempWrongSize := False;
@@ -291,8 +298,9 @@ begin
try try
if (FBuffer <> nil) then if (FBuffer <> nil) then
begin begin
TempScale := ScreenScale;
TempSrc := TRectF.Create(0, 0, FBuffer.Width, FBuffer.Height); TempSrc := TRectF.Create(0, 0, FBuffer.Width, FBuffer.Height);
TempDst := TRectF.Create(0, 0, FBuffer.Width / ScreenScale, FBuffer.Height / ScreenScale); TempDst := TRectF.Create(0, 0, FBuffer.Width / TempScale, FBuffer.Height / TempScale);
TempClip := TRectF.Create(0, 0, Width, Height); TempClip := TRectF.Create(0, 0, Width, Height);
TempState := Canvas.SaveState; TempState := Canvas.SaveState;
@@ -341,8 +349,52 @@ begin
end; end;
end; end;
function TFMXBufferPanel.GetScreenScale : Single; function TFMXBufferPanel.GetParentForm : TCustomForm;
var
TempComp : TComponent;
begin begin
Result := nil;
TempComp := Owner;
while (TempComp <> nil) do
if (TempComp is TCustomForm) then
begin
Result := TCustomForm(TempComp);
exit;
end
else
TempComp := TempComp.owner;
end;
function TFMXBufferPanel.GetParentFormHandle : TCefWindowHandle;
{$IFDEF MSWINDOWS}
var
TempForm : TCustomForm;
{$ENDIF}
begin
Result := 0;
{$IFDEF MSWINDOWS}
TempForm := GetParentForm;
if (TempForm <> nil) then
Result := FmxHandleToHWND(TempForm.Handle)
else
if (Application <> nil) and
(Application.MainForm <> nil) then
Result := FmxHandleToHWND(Application.MainForm.Handle);
{$ENDIF}
end;
function TFMXBufferPanel.GetScreenScale : Single;
var
TempHandle : TCefWindowHandle;
begin
TempHandle := GetParentFormHandle;
if (TempHandle <> 0) then
Result := GetWndScale(TempHandle)
else
if (GlobalCEFApp <> nil) then if (GlobalCEFApp <> nil) then
Result := GlobalCEFApp.DeviceScaleFactor Result := GlobalCEFApp.DeviceScaleFactor
else else
@@ -368,11 +420,13 @@ end;
procedure TFMXBufferPanel.BufferDraw(x, y : integer; const aBitmap : TBitmap); procedure TFMXBufferPanel.BufferDraw(x, y : integer; const aBitmap : TBitmap);
var var
TempSrc, TempDst : TRectF; TempSrc, TempDst : TRectF;
TempScale : single;
begin begin
if (FBuffer <> nil) then if (FBuffer <> nil) then
begin begin
TempScale := ScreenScale;
TempSrc := TRectF.Create(0, 0, aBitmap.Width, aBitmap.Height); TempSrc := TRectF.Create(0, 0, aBitmap.Width, aBitmap.Height);
TempDst := TRectF.Create(x, y, x + (aBitmap.Width / ScreenScale), y + (aBitmap.Height / ScreenScale)); TempDst := TRectF.Create(x, y, x + (aBitmap.Width / TempScale), y + (aBitmap.Height / TempScale));
if FBuffer.Canvas.BeginScene then if FBuffer.Canvas.BeginScene then
try try
@@ -384,10 +438,14 @@ begin
end; end;
function TFMXBufferPanel.UpdateBufferDimensions(aWidth, aHeight : integer) : boolean; function TFMXBufferPanel.UpdateBufferDimensions(aWidth, aHeight : integer) : boolean;
var
TempScale : single;
begin begin
Result := False; Result := False;
TempScale := ScreenScale;
if ((FBuffer = nil) or if ((FBuffer = nil) or
(FBuffer.BitmapScale <> TempScale) or
(FBuffer.Width <> aWidth) or (FBuffer.Width <> aWidth) or
(FBuffer.Height <> aHeight)) then (FBuffer.Height <> aHeight)) then
begin begin
@@ -395,7 +453,7 @@ begin
FBuffer := TBitmap.Create(aWidth, aHeight); FBuffer := TBitmap.Create(aWidth, aHeight);
{$IFDEF DELPHI17_UP} {$IFDEF DELPHI17_UP}
FBuffer.BitmapScale := ScreenScale; FBuffer.BitmapScale := TempScale;
FScanlineSize := FBuffer.BytesPerLine; FScanlineSize := FBuffer.BytesPerLine;
{$ELSE} {$ELSE}
FScanlineSize := aWidth * SizeOf(TRGBQuad); FScanlineSize := aWidth * SizeOf(TRGBQuad);
@@ -407,16 +465,18 @@ end;
function TFMXBufferPanel.BufferIsResized(aUseMutex : boolean) : boolean; function TFMXBufferPanel.BufferIsResized(aUseMutex : boolean) : boolean;
var var
TempWidth, TempHeight : integer; TempWidth, TempHeight : integer;
TempScale : single;
begin begin
Result := False; Result := False;
if (GlobalCEFApp = nil) then exit;
if not(aUseMutex) or BeginBufferDraw then if not(aUseMutex) or BeginBufferDraw then
begin begin
TempWidth := round(Width * GlobalCEFApp.DeviceScaleFactor); TempScale := ScreenScale;
TempHeight := round(Height * GlobalCEFApp.DeviceScaleFactor); TempWidth := round(Width * TempScale);
TempHeight := round(Height * TempScale);
Result := (FBuffer <> nil) and Result := (FBuffer <> nil) and
(FBuffer.BitmapScale = TempScale) and
(FBuffer.Width = TempWidth) and (FBuffer.Width = TempWidth) and
(FBuffer.Height = TempHeight); (FBuffer.Height = TempHeight);
@@ -435,6 +495,11 @@ begin
Result.y := round(TempPoint.y); Result.y := round(TempPoint.y);
end; end;
function TFMXBufferPanel.ScreenToClient(aPoint : TPointF) : TPointF;
begin
Result := ScreenToLocal(aPoint);
end;
function TFMXBufferPanel.ClientToScreen(aPoint : TPoint) : TPoint; function TFMXBufferPanel.ClientToScreen(aPoint : TPoint) : TPoint;
var var
TempPoint : TPointF; TempPoint : TPointF;
@@ -446,4 +511,9 @@ begin
Result.y := round(TempPoint.y); Result.y := round(TempPoint.y);
end; end;
function TFMXBufferPanel.ClientToScreen(aPoint : TPointF) : TPointF;
begin
Result := LocalToScreen(aPoint);
end;
end. end.

4
update_CEF4Delphi.json
View File

@@ -2,9 +2,9 @@
"UpdateLazPackages" : [ "UpdateLazPackages" : [
{ {
"ForceNotify" : true, "ForceNotify" : true,
"InternalVersion" : 105, "InternalVersion" : 106,
"Name" : "cef4delphi_lazarus.lpk", "Name" : "cef4delphi_lazarus.lpk",
"Version" : "80.0.4.0" "Version" : "80.0.5.0"
} }
], ],
"UpdatePackageData" : { "UpdatePackageData" : {