pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2024-11-24 08:02:15 +02:00
Code Issues Actions Releases Activity

Added GlobalCEFApp.ForcedDeviceScaleFactor property.

Browse Source 
Added TBufferPanel.ForcedDeviceScaleFactor property.
Added TFMXBufferPanel.ForcedDeviceScaleFactor property.
Updated ConsoleBrowser2 and WebpageSnapshot demos to use the new TBufferPanel.ForcedDeviceScaleFactor property.
This commit is contained in:
Salvador Diaz Fau 2020-12-20 12:28:56 +01:00
parent 858f1a1625
commit 34c2c49034
12 changed files with 270 additions and 170 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -50,20 +50,10 @@ uses
uCEFChromium, uCEFTypes, uCEFInterfaces, uCEFConstants, uCEFBufferPanel, uCEFChromiumCore, uCEFMiscFunctions;
type
TVirtualBufferPanel = class(TBufferPanel)
protected
FCustomScale : single;
function GetScreenScale : single; override;
public
property CustomScale : single read FCustomScale write FCustomScale;
end;
TCEFBrowserThread = class(TThread)
protected
FBrowser : TChromium;
FPanel : TVirtualBufferPanel;
FPanel : TBufferPanel;
FPanelSize : TSize;
FScreenScale : single;
FPopUpBitmap : TBitmap;
@ -147,20 +137,6 @@ const
CEF_CLOSE_BROWSER_MSG = WM_APP + 3;
CEF_LOAD_PENDING_URL_MSG = WM_APP + 4;
// *************************************
// ******** TVirtualBufferPanel ********
// *************************************
function TVirtualBufferPanel.GetScreenScale : single;
begin
Result := FCustomScale;
end;
// *************************************
// ********* TCEFBrowserThread *********
// *************************************
constructor TCEFBrowserThread.Create(const aDefaultURL : ustring; aWidth, aHeight, aDelayMs : integer; const aScreenScale : single);
begin
inherited Create(True);
@ -215,14 +191,14 @@ procedure TCEFBrowserThread.AfterConstruction;
begin
inherited AfterConstruction;
FResizeCS := TCriticalSection.Create;
FBrowserInfoCS := TCriticalSection.Create;
FResizeCS := TCriticalSection.Create;
FBrowserInfoCS := TCriticalSection.Create;
FPanel := TVirtualBufferPanel.Create(nil);
FPanel.CustomScale := FScreenScale;
FPanel.Width := FPanelSize.cx;
FPanel.Height := FPanelSize.cy;
FPanel.OnResize := Panel_OnResize;
FPanel := TBufferPanel.Create(nil);
FPanel.ForcedDeviceScaleFactor := FScreenScale;
FPanel.Width := FPanelSize.cx;
FPanel.Height := FPanelSize.cy;
FPanel.OnResize := Panel_OnResize;
FBrowser := TChromium.Create(nil);
FBrowser.DefaultURL := FDefaultURL;

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

@ -66,7 +66,7 @@ type
public
constructor Create;
destructor Destroy; override;
procedure LoadURL(const aURL : string);
procedure LoadURL(const aURL : ustring);
property Width : integer read FWidth write FWidth;
property Height : integer read FHeight write FHeight;
@ -189,7 +189,7 @@ begin
inherited Destroy;
end;
procedure TEncapsulatedBrowser.LoadURL(const aURL : string);
procedure TEncapsulatedBrowser.LoadURL(const aURL : ustring);
begin
if (FThread = nil) then
begin

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

@ -50,20 +50,10 @@ uses
uCEFChromium, uCEFTypes, uCEFInterfaces, uCEFConstants, uCEFBufferPanel, uCEFChromiumCore, uCEFMiscFunctions;
type
TVirtualBufferPanel = class(TBufferPanel)
protected
FCustomScale : single;
function GetScreenScale : single; override;
public
property CustomScale : single read FCustomScale write FCustomScale;
end;
TCEFBrowserThread = class(TThread)
protected
FBrowser : TChromium;
FPanel : TVirtualBufferPanel;
FPanel : TBufferPanel;
FPanelSize : TSize;
FScreenScale : single;
FPopUpBitmap : TBitmap;
@ -147,21 +137,8 @@ const
CEF_CLOSE_BROWSER_MSG = WM_APP + 3;
CEF_LOAD_PENDING_URL_MSG = WM_APP + 4;
// *************************************
// ******** TVirtualBufferPanel ********
// *************************************
function TVirtualBufferPanel.GetScreenScale : single;
begin
Result := FCustomScale;
end;
// *************************************
// ********* TCEFBrowserThread *********
// *************************************
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
inherited Create(True);
@ -215,14 +192,14 @@ procedure TCEFBrowserThread.AfterConstruction;
begin
inherited AfterConstruction;
FResizeCS := TCriticalSection.Create;
FBrowserInfoCS := TCriticalSection.Create;
FResizeCS := TCriticalSection.Create;
FBrowserInfoCS := TCriticalSection.Create;
FPanel := TVirtualBufferPanel.Create(nil);
FPanel.CustomScale := FScreenScale;
FPanel.Width := FPanelSize.cx;
FPanel.Height := FPanelSize.cy;
FPanel.OnResize := Panel_OnResize;
FPanel := TBufferPanel.Create(nil);
FPanel.ForcedDeviceScaleFactor := FScreenScale;
FPanel.Width := FPanelSize.cx;
FPanel.Height := FPanelSize.cy;
FPanel.OnResize := Panel_OnResize;
FBrowser := TChromium.Create(nil);
FBrowser.DefaultURL := FDefaultURL;

5
demos/Delphi_VCL/WebpageSnapshot/uWebpageSnapshot.dfm
View File

@ -39,8 +39,6 @@ object WebpageSnapshotFrm: TWebpageSnapshotFrm
item
Width = 1000
end>
ExplicitTop = 467
ExplicitWidth = 711
end
object NavigationPnl: TPanel
Left = 0
@ -54,7 +52,6 @@ object WebpageSnapshotFrm: TWebpageSnapshotFrm
Padding.Right = 2
Padding.Bottom = 2
TabOrder = 1
ExplicitWidth = 711
object GoBtn: TButton
Left = 955
Top = 2
@ -64,7 +61,6 @@ object WebpageSnapshotFrm: TWebpageSnapshotFrm
Caption = 'Go'
TabOrder = 0
OnClick = GoBtnClick
ExplicitLeft = 634
end
object AddressEdt: TEdit
Left = 2
@ -74,7 +70,6 @@ object WebpageSnapshotFrm: TWebpageSnapshotFrm
Align = alClient
TabOrder = 1
Text = 'https://www.google.com'
ExplicitWidth = 632
end
end
end

109
demos/Lazarus_Windows/ConsoleBrowser2/ConsoleBrowser2.lps
View File

@ -4,11 +4,11 @@
<PathDelim Value="\"/>
<Version Value="11"/>
<BuildModes Active="Default"/>
<Units Count="5">
<Units Count="8">
<Unit0>
<Filename Value="ConsoleBrowser2.lpr"/>
<IsPartOfProject Value="True"/>
<TopLine Value="83"/>
<TopLine Value="82"/>
<CursorPos X="45" Y="84"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
@ -19,8 +19,8 @@
<IsPartOfProject Value="True"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="141"/>
<CursorPos X="3" Y="222"/>
<TopLine Value="199"/>
<CursorPos X="38" Y="214"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
@ -28,10 +28,11 @@
<Unit2>
<Filename Value="uCEFBrowserThread.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="86"/>
<CursorPos Y="98"/>
<EditorIndex Value="2"/>
<TopLine Value="106"/>
<CursorPos X="19" Y="121"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit2>
<Unit3>
@ -49,8 +50,100 @@
<CursorPos X="16" Y="80"/>
<UsageCount Value="10"/>
</Unit4>
<Unit5>
<Filename Value="..\..\..\source\uCEFBufferPanel.pas"/>
<EditorIndex Value="5"/>
<TopLine Value="56"/>
<CursorPos X="31" Y="78"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="..\..\..\source\uCEFApplicationCore.pas"/>
<EditorIndex Value="3"/>
<TopLine Value="1880"/>
<CursorPos Y="1897"/>
<UsageCount Value="10"/>
<Bookmarks Count="1">
<Item0 X="52" Y="1896" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="C:\lazarus\fpc\3.2.0\source\rtl\objpas\sysutils\sysinth.inc"/>
<EditorIndex Value="4"/>
<TopLine Value="28"/>
<CursorPos X="21" Y="37"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit7>
</Units>
<JumpHistory HistoryIndex="-1"/>
<JumpHistory Count="16" HistoryIndex="15">
<Position1>
<Filename Value="uCEFBrowserThread.pas"/>
<Caret Line="200" Column="10" TopLine="181"/>
</Position1>
<Position2>
<Filename Value="uCEFBrowserThread.pas"/>
<Caret Line="201" Column="36" TopLine="175"/>
</Position2>
<Position3>
<Filename Value="..\..\..\source\uCEFApplicationCore.pas"/>
<Caret Line="1892" Column="39" TopLine="1877"/>
</Position3>
<Position4>
<Filename Value="..\..\..\source\uCEFApplicationCore.pas"/>
<Caret Line="40" TopLine="22"/>
</Position4>
<Position5>
<Filename Value="..\..\..\source\uCEFApplicationCore.pas"/>
<Caret Line="54" TopLine="34"/>
</Position5>
<Position6>
<Filename Value="uEncapsulatedBrowser.pas"/>
<Caret Line="176" Column="22" TopLine="163"/>
</Position6>
<Position7>
<Filename Value="uEncapsulatedBrowser.pas"/>
<Caret Line="120" Column="38" TopLine="106"/>
</Position7>
<Position8>
<Filename Value="uEncapsulatedBrowser.pas"/>
<Caret Line="104" Column="20" TopLine="90"/>
</Position8>
<Position9>
<Filename Value="uEncapsulatedBrowser.pas"/>
<Caret Line="120" Column="26" TopLine="103"/>
</Position9>
<Position10>
<Filename Value="uEncapsulatedBrowser.pas"/>
<Caret Line="71" Column="41" TopLine="57"/>
</Position10>
<Position11>
<Filename Value="uEncapsulatedBrowser.pas"/>
<Caret Line="194" Column="54" TopLine="193"/>
</Position11>
<Position12>
<Filename Value="uCEFBrowserThread.pas"/>
<Caret Line="121" Column="19" TopLine="107"/>
</Position12>
<Position13>
<Filename Value="uEncapsulatedBrowser.pas"/>
<Caret Line="214" Column="38" TopLine="199"/>
</Position13>
<Position14>
<Filename Value="uEncapsulatedBrowser.pas"/>
<Caret Line="204" Column="15" TopLine="188"/>
</Position14>
<Position15>
<Filename Value="uCEFBrowserThread.pas"/>
<Caret Line="121" Column="19" TopLine="106"/>
</Position15>
<Position16>
<Filename Value="uEncapsulatedBrowser.pas"/>
<Caret Line="104" Column="20" TopLine="89"/>
</Position16>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="1" ActiveMode="default">

40
demos/Lazarus_Windows/ConsoleBrowser2/uCEFBrowserThread.pas
View File

@ -52,20 +52,10 @@ uses
uCEFChromium, uCEFTypes, uCEFInterfaces, uCEFConstants, uCEFBufferPanel, uCEFChromiumCore, uCEFMiscFunctions;
type
TVirtualBufferPanel = class(TBufferPanel)
protected
FCustomScale : single;
function GetScreenScale : single; override;
public
property CustomScale : single read FCustomScale write FCustomScale;
end;
TCEFBrowserThread = class(TThread)
protected
FBrowser : TChromium;
FPanel : TVirtualBufferPanel;
FPanel : TBufferPanel;
FPanelSize : TSize;
FScreenScale : single;
FPopUpBitmap : TBitmap;
@ -149,20 +139,6 @@ const
CEF_CLOSE_BROWSER_MSG = WM_APP + 3;
CEF_LOAD_PENDING_URL_MSG = WM_APP + 4;
// *************************************
// ******** TVirtualBufferPanel ********
// *************************************
function TVirtualBufferPanel.GetScreenScale : single;
begin
Result := FCustomScale;
end;
// *************************************
// ********* TCEFBrowserThread *********
// *************************************
constructor TCEFBrowserThread.Create(const aDefaultURL : ustring; aWidth, aHeight, aDelayMs : integer; const aScreenScale : single);
begin
inherited Create(True);
@ -217,14 +193,14 @@ procedure TCEFBrowserThread.AfterConstruction;
begin
inherited AfterConstruction;
FResizeCS := TCriticalSection.Create;
FBrowserInfoCS := TCriticalSection.Create;
FResizeCS := TCriticalSection.Create;
FBrowserInfoCS := TCriticalSection.Create;
FPanel := TVirtualBufferPanel.Create(nil);
FPanel.CustomScale := FScreenScale;
FPanel.Width := FPanelSize.cx;
FPanel.Height := FPanelSize.cy;
FPanel.OnResize := Panel_OnResize;
FPanel := TBufferPanel.Create(nil);
FPanel.ForcedDeviceScaleFactor := FScreenScale;
FPanel.Width := FPanelSize.cx;
FPanel.Height := FPanelSize.cy;
FPanel.OnResize := Panel_OnResize;
FBrowser := TChromium.Create(nil);
FBrowser.DefaultURL := FDefaultURL;

4
demos/Lazarus_Windows/ConsoleBrowser2/uEncapsulatedBrowser.pas
View File

@ -68,7 +68,7 @@ type
public
constructor Create;
destructor Destroy; override;
procedure LoadURL(const aURL : string);
procedure LoadURL(const aURL : ustring);
property Width : integer read FWidth write FWidth;
property Height : integer read FHeight write FHeight;
@ -191,7 +191,7 @@ begin
inherited Destroy;
end;
procedure TEncapsulatedBrowser.LoadURL(const aURL : string);
procedure TEncapsulatedBrowser.LoadURL(const aURL : ustring);
begin
if (FThread = nil) then
begin

22
demos/Lazarus_Windows/WebpageSnapshot/WebpageSnapshot.lps
View File

@ -19,8 +19,8 @@
<IsPartOfProject Value="True"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="2"/>
<TopLine Value="471"/>
<CursorPos X="66" Y="483"/>
<TopLine Value="447"/>
<CursorPos X="69" Y="487"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
@ -32,8 +32,8 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="1"/>
<TopLine Value="98"/>
<CursorPos X="71" Y="163"/>
<TopLine Value="20"/>
<CursorPos X="75" Y="152"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
@ -77,7 +77,7 @@
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit7>
</Units>
<JumpHistory Count="15" HistoryIndex="14">
<JumpHistory Count="18" HistoryIndex="17">
<Position1>
<Filename Value="uCEFBrowserThread.pas"/>
<Caret Line="348" TopLine="334"/>
@ -138,6 +138,18 @@
<Filename Value="uCEFBrowserThread.pas"/>
<Caret Line="416" Column="50" TopLine="403"/>
</Position15>
<Position16>
<Filename Value="uWebpageSnapshot.pas"/>
<Caret Line="121" Column="65" TopLine="110"/>
</Position16>
<Position17>
<Filename Value="uWebpageSnapshot.pas"/>
<Caret Line="117" Column="78" TopLine="102"/>
</Position17>
<Position18>
<Filename Value="uWebpageSnapshot.pas"/>
<Caret Line="147" Column="126" TopLine="132"/>
</Position18>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>

26
source/uCEFApplicationCore.pas
View File

@ -153,7 +153,6 @@ type
{$ENDIF}
FOnRegisterCustomSchemes : TOnRegisterCustomSchemesEvent;
FAppSettings : TCefSettings;
FDeviceScaleFactor : single;
FCheckDevToolsResources : boolean;
FDisableExtensions : boolean;
FDisableGPUCache : boolean;
@ -170,6 +169,8 @@ type
FSupportedSchemes : TStringList;
FDisableNewBrowserInfoTimeout : boolean;
FDevToolsProtocolLogFile : ustring;
FDeviceScaleFactor : single;
FForcedDeviceScaleFactor : single;
FPluginPolicy : TCefPluginPolicySwitch;
FDefaultEncoding : string;
@ -448,6 +449,7 @@ type
property HyperlinkAuditing : boolean read FHyperlinkAuditing write FHyperlinkAuditing; // --no-pings
property DisableNewBrowserInfoTimeout : boolean read FDisableNewBrowserInfoTimeout write FDisableNewBrowserInfoTimeout; // --disable-new-browser-info-timeout
property DevToolsProtocolLogFile : ustring read FDevToolsProtocolLogFile write FDevToolsProtocolLogFile; // --devtools-protocol-log-file
property ForcedDeviceScaleFactor : single read FForcedDeviceScaleFactor write FForcedDeviceScaleFactor; // --device-scale-factor
// Properties used during the CEF initialization
property WindowsSandboxInfo : Pointer read FWindowsSandboxInfo write FWindowsSandboxInfo;
@ -686,6 +688,7 @@ begin
FSupportedSchemes := nil;
FDisableNewBrowserInfoTimeout := False;
FDevToolsProtocolLogFile := '';
FForcedDeviceScaleFactor := 0;
FDisableJavascriptCloseWindows := False;
FDisableJavascriptAccessClipboard := False;
@ -1122,7 +1125,10 @@ end;
procedure TCefApplicationCore.UpdateDeviceScaleFactor;
begin
FDeviceScaleFactor := GetDeviceScaleFactor;
if (FForcedDeviceScaleFactor <> 0) then
FDeviceScaleFactor := FForcedDeviceScaleFactor
else
FDeviceScaleFactor := GetDeviceScaleFactor;
end;
procedure TCefApplicationCore.ShutDown;
@ -1711,6 +1717,7 @@ end;
procedure TCefApplicationCore.AddCustomCommandLineSwitches(var aKeys, aValues : TStringList);
var
i : integer;
TempFormatSettings : TFormatSettings;
{$IFDEF MSWINDOWS}
TempVersionInfo : TFileVersionInfo;
TempFileName : ustring;
@ -1880,6 +1887,21 @@ begin
if (length(FOverrideSpellCheckLang) > 0) then
ReplaceSwitch(aKeys, aValues, '--override-spell-check-lang', FOverrideSpellCheckLang);
if (FForcedDeviceScaleFactor <> 0) then
begin
{$IFDEF FPC}
TempFormatSettings.DecimalSeparator := '.';
{$ELSE}
{$IFDEF DELPHI26_UP}
TempFormatSettings := TFormatSettings.Create('en-US');
{$ELSE}
GetLocaleFormatSettings(GetThreadLocale, TempFormatSettings);
TempFormatSettings.DecimalSeparator := '.';
{$ENDIF}
{$ENDIF}
ReplaceSwitch(aKeys, aValues, '--force-device-scale-factor', FloatToStr(FForcedDeviceScaleFactor, TempFormatSettings));
end;
// The list of features you can enable is here :
// https://chromium.googlesource.com/chromium/src/+/master/chrome/common/chrome_features.cc
if (length(FEnableFeatures) > 0) then

84
source/uCEFBufferPanel.pas
View File

@ -70,20 +70,21 @@ type
{$IFNDEF FPC}{$IFDEF DELPHI16_UP}[ComponentPlatformsAttribute(pidWin32 or pidWin64)]{$ENDIF}{$ENDIF}
TBufferPanel = class(TCustomPanel)
protected
FMutex : THandle;
FBuffer : TBitmap;
FScanlineSize : integer;
FTransparent : boolean;
FOnPaintParentBkg : TNotifyEvent;
FMutex : THandle;
FBuffer : TBitmap;
FScanlineSize : integer;
FTransparent : boolean;
FOnPaintParentBkg : TNotifyEvent;
FForcedDeviceScaleFactor : single;
{$IFDEF MSWINDOWS}
FIMEHandler : TCEFOSRIMEHandler;
FOnIMECancelComposition : TNotifyEvent;
FOnIMECommitText : TOnIMECommitTextEvent;
FOnIMESetComposition : TOnIMESetCompositionEvent;
FOnCustomTouch : TOnHandledMessageEvent;
FOnPointerDown : TOnHandledMessageEvent;
FOnPointerUp : TOnHandledMessageEvent;
FOnPointerUpdate : TOnHandledMessageEvent;
FIMEHandler : TCEFOSRIMEHandler;
FOnIMECancelComposition : TNotifyEvent;
FOnIMECommitText : TOnIMECommitTextEvent;
FOnIMESetComposition : TOnIMESetCompositionEvent;
FOnCustomTouch : TOnHandledMessageEvent;
FOnPointerDown : TOnHandledMessageEvent;
FOnPointerUp : TOnHandledMessageEvent;
FOnPointerUpdate : TOnHandledMessageEvent;
{$ENDIF}
procedure CreateSyncObj;
@ -95,6 +96,7 @@ type
function GetBufferWidth : integer;
function GetBufferHeight : integer;
function GetScreenScale : single; virtual;
function GetRealScreenScale(var aResultScale : single) : boolean; virtual;
{$IFDEF MSWINDOWS}
function GetParentFormHandle : TCefWindowHandle;
function GetParentForm : TCustomForm;
@ -135,15 +137,16 @@ type
procedure CreateIMEHandler;
procedure ChangeCompositionRange(const selection_range : TCefRange; const character_bounds : TCefRectDynArray);
property Buffer : TBitmap read FBuffer;
property ScanlineSize : integer read FScanlineSize;
property BufferWidth : integer read GetBufferWidth;
property BufferHeight : integer read GetBufferHeight;
property BufferBits : pointer read GetBufferBits;
property ScreenScale : single read GetScreenScale;
property Buffer : TBitmap read FBuffer;
property ScanlineSize : integer read FScanlineSize;
property BufferWidth : integer read GetBufferWidth;
property BufferHeight : integer read GetBufferHeight;
property BufferBits : pointer read GetBufferBits;
property ScreenScale : single read GetScreenScale;
property ForcedDeviceScaleFactor : single read FForcedDeviceScaleFactor write FForcedDeviceScaleFactor;
{$IFDEF MSWINDOWS}
property ParentFormHandle : TCefWindowHandle read GetParentFormHandle;
property ParentForm : TCustomForm read GetParentForm;
property ParentFormHandle : TCefWindowHandle read GetParentFormHandle;
property ParentForm : TCustomForm read GetParentForm;
{$ENDIF}
property DockManager;
@ -271,6 +274,11 @@ begin
FTransparent := False;
FOnPaintParentBkg := nil;
if (GlobalCEFApp <> nil) and (GlobalCEFApp.ForcedDeviceScaleFactor <> 0) then
FForcedDeviceScaleFactor := GlobalCEFApp.ForcedDeviceScaleFactor
else
FForcedDeviceScaleFactor := 0;
{$IFDEF MSWINDOWS}
FIMEHandler := nil;
FOnIMECancelComposition := nil;
@ -662,7 +670,7 @@ begin
Result := 0;
end;
function TBufferPanel.GetScreenScale : single;
function TBufferPanel.GetRealScreenScale(var aResultScale : single) : boolean;
{$IFDEF MSWINDOWS}
var
TempHandle : TCefWindowHandle;
@ -670,26 +678,42 @@ var
TempDPI : UINT;
{$ENDIF}
begin
Result := False;
aResultScale := 1;
{$IFDEF MSWINDOWS}
TempHandle := ParentFormHandle;
if (TempHandle <> 0) then
begin
Result := True;
if RunningWindows10OrNewer and GetDPIForHandle(TempHandle, TempDPI) then
Result := TempDPI / USER_DEFAULT_SCREEN_DPI
aResultScale := TempDPI / USER_DEFAULT_SCREEN_DPI
else
begin
TempDC := GetWindowDC(TempHandle);
Result := GetDeviceCaps(TempDC, LOGPIXELSX) / USER_DEFAULT_SCREEN_DPI;
TempDC := GetWindowDC(TempHandle);
aResultScale := GetDeviceCaps(TempDC, LOGPIXELSX) / USER_DEFAULT_SCREEN_DPI;
ReleaseDC(TempHandle, TempDC);
end;
end
else
end;
{$ENDIF}
if (GlobalCEFApp <> nil) then
Result := GlobalCEFApp.DeviceScaleFactor
end;
function TBufferPanel.GetScreenScale : single;
var
TempScale : single;
begin
if (FForcedDeviceScaleFactor <> 0) then
Result := FForcedDeviceScaleFactor
else
if GetRealScreenScale(TempScale) then
Result := TempScale
else
Result := 1;
if (GlobalCEFApp <> nil) then
Result := GlobalCEFApp.DeviceScaleFactor
else
Result := 1;
end;
{$IFDEF MSWINDOWS}

63
source/uCEFFMXBufferPanel.pas
View File

@ -61,26 +61,28 @@ type
TFMXBufferPanel = class(TControl)
protected
{$IFDEF MSWINDOWS}
FMutex : THandle;
FMutex : THandle;
{$ELSE}
FBufferCS : TCriticalSection;
FBufferCS : TCriticalSection;
{$ENDIF}
FBuffer : TBitmap;
FScanlineSize : integer;
FColor : TAlphaColor;
FHighSpeedDrawing : boolean;
FOnDialogKey : TDialogKeyEvent;
FBuffer : TBitmap;
FScanlineSize : integer;
FColor : TAlphaColor;
FHighSpeedDrawing : boolean;
FOnDialogKey : TDialogKeyEvent;
FForcedDeviceScaleFactor : single;
procedure CreateSyncObj;
procedure DestroySyncObj;
procedure DestroyBuffer;
function GetScreenScale : Single;
function GetScreenScale : single; virtual;
function GetBufferWidth : integer;
function GetBufferHeight : integer;
function GetParentForm : TCustomForm;
function GetParentFormHandle : TCefWindowHandle;
function GetRealScreenScale(var aResultScale : single) : boolean; virtual;
function CopyBuffer : boolean;
function SaveBufferToFile(const aFilename : string) : boolean;
@ -104,11 +106,12 @@ type
function ClientToScreen(aPoint : TPoint) : TPoint; overload;
function ClientToScreen(aPoint : TPointF) : TPointF; overload;
property Buffer : TBitmap read FBuffer;
property ScanlineSize : integer read FScanlineSize;
property BufferWidth : integer read GetBufferWidth;
property BufferHeight : integer read GetBufferHeight;
property ScreenScale : single read GetScreenScale;
property Buffer : TBitmap read FBuffer;
property ScanlineSize : integer read FScanlineSize;
property BufferWidth : integer read GetBufferWidth;
property BufferHeight : integer read GetBufferHeight;
property ScreenScale : single read GetScreenScale;
property ForcedDeviceScaleFactor : single read FForcedDeviceScaleFactor write FForcedDeviceScaleFactor;
published
property Align;
@ -175,6 +178,11 @@ begin
FColor := claWhite;
FOnDialogKey := nil;
FHighSpeedDrawing := True;
if (GlobalCEFApp <> nil) and (GlobalCEFApp.ForcedDeviceScaleFactor <> 0) then
FForcedDeviceScaleFactor := GlobalCEFApp.ForcedDeviceScaleFactor
else
FForcedDeviceScaleFactor := 0;
end;
destructor TFMXBufferPanel.Destroy;
@ -376,23 +384,40 @@ begin
{$ENDIF}
end;
function TFMXBufferPanel.GetScreenScale : Single;
function TFMXBufferPanel.GetRealScreenScale(var aResultScale : single) : boolean;
{$IFDEF DELPHI24_UP}
var
TempHandle : TCefWindowHandle;
{$ENDIF}
begin
Result := False;
aResultScale := 1;
{$IFDEF DELPHI24_UP}
TempHandle := GetParentFormHandle;
if (TempHandle <> 0) then
Result := GetWndScale(TempHandle)
else
begin
Result := True;
aResultScale := GetWndScale(TempHandle);
end;
{$ENDIF}
if (GlobalCEFApp <> nil) then
Result := GlobalCEFApp.DeviceScaleFactor
end;
function TFMXBufferPanel.GetScreenScale : single;
var
TempScale : single;
begin
if (FForcedDeviceScaleFactor <> 0) then
Result := FForcedDeviceScaleFactor
else
if GetRealScreenScale(TempScale) then
Result := TempScale
else
Result := 1;
if (GlobalCEFApp <> nil) then
Result := GlobalCEFApp.DeviceScaleFactor
else
Result := 1;
end;
function TFMXBufferPanel.GetBufferWidth : integer;

2
update_CEF4Delphi.json
View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 210,
"InternalVersion" : 211,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "87.1.12.0"
}