// ************************************************************************ // ***************************** CEF4Delphi ******************************* // ************************************************************************ // // CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based // browser in Delphi applications. // // The original license of DCEF3 still applies to CEF4Delphi. // // For more information about CEF4Delphi visit : // https://www.briskbard.com/index.php?lang=en&pageid=cef // // Copyright © 2023 Salvador Diaz Fau. All rights reserved. // // ************************************************************************ // ************ vvvv Original license and comments below vvvv ************* // ************************************************************************ (* * Delphi Chromium Embedded 3 * * Usage allowed under the restrictions of the Lesser GNU General Public License * or alternatively the restrictions of the Mozilla Public License 1.1 * * Software distributed under the License is distributed on an "AS IS" basis, * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for * the specific language governing rights and limitations under the License. * * Unit owner : Henri Gourvest * Web site : http://www.progdigy.com * Repository : http://code.google.com/p/delphichromiumembedded/ * Group : http://groups.google.com/group/delphichromiumembedded * * Embarcadero Technologies, Inc is not permitted to use or redistribute * this source code without explicit permission. * *) unit uCEFBrowserBitmap; {$IFDEF FPC} {$MODE OBJFPC}{$H+} {$ENDIF} {$I cef.inc} interface uses {$IFDEF DELPHI16_UP} {$IFDEF MSWINDOWS}Winapi.Windows,{$ELSE}System.SyncObjs,{$ENDIF} System.Classes, System.SysUtils, Vcl.Graphics; {$ELSE} {$IFDEF MSWINDOWS}Windows,{$ENDIF} Classes, SysUtils, Graphics {$IFDEF FPC}, LCLProc, LCLType, LCLIntf, LResources, InterfaceBase{$ENDIF} {$IFNDEF MSWINDOWS}, SyncObjs{$ENDIF}; {$ENDIF} type TCEFBrowserBitmap = class(TBitmap) protected FScanlineSize : integer; FDeviceScaleFactor : single; {$IFDEF MSWINDOWS} FSyncObj : THandle; {$ELSE} FSyncObj : TCriticalSection; {$ENDIF} function GetBufferBits : pointer; procedure CreateSyncObj; procedure DestroySyncObj; public constructor Create; override; destructor Destroy; override; function BeginBufferDraw : boolean; procedure EndBufferDraw; function UpdateBufferDimensions(aWidth, aHeight : integer) : boolean; function BufferIsResized(aUseMutex : boolean = True) : boolean; procedure BufferDraw(const aBitmap : TBitmap; const aSrcRect, aDstRect : TRect); property ScanlineSize : integer read FScanlineSize; property BufferBits : pointer read GetBufferBits; property DeviceScaleFactor : single read FDeviceScaleFactor write FDeviceScaleFactor; end; implementation uses uCEFMiscFunctions; constructor TCEFBrowserBitmap.Create; begin inherited Create; FScanlineSize := 0; FDeviceScaleFactor := 1; CreateSyncObj; end; destructor TCEFBrowserBitmap.Destroy; begin DestroySyncObj; inherited Destroy; end; procedure TCEFBrowserBitmap.CreateSyncObj; begin {$IFDEF MSWINDOWS} FSyncObj := CreateMutex(nil, False, nil); {$ELSE} FSyncObj := TCriticalSection.Create; {$ENDIF} end; procedure TCEFBrowserBitmap.DestroySyncObj; begin {$IFDEF MSWINDOWS} if (FSyncObj <> 0) then begin CloseHandle(FSyncObj); FSyncObj := 0; end; {$ELSE} if (FSyncObj <> nil) then FreeAndNil(FSyncObj); {$ENDIF} end; function TCEFBrowserBitmap.GetBufferBits : pointer; begin if (Height <> 0) then Result := Scanline[pred(Height)] else Result := nil; end; function TCEFBrowserBitmap.BeginBufferDraw : boolean; begin {$IFDEF MSWINDOWS} Result := (FSyncObj <> 0) and (WaitForSingleObject(FSyncObj, 5000) = WAIT_OBJECT_0); {$ELSE} if (FSyncObj <> nil) then begin FSyncObj.Acquire; Result := True; end else Result := False; {$ENDIF} end; procedure TCEFBrowserBitmap.EndBufferDraw; begin {$IFDEF MSWINDOWS} if (FSyncObj <> 0) then ReleaseMutex(FSyncObj); {$ELSE} if (FSyncObj <> nil) then FSyncObj.Release; {$ENDIF} end; function TCEFBrowserBitmap.UpdateBufferDimensions(aWidth, aHeight : integer) : boolean; begin Result := False; FScanlineSize := aWidth * SizeOf(TRGBQuad); if (Width <> aWidth) or (Height <> aHeight) then begin {$IFDEF DELPHI16_UP} SetSize(aWidth, aHeight); {$ELSE} Width := aWidth; Height := aHeight; {$ENDIF} Result := True; 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); begin if (aBitmap <> nil) then begin Canvas.Lock; aBitmap.Canvas.Lock; Canvas.CopyRect(aDstRect, aBitmap.Canvas, aSrcRect); aBitmap.Canvas.UnLock; Canvas.UnLock; end; end; end.