pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-06-02 21:57:37 +02:00
Code Issues Actions 1 Releases Activity

Fixed ConsoleBrowser2 resize issues

Browse Source 
Renamed TCEFBrowserBitmap.BeginBufferDraw to TCEFBrowserBitmap.BeginDraw
Renamed TCEFBrowserBitmap.EndBufferDraw to TCEFBrowserBitmap.EndDraw
Renamed TCEFBrowserBitmap.UpdateBufferDimensions to TCEFBrowserBitmap.UpdateDimensions
Removed TCEFBrowserBitmap.BufferIsResize
This commit is contained in:
Salvador Díaz Fau 2024-11-30 11:18:21 +01:00
parent 5d4705c34f
commit 6badc8f3bd
7 changed files with 108 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
demos/Delphi_VCL/ConsoleBrowser2/uCEFBrowserThread.pas
View File

@ -62,6 +62,7 @@ type
procedure Resize; procedure Resize;
function CreateBrowser : boolean; function CreateBrowser : boolean;
procedure CloseBrowser; procedure CloseBrowser;
procedure UpdateSize(aNewWidth, aNewHeight : integer);
procedure InitError; procedure InitError;
procedure WebpagePostProcessing; procedure WebpagePostProcessing;
procedure WebpageError; procedure WebpageError;
@ -76,6 +77,7 @@ type
function CopySnapshot(var aSnapshot : TBitmap) : boolean; function CopySnapshot(var aSnapshot : TBitmap) : boolean;
function SaveSnapshotToFile(const aPath : ustring) : boolean; function SaveSnapshotToFile(const aPath : ustring) : boolean;
procedure LoadUrl(const aURL : ustring); procedure LoadUrl(const aURL : ustring);
function UpdateBrowserSize(aNewWidth, aNewHeight : integer): boolean;
property ErrorCode : integer read GetErrorCode; property ErrorCode : integer read GetErrorCode;
property ErrorText : ustring read GetErrorText write SetErrorText; property ErrorText : ustring read GetErrorText write SetErrorText;
@ -91,10 +93,11 @@ type
implementation implementation
const const
CEF_WEBPAGE_LOADED_MSG = WM_APP + 1; CEF_WEBPAGE_LOADED_MSG = WM_APP + 1;
CEF_WEBPAGE_ERROR_MSG = WM_APP + 2; CEF_WEBPAGE_ERROR_MSG = WM_APP + 2;
CEF_CLOSE_BROWSER_MSG = WM_APP + 3; CEF_CLOSE_BROWSER_MSG = WM_APP + 3;
CEF_LOAD_PENDING_URL_MSG = WM_APP + 4; CEF_LOAD_PENDING_URL_MSG = WM_APP + 4;
CEF_UPDATEBROWSERSIZE_MSG = WM_APP + 5;
constructor TCEFBrowserThread.Create(const aDefaultURL : ustring; aWidth, aHeight, aDelayMs : integer; const aScreenScale : single); constructor TCEFBrowserThread.Create(const aDefaultURL : ustring; aWidth, aHeight, aDelayMs : integer; const aScreenScale : single);
begin begin
@ -317,6 +320,12 @@ begin
PostThreadMessage(ThreadID, CEF_CLOSE_BROWSER_MSG, 0, 0); PostThreadMessage(ThreadID, CEF_CLOSE_BROWSER_MSG, 0, 0);
end; end;
function TCEFBrowserThread.UpdateBrowserSize(aNewWidth, aNewHeight : integer): boolean;
begin
Result := Initialized and
PostThreadMessage(ThreadID, CEF_UPDATEBROWSERSIZE_MSG, WPARAM(aNewWidth), LPARAM(aNewHeight));
end;
procedure TCEFBrowserThread.Browser_OnAfterCreated(Sender: TObject; const browser: ICefBrowser); procedure TCEFBrowserThread.Browser_OnAfterCreated(Sender: TObject; const browser: ICefBrowser);
begin begin
if assigned(FBrowserInfoCS) then if assigned(FBrowserInfoCS) then
@ -343,7 +352,7 @@ begin
FResizeCS.Acquire; FResizeCS.Acquire;
TempForcedResize := False; TempForcedResize := False;
if FBrowserBitmap.BeginBufferDraw then if FBrowserBitmap.BeginDraw then
begin begin
if (kind = PET_POPUP) then if (kind = PET_POPUP) then
begin begin
@ -367,7 +376,7 @@ begin
end end
else else
begin begin
TempForcedResize := FBrowserBitmap.UpdateBufferDimensions(aWidth, aHeight) or not(FBrowserBitmap.BufferIsResized(False)); TempForcedResize := FBrowserBitmap.UpdateDimensions(aWidth, aHeight);
TempWidth := FBrowserBitmap.Width; TempWidth := FBrowserBitmap.Width;
TempHeight := FBrowserBitmap.Height; TempHeight := FBrowserBitmap.Height;
TempScanlineSize := FBrowserBitmap.ScanlineSize; TempScanlineSize := FBrowserBitmap.ScanlineSize;
@ -423,7 +432,7 @@ begin
end; end;
end; end;
FBrowserBitmap.EndBufferDraw; FBrowserBitmap.EndDraw;
if (kind = PET_VIEW) then if (kind = PET_VIEW) then
begin begin
@ -540,13 +549,10 @@ begin
if FResizing then if FResizing then
FPendingResize := True FPendingResize := True
else else
if FBrowserBitmap.BufferIsResized then begin
FBrowser.Invalidate(PET_VIEW) FResizing := True;
else FBrowser.WasResized;
begin end;
FResizing := True;
FBrowser.WasResized;
end;
finally finally
FResizeCS.Release; FResizeCS.Release;
end; end;
@ -612,6 +618,36 @@ begin
end; end;
end; end;
procedure TCEFBrowserThread.UpdateSize(aNewWidth, aNewHeight : integer);
begin
if assigned(FResizeCS) then
try
FResizeCS.Acquire;
if assigned(FBrowserBitmap) and
FBrowserBitmap.BeginDraw then
try
if (FBrowserBitmap.Width <> aNewWidth) or
(FBrowserBitmap.Height <> aNewHeight) then
begin
{$IFDEF DELPHI16_UP}
FBrowserBitmap.SetSize(aNewWidth, aNewHeight);
{$ELSE}
FBrowserBitmap.Width := aNewWidth;
FBrowserBitmap.Height := aNewHeight;
{$ENDIF}
FResizing := True;
FBrowser.WasResized;
end;
finally
FBrowserBitmap.EndDraw;
end;
finally
FResizeCS.Release;
end;
end;
procedure TCEFBrowserThread.DoOnError; procedure TCEFBrowserThread.DoOnError;
begin begin
FOnError(self); FOnError(self);
@ -645,12 +681,13 @@ begin
while TempCont and GetMessage(TempMsg, 0, 0, 0) and not(Terminated) do while TempCont and GetMessage(TempMsg, 0, 0, 0) and not(Terminated) do
begin begin
case TempMsg.Message of case TempMsg.Message of
CEF_PENDINGRESIZE : Resize; CEF_PENDINGRESIZE : Resize;
CEF_CLOSE_BROWSER_MSG : CloseBrowser; CEF_CLOSE_BROWSER_MSG : CloseBrowser;
CEF_LOAD_PENDING_URL_MSG : LoadPendingURL; CEF_LOAD_PENDING_URL_MSG : LoadPendingURL;
CEF_WEBPAGE_LOADED_MSG : WebpagePostProcessing; CEF_WEBPAGE_LOADED_MSG : WebpagePostProcessing;
CEF_WEBPAGE_ERROR_MSG : WebpageError; CEF_WEBPAGE_ERROR_MSG : WebpageError;
WM_QUIT : TempCont := False; CEF_UPDATEBROWSERSIZE_MSG : UpdateSize(integer(TempMsg.wParam), integer(TempMsg.lParam));
WM_QUIT : TempCont := False;
end; end;
DispatchMessage(TempMsg); DispatchMessage(TempMsg);

36
demos/Delphi_VCL/ConsoleBrowser2/uEncapsulatedBrowser.pas
View File

@ -22,17 +22,19 @@ type
FScale : single; FScale : single;
FSnapshotPath : ustring; FSnapshotPath : ustring;
FErrorText : ustring; FErrorText : ustring;
FFirst : boolean;
procedure Thread_OnError(Sender: TObject); procedure Thread_OnError(Sender: TObject);
procedure Thread_OnSnapshotAvailable(Sender: TObject); procedure Thread_OnSnapshotAvailable(Sender: TObject);
public public
constructor Create; constructor Create(aWidth, aHeight : integer);
destructor Destroy; override; destructor Destroy; override;
procedure LoadURL(const aURL : ustring); procedure LoadURL(const aURL : ustring);
function UpdateBrowserSize(aNewWidth, aNewHeight : integer): boolean;
property Width : integer read FWidth write FWidth; property Width : integer read FWidth;
property Height : integer read FHeight write FHeight; property Height : integer read FHeight;
property DelayMs : integer read FDelayMs write FDelayMs; property DelayMs : integer read FDelayMs write FDelayMs;
property Scale : single read FScale write FScale; property Scale : single read FScale write FScale;
property SnapshotPath : ustring read FSnapshotPath write FSnapshotPath; property SnapshotPath : ustring read FSnapshotPath write FSnapshotPath;
@ -77,7 +79,7 @@ begin
WriteLn('No URL has been specified. Using the default...'); WriteLn('No URL has been specified. Using the default...');
end; end;
EncapsulatedBrowser := TEncapsulatedBrowser.Create; EncapsulatedBrowser := TEncapsulatedBrowser.Create(1024, 768);
EncapsulatedBrowser.LoadURL(TempURL); EncapsulatedBrowser.LoadURL(TempURL);
end; end;
@ -125,13 +127,14 @@ begin
GlobalCEFApp.StartMainProcess; GlobalCEFApp.StartMainProcess;
end; end;
constructor TEncapsulatedBrowser.Create; constructor TEncapsulatedBrowser.Create(aWidth, aHeight : integer);
begin begin
inherited Create; inherited Create;
FFirst := True;
FThread := nil; FThread := nil;
FWidth := 1024; FWidth := aWidth;
FHeight := 768; FHeight := aHeight;
FDelayMs := 500; FDelayMs := 500;
FScale := 1; // This is the relative scale to a 96 DPI screen. It's calculated with the formula : scale = custom_DPI / 96 FScale := 1; // This is the relative scale to a 96 DPI screen. It's calculated with the formula : scale = custom_DPI / 96
FSnapshotPath := 'snapshot.bmp'; FSnapshotPath := 'snapshot.bmp';
@ -164,6 +167,14 @@ begin
FThread.LoadUrl(aURL); FThread.LoadUrl(aURL);
end; end;
function TEncapsulatedBrowser.UpdateBrowserSize(aNewWidth, aNewHeight : integer): boolean;
begin
FWidth := aNewWidth;
FHeight := aNewHeight;
Result := assigned(FThread) and
FThread.UpdateBrowserSize(aNewWidth, aNewHeight);
end;
procedure TEncapsulatedBrowser.Thread_OnError(Sender: TObject); procedure TEncapsulatedBrowser.Thread_OnError(Sender: TObject);
begin begin
// This code is executed in the TCEFBrowserThread thread context while the main application thread is waiting for MainAppEvent. // This code is executed in the TCEFBrowserThread thread context while the main application thread is waiting for MainAppEvent.
@ -186,6 +197,17 @@ procedure TEncapsulatedBrowser.Thread_OnSnapshotAvailable(Sender: TObject);
begin begin
// This code is executed in the TCEFBrowserThread thread context while the main application thread is waiting for MainAppEvent. // This code is executed in the TCEFBrowserThread thread context while the main application thread is waiting for MainAppEvent.
// Enable this block to test UpdateBrowserSize
{
if FFirst then
begin
FFirst := False;
if UpdateBrowserSize(800, 600) then
LoadURL('https://www.bing.com');
exit;
end;
}
if (FThread = nil) or not(FThread.SaveSnapshotToFile(FSnapshotPath)) then if (FThread = nil) or not(FThread.SaveSnapshotToFile(FSnapshotPath)) then
FErrorText := 'There was an error copying the snapshot'; FErrorText := 'There was an error copying the snapshot';

17
demos/Delphi_VCL/WebpageSnapshot/uCEFBrowserThread.pas
View File

@ -377,7 +377,7 @@ begin
FResizeCS.Acquire; FResizeCS.Acquire;
TempForcedResize := False; TempForcedResize := False;
if FBrowserBitmap.BeginBufferDraw then if FBrowserBitmap.BeginDraw then
begin begin
if (kind = PET_POPUP) then if (kind = PET_POPUP) then
begin begin
@ -401,7 +401,7 @@ begin
end end
else else
begin begin
TempForcedResize := FBrowserBitmap.UpdateBufferDimensions(aWidth, aHeight) or not(FBrowserBitmap.BufferIsResized(False)); TempForcedResize := FBrowserBitmap.UpdateDimensions(aWidth, aHeight);
TempWidth := FBrowserBitmap.Width; TempWidth := FBrowserBitmap.Width;
TempHeight := FBrowserBitmap.Height; TempHeight := FBrowserBitmap.Height;
TempScanlineSize := FBrowserBitmap.ScanlineSize; TempScanlineSize := FBrowserBitmap.ScanlineSize;
@ -457,7 +457,7 @@ begin
end; end;
end; end;
FBrowserBitmap.EndBufferDraw; FBrowserBitmap.EndDraw;
if (kind = PET_VIEW) then if (kind = PET_VIEW) then
begin begin
@ -587,13 +587,10 @@ begin
if FResizing then if FResizing then
FPendingResize := True FPendingResize := True
else else
if FBrowserBitmap.BufferIsResized then begin
FBrowser.Invalidate(PET_VIEW) FResizing := True;
else FBrowser.WasResized;
begin end;
FResizing := True;
FBrowser.WasResized;
end;
finally finally
FResizeCS.Release; FResizeCS.Release;
end; end;

17
demos/Delphi_VCL/WindowsServiceBrowser/uCEFBrowserThread.pas
View File

@ -343,7 +343,7 @@ begin
FResizeCS.Acquire; FResizeCS.Acquire;
TempForcedResize := False; TempForcedResize := False;
if FBrowserBitmap.BeginBufferDraw then if FBrowserBitmap.BeginDraw then
begin begin
if (kind = PET_POPUP) then if (kind = PET_POPUP) then
begin begin
@ -367,7 +367,7 @@ begin
end end
else else
begin begin
TempForcedResize := FBrowserBitmap.UpdateBufferDimensions(aWidth, aHeight) or not(FBrowserBitmap.BufferIsResized(False)); TempForcedResize := FBrowserBitmap.UpdateDimensions(aWidth, aHeight);
TempWidth := FBrowserBitmap.Width; TempWidth := FBrowserBitmap.Width;
TempHeight := FBrowserBitmap.Height; TempHeight := FBrowserBitmap.Height;
TempScanlineSize := FBrowserBitmap.ScanlineSize; TempScanlineSize := FBrowserBitmap.ScanlineSize;
@ -423,7 +423,7 @@ begin
end; end;
end; end;
FBrowserBitmap.EndBufferDraw; FBrowserBitmap.EndDraw;
if (kind = PET_VIEW) then if (kind = PET_VIEW) then
begin begin
@ -540,13 +540,10 @@ begin
if FResizing then if FResizing then
FPendingResize := True FPendingResize := True
else else
if FBrowserBitmap.BufferIsResized then begin
FBrowser.Invalidate(PET_VIEW) FResizing := True;
else FBrowser.WasResized;
begin end;
FResizing := True;
FBrowser.WasResized;
end;
finally finally
FResizeCS.Release; FResizeCS.Release;
end; end;

2
demos/Lazarus_Windows/WebpageSnapshot/uCEFBrowserThread.pas
View File

@ -542,7 +542,7 @@ begin
FPopUpRect.Bottom := rect.y + rect.height - 1; FPopUpRect.Bottom := rect.y + rect.height - 1;
end; end;
procedure TCEFBrowserThread.Browser_OnBeforePopup(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl, targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; const popupFeatures: TCefPopupFeatures; var windowInfo: TCefWindowInfo; var client: ICefClient; var settings: TCefBrowserSettings; var extra_info: ICefDictionaryValue; var noJavascriptAccess: Boolean; var Result: Boolean); procedure TCEFBrowserThread.Browser_OnBeforePopup(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; popup_id: Integer; const targetUrl, targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; const popupFeatures: TCefPopupFeatures; var windowInfo: TCefWindowInfo; var client: ICefClient; var settings: TCefBrowserSettings; var extra_info: ICefDictionaryValue; var noJavascriptAccess: Boolean; var Result: Boolean);
begin begin
// For simplicity, this demo blocks all popup windows and new tabs // For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [CEF_WOD_NEW_FOREGROUND_TAB, CEF_WOD_NEW_BACKGROUND_TAB, CEF_WOD_NEW_POPUP, CEF_WOD_NEW_WINDOW]); Result := (targetDisposition in [CEF_WOD_NEW_FOREGROUND_TAB, CEF_WOD_NEW_BACKGROUND_TAB, CEF_WOD_NEW_POPUP, CEF_WOD_NEW_WINDOW]);

44
source/uCEFBrowserBitmap.pas
View File

@ -36,10 +36,9 @@ type
public public
constructor Create; override; constructor Create; override;
destructor Destroy; override; destructor Destroy; override;
function BeginBufferDraw : boolean; function BeginDraw : boolean;
procedure EndBufferDraw; procedure EndDraw;
function UpdateBufferDimensions(aWidth, aHeight : integer) : boolean; function UpdateDimensions(aWidth, aHeight : integer) : boolean;
function BufferIsResized(aUseMutex : boolean = True) : boolean;
procedure BufferDraw(const aBitmap : TBitmap; const aSrcRect, aDstRect : TRect); procedure BufferDraw(const aBitmap : TBitmap; const aSrcRect, aDstRect : TRect);
property ScanlineSize : integer read FScanlineSize; property ScanlineSize : integer read FScanlineSize;
@ -98,7 +97,7 @@ begin
Result := nil; Result := nil;
end; end;
function TCEFBrowserBitmap.BeginBufferDraw : boolean; function TCEFBrowserBitmap.BeginDraw : boolean;
begin begin
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
Result := (FSyncObj <> 0) and (WaitForSingleObject(FSyncObj, 5000) = WAIT_OBJECT_0); Result := (FSyncObj <> 0) and (WaitForSingleObject(FSyncObj, 5000) = WAIT_OBJECT_0);
@ -113,7 +112,7 @@ begin
{$ENDIF} {$ENDIF}
end; end;
procedure TCEFBrowserBitmap.EndBufferDraw; procedure TCEFBrowserBitmap.EndDraw;
begin begin
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
if (FSyncObj <> 0) then ReleaseMutex(FSyncObj); if (FSyncObj <> 0) then ReleaseMutex(FSyncObj);
@ -122,7 +121,7 @@ begin
{$ENDIF} {$ENDIF}
end; end;
function TCEFBrowserBitmap.UpdateBufferDimensions(aWidth, aHeight : integer) : boolean; function TCEFBrowserBitmap.UpdateDimensions(aWidth, aHeight : integer) : boolean;
begin begin
Result := False; Result := False;
FScanlineSize := aWidth * SizeOf(TRGBQuad); FScanlineSize := aWidth * SizeOf(TRGBQuad);
@ -140,37 +139,6 @@ begin
end; end;
end; end;
function TCEFBrowserBitmap.BufferIsResized(aUseMutex : boolean) : boolean;
var
TempDevWidth, TempLogWidth, TempDevHeight, TempLogHeight : integer;
begin
Result := False;
if not(aUseMutex) or BeginBufferDraw then
begin
if (FDeviceScaleFactor = 1) then
Result := (Width = Width) and
(Height = Height)
else
begin
// CEF and Chromium use 'floor' to round the float values in Device <-> Logical unit conversions
// and Delphi uses MulDiv, which uses the bankers rounding, to resize the components in high DPI mode.
// This is the cause of slight differences in size between the buffer and the panel in some occasions.
TempLogWidth := DeviceToLogical(Width, FDeviceScaleFactor);
TempLogHeight := DeviceToLogical(Height, FDeviceScaleFactor);
TempDevWidth := LogicalToDevice(TempLogWidth, FDeviceScaleFactor);
TempDevHeight := LogicalToDevice(TempLogHeight, FDeviceScaleFactor);
Result := (Width = TempDevWidth) and
(Height = TempDevHeight);
end;
if aUseMutex then EndBufferDraw;
end;
end;
procedure TCEFBrowserBitmap.BufferDraw(const aBitmap : TBitmap; const aSrcRect, aDstRect : TRect); procedure TCEFBrowserBitmap.BufferDraw(const aBitmap : TBitmap; const aSrcRect, aDstRect : TRect);
begin begin
if (aBitmap <> nil) then if (aBitmap <> nil) then

2
update_CEF4Delphi.json
View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [ "UpdateLazPackages" : [
{ {
"ForceNotify" : true, "ForceNotify" : true,
"InternalVersion" : 679, "InternalVersion" : 680,
"Name" : "cef4delphi_lazarus.lpk", "Name" : "cef4delphi_lazarus.lpk",
"Version" : "131.2.7" "Version" : "131.2.7"
} }