1
0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-03-27 20:20:31 +02:00

Added ConsoleBrowser2 and WebpageSnapshot demos

- Split the Lazarus demos directory into "Lazarus_Windows" and "Lazarus_Linux".
- Added OSRExternalPumpBrowser and TinyBrowser2 demos to "Lazarus_Linux".
- Set TBufferPanel.GetScreenScale as virtual.
- Added DevTools to the SchemeRegistrationBrowser demo.
- Modified the SchemeRegistrationBrowser demo to receive XMLHttpRequest requests from JavaScript.
This commit is contained in:
Salvador Diaz Fau 2020-12-13 18:36:10 +01:00
parent 8f55182540
commit 1299a6f596
390 changed files with 12796 additions and 370 deletions

View File

@ -13,9 +13,8 @@ Local SWF file.<br>
You need to install the Adobe Flash PPAPI plugin to view the SWF file.</p>
<p><button onclick="myAlertFunction()">Click me</button>
</p>
<p><button onclick="myAlertFunction()">Show Alert box</button></p>
<p><button onclick="sendCustomReq()">Send request</button></p>
<p><img src='jupiter.png'><br>Bigger image</p>
</body>

View File

@ -1,5 +1,15 @@
function myAlertFunction() {
alert('This alert dialog is declared in a local JS file.');
}
function sendCustomReq() {
var xhr = new XMLHttpRequest();
var url = 'hello://localhost/customrequest?name1=value1';
xhr.open('GET', url, true);
xhr.onreadystatechange = function() {
if(xhr.readyState == 4 && xhr.status == 200) {
alert(xhr.responseText);
}
}
xhr.send();
}

View File

@ -42,6 +42,7 @@ object WebBrowserFrm: TWebBrowserFrm
end
object chrmosr: TChromium
OnTooltip = chrmosrTooltip
OnCursorChange = chrmosrCursorChange
OnBeforePopup = chrmosrBeforePopup
OnAfterCreated = chrmosrAfterCreated
OnBeforeClose = chrmosrBeforeClose
@ -51,7 +52,6 @@ object WebBrowserFrm: TWebBrowserFrm
OnPopupShow = chrmosrPopupShow
OnPopupSize = chrmosrPopupSize
OnPaint = chrmosrPaint
OnCursorChange = chrmosrCursorChange
Left = 24
Top = 56
end

View File

@ -0,0 +1,18 @@
del /s /q *.dcu
del /s /q *.exe
del /s /q *.res
del /s /q *.rsm
del /s /q *.log
del /s /q *.dsk
del /s /q *.identcache
del /s /q *.stat
del /s /q *.local
del /s /q *.~*
rmdir Win32\Debug
rmdir Win32\Release
rmdir Win32
rmdir Win64\Debug
rmdir Win64\Release
rmdir Win64
rmdir __history
rmdir __recovery

View File

@ -0,0 +1,114 @@
// ************************************************************************
// ***************************** 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 © 2020 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 <hgourvest@gmail.com>
* 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.
*
*)
program ConsoleBrowser2;
{$I cef.inc}
{$APPTYPE CONSOLE}
{$R *.res}
uses
{$IFDEF DELPHI16_UP}
System.SysUtils,
{$ELSE}
SysUtils,
{$ENDIF}
uCEFApplication,
uEncapsulatedBrowser in 'uEncapsulatedBrowser.pas',
uCEFBrowserThread in 'uCEFBrowserThread.pas';
{$IFDEF WIN32}
// CEF3 needs to set the LARGEADDRESSAWARE ($20) flag which allows 32-bit processes to use up to 3GB of RAM.
{$SetPEFlags $20}
{$ENDIF}
// This demo navigates to a webpage, captures the browser screen and saves it as a bitmap file called "snapshot.bmp"
// ConsoleBrowser2 is a console application without a user interface. For this reason the browser is in
// "off-screen mode" (OSR mode), it's encamsulated in a custom thread and it uses a different EXE for the
// CEF subprocesses (ConsoleBrowser2_sp.exe).
// While the custom browser thread is loading the webpage and capturing the screen, the console application is
// waiting for an Event.
// ConsoleBrowser2 reads the "/url" parameter and uses that URL to navigate and capture the screen.
// For example : ConsoleBrowser2.exe /url=https://www.briskbard.com
// If you need to debug this demo in Delphi using http://www.example.com click on the "Run->Parameters" menu option,
// select the right target (Windows 32 bits / Windows 64 bits) and type "/url=http://www.example.com" (without quotes)
// in the "Parameters" box.
// By default the browser uses a virtual screen size of 1024x728 with 96 DPI (screen scale = 1)
// If you need a different resolution or scale just edit those values in TEncapsulatedBrowser.Create
// or add new command line switches with the new information.
// The browser captures the screen when the main frame is loaded but some web pages need some extra time to finish.
// This demo uses a 500 ms delay to avoid this problem and you can modify this value in TEncapsulatedBrowser.Create
// CEF is configured in this demo to use "in memory" cache. As a result of this, the browser will always download
// all the web page resources. Remember that if you switch to a local directory for the cache you will have problems
// when you run several instances of this demo at the same time because Chromium doesn't allow sharing the same cache
// by different processes.
// This demo is configured to load the CEF binaries in the same directory were ConsoleBrowser2.exe is located but you
// can set a different directory for the binaries by setting the GlobalCEFApp.FrameworkDirPath,
// GlobalCEFApp.ResourcesDirPath and GlobalCEFApp.LocalesDirPath properties inside CreateGlobalCEFApp.
// See the SimpleBrowser2 demo for more details.
// CEF is configured to use ConsoleBrowser2_sp.exe for the subprocesses and it tries to find it in the same directory as
// ConsoleBrowser2.exe but it's possible to use a different location for that EXE if you set a custom path in
// GlobalCEFApp.BrowserSubprocessPath.
// Most of the GlobalCEFApp properties must be the same in the main EXE and the EXE for the subprocesses. If you modify
// them in CreateGlobalCEFApp then you'll also have to copy those property values in ConsoleBrowser2_sp.dpr
// See the "SubProcess" demo for more details.
begin
try
try
CreateGlobalCEFApp;
if WaitForMainAppEvent then
WriteResult;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
finally
DestroyGlobalCEFApp;
end;
end.

View File

@ -0,0 +1,920 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{AA8E526F-FBD1-4D31-B463-A4CE79C00B18}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>ConsoleBrowser2.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>3</TargetedPlatforms>
<AppType>Console</AppType>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>..\..\..\bin</DCC_ExeOutput>
<DCC_E>false</DCC_E>
<DCC_N>false</DCC_N>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
<SanitizedProjectName>ConsoleBrowser2</SanitizedProjectName>
<VerInfo_Locale>3082</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;bindcompvclsmp;emsclientfiredac;tethering;svnui;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;VisualStyles_runtime;vcltouch;vcldb;bindcompfmx;svn;DBXOracleDriver;inetdb;fmx;FireDACIBDriver;fmxdae;vcledge;FireDACDBXDriver;dbexpress;vclx;dsnap;emsclient;DataSnapCommon;FireDACCommon;IndySystem260;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;CEF4Delphi_FMX;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;IndyProtocols260;bindcompdbx;vcl;DBXSybaseASEDriver;IndyCore260;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;Componentes_UI;FireDAC;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;SVGPackage;soaprtl;DbxCommonDriver;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_ConsoleTarget>true</DCC_ConsoleTarget>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;bindcompvclsmp;emsclientfiredac;tethering;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;VisualStyles_runtime;vcltouch;vcldb;bindcompfmx;DBXOracleDriver;inetdb;fmx;FireDACIBDriver;fmxdae;vcledge;FireDACDBXDriver;dbexpress;vclx;dsnap;emsclient;DataSnapCommon;FireDACCommon;IndySystem260;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;CEF4Delphi_FMX;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;IndyProtocols260;bindcompdbx;vcl;DBXSybaseASEDriver;IndyCore260;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;Componentes_UI;FireDAC;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;SVGPackage;soaprtl;DbxCommonDriver;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_ConsoleTarget>true</DCC_ConsoleTarget>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_DebugDCUs>true</DCC_DebugDCUs>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>(None)</Manifest_File>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="uEncapsulatedBrowser.pas"/>
<DCCReference Include="uCEFBrowserThread.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>Application</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">ConsoleBrowser2.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\DataExplorerFireDACPlugin270.bpl">FireDAC Data Explorer Integration</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclIPIndyImpl270.bpl">IP Abstraction Indy Implementation Design Time</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k270.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp270.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="OSX32">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libpcre.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\Debug\ConsoleBrowser2.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>ConsoleBrowser2.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClassesDexFile">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidFileProvider">
<Platform Name="Android">
<RemoteDir>res\xml</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\xml</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidGDBServer">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiFile">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiv7aFile">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeMipsFile">
<Platform Name="Android">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidServiceOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\arm64-v8a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidServiceOutput_Android32">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashImageDef">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStyles">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStylesV21">
<Platform Name="Android">
<RemoteDir>res\values-v21</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values-v21</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Colors">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_DefaultAppIcon">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon144">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon24">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage426">
<Platform Name="Android">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage470">
<Platform Name="Android">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage640">
<Platform Name="Android">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage960">
<Platform Name="Android">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Strings">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyFramework">
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyModule">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="DependencyPackage">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Name="File">
<Platform Name="Android">
<Operation>0</Operation>
</Platform>
<Platform Name="Android64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>0</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iOS_AppStore1024">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon152">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon167">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_SpotLight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon180">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification60">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting87">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectAndroidManifest">
<Platform Name="Android">
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSEntitlements">
<Platform Name="iOSDevice32">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSInfoPList">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSLaunchScreen">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen</RemoteDir>
<Operation>64</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen</RemoteDir>
<Operation>64</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSResource">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXDebug">
<Platform Name="OSX64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXEntitlements">
<Platform Name="OSX32">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXInfoPList">
<Platform Name="OSX32">
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\arm64-v8a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="Linux64">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOutput_Android32">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectUWPManifest">
<Platform Name="Win32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo150">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
</Deployment>
<Platforms>
<Platform value="Win32">True</Platform>
<Platform value="Win64">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
</Project>

View File

@ -0,0 +1,48 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{B3B59DC2-AFE8-41F8-81CF-6F7882A9E196}</ProjectGuid>
</PropertyGroup>
<ItemGroup>
<Projects Include="ConsoleBrowser2.dproj">
<Dependencies/>
</Projects>
<Projects Include="ConsoleBrowser2_sp.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Default.Personality/>
</BorlandProject>
</ProjectExtensions>
<Target Name="ConsoleBrowser2">
<MSBuild Projects="ConsoleBrowser2.dproj"/>
</Target>
<Target Name="ConsoleBrowser2:Clean">
<MSBuild Projects="ConsoleBrowser2.dproj" Targets="Clean"/>
</Target>
<Target Name="ConsoleBrowser2:Make">
<MSBuild Projects="ConsoleBrowser2.dproj" Targets="Make"/>
</Target>
<Target Name="ConsoleBrowser2_sp">
<MSBuild Projects="ConsoleBrowser2_sp.dproj"/>
</Target>
<Target Name="ConsoleBrowser2_sp:Clean">
<MSBuild Projects="ConsoleBrowser2_sp.dproj" Targets="Clean"/>
</Target>
<Target Name="ConsoleBrowser2_sp:Make">
<MSBuild Projects="ConsoleBrowser2_sp.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="ConsoleBrowser2;ConsoleBrowser2_sp"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="ConsoleBrowser2:Clean;ConsoleBrowser2_sp:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="ConsoleBrowser2:Make;ConsoleBrowser2_sp:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

View File

@ -0,0 +1,59 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 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 © 2018 Salvador Díaz 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 <hgourvest@gmail.com>
* 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.
*
*)
program ConsoleBrowser2_sp;
{$I cef.inc}
uses
uCEFApplicationCore;
{$IFDEF WIN32}
// CEF3 needs to set the LARGEADDRESSAWARE ($20) flag which allows 32-bit processes to use up to 3GB of RAM.
{$SetPEFlags $20}
{$ENDIF}
begin
GlobalCEFApp := TCefApplicationCore.Create;
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
GlobalCEFApp.ShowMessageDlg := False;
GlobalCEFApp.BlinkSettings := 'hideScrollbars';
GlobalCEFApp.StartSubProcess;
DestroyGlobalCEFApp;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,692 @@
// ************************************************************************
// ***************************** 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 © 2020 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 <hgourvest@gmail.com>
* 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 uCEFBrowserThread;
{$I cef.inc}
interface
uses
{$IFDEF DELPHI16_UP}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, System.SyncObjs, System.Math,
{$ELSE}
Windows, Messages, SysUtils, Classes, Graphics, SyncObjs, Math,
{$ENDIF}
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;
FPanelSize : TSize;
FScreenScale : single;
FPopUpBitmap : TBitmap;
FPopUpRect : TRect;
FResizeCS : TCriticalSection;
FBrowserInfoCS : TCriticalSection;
FShowPopUp : boolean;
FClosing : boolean;
FResizing : boolean;
FPendingResize : boolean;
FInitialized : boolean;
FDefaultURL : ustring;
FSnapshot : TBitmap;
FDelayMs : integer;
FOnSnapshotAvailable : TNotifyEvent;
FOnError : TNotifyEvent;
FErrorCode : integer;
FErrorText : ustring;
FFailedUrl : ustring;
FPendingUrl : ustring;
function GetErrorCode : integer;
function GetErrorText : ustring;
function GetFailedUrl : ustring;
function GetInitialized : boolean;
procedure Panel_OnResize(Sender: TObject);
procedure Browser_OnAfterCreated(Sender: TObject; const browser: ICefBrowser);
procedure Browser_OnPaint(Sender: TObject; const browser: ICefBrowser; kind: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; width, height: Integer);
procedure Browser_OnGetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect);
procedure Browser_OnGetScreenPoint(Sender: TObject; const browser: ICefBrowser; viewX, viewY: Integer; var screenX, screenY: Integer; out Result: Boolean);
procedure Browser_OnGetScreenInfo(Sender: TObject; const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out Result: Boolean);
procedure Browser_OnPopupShow(Sender: TObject; const browser: ICefBrowser; show: Boolean);
procedure Browser_OnPopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect);
procedure 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 Browser_OnBeforeClose(Sender: TObject; const browser: ICefBrowser);
procedure Browser_OnLoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring);
procedure Browser_OnLoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
procedure Resize;
function CreateBrowser : boolean;
procedure TakeSnapshot;
procedure CloseBrowser;
procedure DoOnError;
procedure InitError;
procedure WebpagePostProcessing;
procedure LoadPendingURL;
procedure Execute; override;
public
constructor Create(const aDefaultURL : ustring; aWidth, aHeight : integer; aDelayMs : integer = 500; const aScreenScale : single = 1);
destructor Destroy; override;
procedure AfterConstruction; override;
function TerminateBrowserThread : boolean;
function CopySnapshot(var aSnapshot : TBitmap) : boolean;
function SaveSnapshotToFile(const aPath : ustring) : boolean;
procedure LoadUrl(const aURL : ustring);
property ErrorCode : integer read GetErrorCode;
property ErrorText : ustring read GetErrorText;
property FailedUrl : ustring read GetFailedUrl;
property Initialized : boolean read GetInitialized;
property OnSnapshotAvailable : TNotifyEvent read FOnSnapshotAvailable write FOnSnapshotAvailable;
property OnError : TNotifyEvent read FOnError write FOnError;
end;
implementation
const
CEF_WEBPAGE_LOADED_MSG = WM_APP + 1;
CEF_WEBPAGE_ERROR_MSG = WM_APP + 2;
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);
FreeOnTerminate := False;
FInitialized := False;
FBrowser := nil;
FPanel := nil;
FPanelSize.cx := aWidth;
FPanelSize.cy := aHeight;
FScreenScale := aScreenScale;
FDefaultURL := aDefaultURL;
FPopUpBitmap := nil;
FPopUpRect := rect(0, 0, 0, 0);
FShowPopUp := False;
FResizing := False;
FPendingResize := False;
FResizeCS := nil;
FBrowserInfoCS := nil;
FSnapshot := nil;
FDelayMs := aDelayMs;
FOnSnapshotAvailable := nil;
FOnError := nil;
FClosing := False;
end;
destructor TCEFBrowserThread.Destroy;
begin
if (FBrowser <> nil) then
FreeAndNil(FBrowser);
if (FPanel <> nil) then
FreeAndNil(FPanel);
if (FPopUpBitmap <> nil) then
FreeAndNil(FPopUpBitmap);
if (FSnapshot <> nil) then
FreeAndNil(FSnapshot);
if (FResizeCS <> nil) then
FreeAndNil(FResizeCS);
if (FBrowserInfoCS <> nil) then
FreeAndNil(FBrowserInfoCS);
inherited Destroy;
end;
procedure TCEFBrowserThread.AfterConstruction;
begin
inherited AfterConstruction;
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;
FBrowser := TChromium.Create(nil);
FBrowser.DefaultURL := FDefaultURL;
FBrowser.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF);
FBrowser.OnAfterCreated := Browser_OnAfterCreated;
FBrowser.OnPaint := Browser_OnPaint;
FBrowser.OnGetViewRect := Browser_OnGetViewRect;
FBrowser.OnGetScreenPoint := Browser_OnGetScreenPoint;
FBrowser.OnGetScreenInfo := Browser_OnGetScreenInfo;
FBrowser.OnPopupShow := Browser_OnPopupShow;
FBrowser.OnPopupSize := Browser_OnPopupSize;
FBrowser.OnBeforePopup := Browser_OnBeforePopup;
FBrowser.OnBeforeClose := Browser_OnBeforeClose;
FBrowser.OnLoadError := Browser_OnLoadError;
FBrowser.OnLoadingStateChange := Browser_OnLoadingStateChange;
end;
function TCEFBrowserThread.GetErrorCode : integer;
begin
FBrowserInfoCS.Acquire;
Result := FErrorCode;
FBrowserInfoCS.Release;
end;
function TCEFBrowserThread.GetErrorText : ustring;
begin
FBrowserInfoCS.Acquire;
Result := FErrorText;
FBrowserInfoCS.Release;
end;
function TCEFBrowserThread.GetFailedUrl : ustring;
begin
FBrowserInfoCS.Acquire;
Result := FFailedUrl;
FBrowserInfoCS.Release;
end;
function TCEFBrowserThread.GetInitialized : boolean;
begin
Result := False;
if assigned(FBrowserInfoCS) and assigned(FBrowser) then
try
FBrowserInfoCS.Acquire;
Result := FInitialized and FBrowser.Initialized;
finally
FBrowserInfoCS.Release;
end;
end;
function TCEFBrowserThread.CopySnapshot(var aSnapshot : TBitmap) : boolean;
begin
Result := False;
if FClosing or Terminated or (FBrowserInfoCS = nil) then exit;
try
try
FBrowserInfoCS.Acquire;
if assigned(FSnapshot) and not(FSnapshot.Empty) then
begin
if (aSnapshot = nil) then
begin
aSnapshot := TBitmap.Create;
aSnapshot.PixelFormat := pf32bit;
aSnapshot.HandleType := bmDIB;
aSnapshot.Width := FSnapshot.Width;
aSnapshot.Height := FSnapshot.Height;
end;
aSnapshot.Assign(FSnapshot);
Result := True;
end;
except
on e : exception do
if CustomExceptionHandler('TCEFBrowserThread.CopySnapshot', e) then raise;
end;
finally
FBrowserInfoCS.Release;
end;
end;
function TCEFBrowserThread.SaveSnapshotToFile(const aPath : ustring) : boolean;
begin
Result := False;
if (FBrowserInfoCS = nil) then exit;
try
try
FBrowserInfoCS.Acquire;
if assigned(FSnapshot) and not(FSnapshot.Empty) then
begin
FSnapshot.SaveToFile(aPath);
Result := True;
end;
except
on e : exception do
if CustomExceptionHandler('TCEFBrowserThread.SaveSnapshotToFile', e) then raise;
end;
finally
FBrowserInfoCS.Release;
end;
end;
procedure TCEFBrowserThread.LoadUrl(const aURL : ustring);
begin
if FClosing or Terminated or (FBrowserInfoCS = nil) then
exit;
if Initialized then
try
FBrowserInfoCS.Acquire;
FPendingUrl := aURL;
PostThreadMessage(ThreadID, CEF_LOAD_PENDING_URL_MSG, 0, 0);
finally
FBrowserInfoCS.Release;
end;
end;
function TCEFBrowserThread.TerminateBrowserThread : boolean;
begin
Result := Initialized and
PostThreadMessage(ThreadID, CEF_CLOSE_BROWSER_MSG, 0, 0);
end;
procedure TCEFBrowserThread.Panel_OnResize(Sender: TObject);
begin
Resize;
end;
procedure TCEFBrowserThread.Browser_OnAfterCreated(Sender: TObject; const browser: ICefBrowser);
begin
FBrowserInfoCS.Acquire;
FInitialized := True;
FBrowserInfoCS.Release;
end;
procedure TCEFBrowserThread.Browser_OnPaint(Sender: TObject; const browser: ICefBrowser; kind: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; width, height: Integer);
var
src, dst: PByte;
i, j, TempLineSize, TempSrcOffset, TempDstOffset, SrcStride, DstStride : Integer;
n : NativeUInt;
TempWidth, TempHeight, TempScanlineSize : integer;
TempBufferBits : Pointer;
TempForcedResize : boolean;
TempSrcRect : TRect;
begin
try
FResizeCS.Acquire;
TempForcedResize := False;
if FPanel.BeginBufferDraw then
begin
if (kind = PET_POPUP) then
begin
if (FPopUpBitmap = nil) or
(width <> FPopUpBitmap.Width) or
(height <> FPopUpBitmap.Height) then
begin
if (FPopUpBitmap <> nil) then FPopUpBitmap.Free;
FPopUpBitmap := TBitmap.Create;
FPopUpBitmap.PixelFormat := pf32bit;
FPopUpBitmap.HandleType := bmDIB;
FPopUpBitmap.Width := width;
FPopUpBitmap.Height := height;
end;
TempWidth := FPopUpBitmap.Width;
TempHeight := FPopUpBitmap.Height;
TempScanlineSize := FPopUpBitmap.Width * SizeOf(TRGBQuad);
TempBufferBits := FPopUpBitmap.Scanline[pred(FPopUpBitmap.Height)];
end
else
begin
TempForcedResize := FPanel.UpdateBufferDimensions(Width, Height) or not(FPanel.BufferIsResized(False));
TempWidth := FPanel.BufferWidth;
TempHeight := FPanel.BufferHeight;
TempScanlineSize := FPanel.ScanlineSize;
TempBufferBits := FPanel.BufferBits;
end;
if (TempBufferBits <> nil) then
begin
SrcStride := Width * SizeOf(TRGBQuad);
DstStride := - TempScanlineSize;
n := 0;
while (n < dirtyRectsCount) do
begin
if (dirtyRects[n].x >= 0) and (dirtyRects[n].y >= 0) then
begin
TempLineSize := min(dirtyRects[n].width, TempWidth - dirtyRects[n].x) * SizeOf(TRGBQuad);
if (TempLineSize > 0) then
begin
TempSrcOffset := ((dirtyRects[n].y * Width) + dirtyRects[n].x) * SizeOf(TRGBQuad);
TempDstOffset := ((TempScanlineSize * pred(TempHeight)) - (dirtyRects[n].y * TempScanlineSize)) +
(dirtyRects[n].x * SizeOf(TRGBQuad));
src := @PByte(buffer)[TempSrcOffset];
dst := @PByte(TempBufferBits)[TempDstOffset];
i := 0;
j := min(dirtyRects[n].height, TempHeight - dirtyRects[n].y);
while (i < j) do
begin
Move(src^, dst^, TempLineSize);
Inc(dst, DstStride);
Inc(src, SrcStride);
inc(i);
end;
end;
end;
inc(n);
end;
if FShowPopup and (FPopUpBitmap <> nil) then
begin
TempSrcRect := Rect(0, 0,
min(FPopUpRect.Right - FPopUpRect.Left, FPopUpBitmap.Width),
min(FPopUpRect.Bottom - FPopUpRect.Top, FPopUpBitmap.Height));
FPanel.BufferDraw(FPopUpBitmap, TempSrcRect, FPopUpRect);
end;
end;
FPanel.EndBufferDraw;
if (kind = PET_VIEW) then
begin
if TempForcedResize or FPendingResize then
PostThreadMessage(ThreadID, CEF_PENDINGRESIZE, 0, 0);
FResizing := False;
FPendingResize := False;
end;
end;
finally
FResizeCS.Release;
end;
end;
procedure TCEFBrowserThread.Browser_OnGetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect);
begin
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(FPanel.Width, FScreenScale);
rect.height := DeviceToLogical(FPanel.Height, FScreenScale);
end;
procedure TCEFBrowserThread.Browser_OnGetScreenPoint(Sender: TObject; const browser: ICefBrowser; viewX, viewY: Integer; var screenX, screenY: Integer; out Result: Boolean);
begin
screenX := LogicalToDevice(viewX, FScreenScale);
screenY := LogicalToDevice(viewY, FScreenScale);
Result := True;
end;
procedure TCEFBrowserThread.Browser_OnGetScreenInfo(Sender: TObject; const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out Result: Boolean);
var
TempRect : TCEFRect;
begin
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(FPanel.Width, FScreenScale);
TempRect.height := DeviceToLogical(FPanel.Height, FScreenScale);
screenInfo.device_scale_factor := FScreenScale;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
Result := True;
end;
procedure TCEFBrowserThread.Browser_OnPopupShow(Sender: TObject; const browser: ICefBrowser; show: Boolean);
begin
if show then
FShowPopUp := True
else
begin
FShowPopUp := False;
FPopUpRect := rect(0, 0, 0, 0);
if (FBrowser <> nil) then FBrowser.Invalidate(PET_VIEW);
end;
end;
procedure TCEFBrowserThread.Browser_OnPopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect);
begin
LogicalToDevice(rect^, FScreenScale);
FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1;
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);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TCEFBrowserThread.Browser_OnBeforeClose(Sender: TObject; const browser: ICefBrowser);
begin
PostThreadMessage(ThreadID, WM_QUIT, 0, 0);
end;
procedure TCEFBrowserThread.Browser_OnLoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring);
begin
if not(FClosing) and not(Terminated) and (frame <> nil) and frame.IsValid and frame.IsMain then
try
FBrowserInfoCS.Acquire;
FErrorCode := errorCode;
FErrorText := errorText;
FFailedUrl := failedUrl;
PostThreadMessage(ThreadID, CEF_WEBPAGE_ERROR_MSG, 0, 0);
finally
FBrowserInfoCS.Release;
end;
end;
procedure TCEFBrowserThread.Browser_OnLoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
begin
if not(FClosing) and not(Terminated) and not(isLoading) then
PostThreadMessage(ThreadID, CEF_WEBPAGE_LOADED_MSG, 0, 0);
end;
procedure TCEFBrowserThread.Resize;
begin
if FClosing or Terminated or (FPanel = nil) or (FResizeCS = nil) or (FBrowser = nil) then
exit;
try
FResizeCS.Acquire;
if FResizing then
FPendingResize := True
else
if FPanel.BufferIsResized then
FBrowser.Invalidate(PET_VIEW)
else
begin
FResizing := True;
FBrowser.WasResized;
end;
finally
FResizeCS.Release;
end;
end;
function TCEFBrowserThread.CreateBrowser : boolean;
begin
Result := (FBrowser <> nil) and FBrowser.CreateBrowser;
end;
procedure TCEFBrowserThread.LoadPendingURL;
begin
if FClosing or Terminated or (FBrowser = nil) or (FBrowserInfoCS = nil) then
exit;
try
FBrowserInfoCS.Acquire;
if (length(FPendingURL) > 0) then
begin
FBrowser.LoadURL(FPendingURL);
FPendingURL := '';
end;
finally
FBrowserInfoCS.Release;
end;
end;
procedure TCEFBrowserThread.WebpagePostProcessing;
begin
if FClosing or Terminated then
exit;
if (FDelayMs > 0) then
sleep(FDelayMs);
TakeSnapshot;
if assigned(FOnSnapshotAvailable) then FOnSnapshotAvailable(self);
end;
procedure TCEFBrowserThread.TakeSnapshot;
begin
if (FPanel = nil) or (FPanel.Buffer = nil) or (FBrowserInfoCS = nil) then
exit;
try
FBrowserInfoCS.Acquire;
if (FSnapshot = nil) then
begin
FSnapshot := TBitmap.Create;
FSnapshot.PixelFormat := pf32bit;
FSnapshot.HandleType := bmDIB;
FSnapshot.Width := FPanel.BufferWidth;
FSnapshot.Height := FPanel.BufferHeight;
end;
FSnapshot.Assign(FPanel.Buffer);
finally
FBrowserInfoCS.Release;
end;
end;
procedure TCEFBrowserThread.CloseBrowser;
begin
if not(FClosing) and assigned(FBrowser) then
begin
FClosing := True;
FBrowser.CloseBrowser(True);
end;
end;
procedure TCEFBrowserThread.DoOnError;
begin
if assigned(FOnError) then
FOnError(self);
end;
procedure TCEFBrowserThread.InitError;
begin
FBrowserInfoCS.Acquire;
FErrorText := 'There was an error initializing the CEF browser.';
FBrowserInfoCS.Release;
DoOnError;
end;
procedure TCEFBrowserThread.Execute;
var
TempCont : boolean;
TempMsg : TMsg;
begin
if CreateBrowser then
begin
TempCont := True;
PeekMessage(TempMsg, 0, WM_USER, WM_USER, PM_NOREMOVE);
while TempCont and GetMessage(TempMsg, 0, 0, 0) and not(Terminated) do
begin
case TempMsg.Message of
CEF_PENDINGRESIZE : Resize;
CEF_CLOSE_BROWSER_MSG : CloseBrowser;
CEF_LOAD_PENDING_URL_MSG : LoadPendingURL;
CEF_WEBPAGE_LOADED_MSG : WebpagePostProcessing;
CEF_WEBPAGE_ERROR_MSG : DoOnError;
WM_QUIT : TempCont := False;
end;
DispatchMessage(TempMsg);
end;
end
else
InitError;
end;
end.

View File

@ -0,0 +1,229 @@
// ************************************************************************
// ***************************** 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 © 2020 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 <hgourvest@gmail.com>
* 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 uEncapsulatedBrowser;
{$I cef.inc}
interface
uses
{$IFDEF DELPHI16_UP}
System.SyncObjs, System.SysUtils,
{$ELSE}
SyncObjs, SysUtils,
{$ENDIF}
uCEFTypes, uCEFBrowserThread;
type
TEncapsulatedBrowser = class
protected
FThread : TCEFBrowserThread;
FWidth : integer;
FHeight : integer;
FDelayMs : integer;
FScale : single;
FSnapshotPath : ustring;
FErrorText : ustring;
procedure Thread_OnError(Sender: TObject);
procedure Thread_OnSnapshotAvailable(Sender: TObject);
public
constructor Create;
destructor Destroy; override;
procedure LoadURL(const aURL : string);
property Width : integer read FWidth write FWidth;
property Height : integer read FHeight write FHeight;
property DelayMs : integer read FDelayMs write FDelayMs;
property Scale : single read FScale write FScale;
property SnapshotPath : ustring read FSnapshotPath write FSnapshotPath;
property ErrorText : ustring read FErrorText;
end;
procedure CreateGlobalCEFApp;
function WaitForMainAppEvent : boolean;
procedure WriteResult;
implementation
uses
uCEFApplication;
var
MainAppEvent : TEvent;
EncapsulatedBrowser : TEncapsulatedBrowser = nil;
procedure GlobalCEFApp_OnContextInitialized;
var
TempParam, TempURL : ustring;
begin
TempURL := '';
// This demo reads the "/url" parameter to load it as the default URL in the browser.
// For example : ConsoleBrowser2.exe /url=https://www.briskbard.com
if (ParamCount > 0) then
begin
TempParam := paramstr(1);
if (Copy(TempParam, 1, 5) = '/url=') then
begin
TempURL := trim(Copy(TempParam, 6, length(TempParam)));
if (length(TempURL) > 0) then WriteLn('Loading ' + TempURL);
end;
end;
if (length(TempURL) = 0) then
begin
TempURL := 'https://www.google.com';
WriteLn('No URL has been specified. Using the default...');
end;
EncapsulatedBrowser := TEncapsulatedBrowser.Create;
EncapsulatedBrowser.LoadURL(TempURL);
end;
function WaitForMainAppEvent : boolean;
begin
Result := True;
// Wait for 1 minute max.
if (MainAppEvent.WaitFor(60000) = wrTimeout) then
begin
WriteLn('Timeout expired!');
Result := False;
end;
end;
procedure WriteResult;
begin
if (EncapsulatedBrowser = nil) then
WriteLn('There was a problem in the browser initialization')
else
if (length(EncapsulatedBrowser.ErrorText) > 0) then
WriteLn(EncapsulatedBrowser.ErrorText)
else
WriteLn('Snapshot saved successfully as ' + EncapsulatedBrowser.SnapshotPath);
end;
procedure CreateGlobalCEFApp;
begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
GlobalCEFApp.ShowMessageDlg := False; // This demo shouldn't show any window, just console messages.
GlobalCEFApp.BrowserSubprocessPath := 'ConsoleBrowser2_sp.exe'; // This is the other EXE for the CEF subprocesses. It's on the same directory as this app.
GlobalCEFApp.BlinkSettings := 'hideScrollbars'; // This setting removes all scrollbars to capture a cleaner snapshot
GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized;
GlobalCEFApp.StartMainProcess;
end;
constructor TEncapsulatedBrowser.Create;
begin
inherited Create;
FThread := nil;
FWidth := 1024;
FHeight := 768;
FDelayMs := 500;
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';
FErrorText := '';
end;
destructor TEncapsulatedBrowser.Destroy;
begin
if (FThread <> nil) then
begin
if FThread.TerminateBrowserThread then
FThread.WaitFor;
FreeAndNil(FThread);
end;
inherited Destroy;
end;
procedure TEncapsulatedBrowser.LoadURL(const aURL : string);
begin
if (FThread = nil) then
begin
FThread := TCEFBrowserThread.Create(aURL, FWidth, FHeight, FDelayMs, FScale);
FThread.OnError := Thread_OnError;
FThread.OnSnapshotAvailable := Thread_OnSnapshotAvailable;
FThread.Start;
end
else
FThread.LoadUrl(aURL);
end;
procedure TEncapsulatedBrowser.Thread_OnError(Sender: TObject);
begin
// This code is executed in the TCEFBrowserThread thread context while the main application thread is waiting for MainAppEvent.
FErrorText := 'Error';
if (FThread.ErrorCode <> 0) then
FErrorText := FErrorText + ' ' + inttostr(FThread.ErrorCode);
FErrorText := FErrorText + ' : ' + FThread.ErrorText;
if (length(FThread.FailedUrl) > 0) then
FErrorText := FErrorText + ' - ' + FThread.FailedUrl;
MainAppEvent.SetEvent;
end;
procedure TEncapsulatedBrowser.Thread_OnSnapshotAvailable(Sender: TObject);
begin
// This code is executed in the TCEFBrowserThread thread context while the main application thread is waiting for MainAppEvent.
if not(FThread.SaveSnapshotToFile(FSnapshotPath)) then
FErrorText := 'There was an error copying the snapshot';
MainAppEvent.SetEvent;
end;
initialization
MainAppEvent := TEvent.Create;
finalization
MainAppEvent.Free;
if (EncapsulatedBrowser <> nil) then FreeAndNil(EncapsulatedBrowser);
end.

View File

@ -59,6 +59,7 @@ object Form1: TForm1
OnBeforeContextMenu = chrmosrBeforeContextMenu
OnContextMenuCommand = chrmosrContextMenuCommand
OnTooltip = chrmosrTooltip
OnCursorChange = chrmosrCursorChange
OnBeforePopup = chrmosrBeforePopup
OnBeforeClose = chrmosrBeforeClose
OnGetViewRect = chrmosrGetViewRect
@ -67,7 +68,6 @@ object Form1: TForm1
OnPopupShow = chrmosrPopupShow
OnPopupSize = chrmosrPopupSize
OnPaint = chrmosrPaint
OnCursorChange = chrmosrCursorChange
OnVirtualKeyboardRequested = chrmosrVirtualKeyboardRequested
Left = 40
Top = 40

View File

@ -124,6 +124,7 @@ object OSRExternalPumpBrowserFrm: TOSRExternalPumpBrowserFrm
end
object chrmosr: TChromium
OnTooltip = chrmosrTooltip
OnCursorChange = chrmosrCursorChange
OnBeforePopup = chrmosrBeforePopup
OnAfterCreated = chrmosrAfterCreated
OnBeforeClose = chrmosrBeforeClose
@ -133,7 +134,6 @@ object OSRExternalPumpBrowserFrm: TOSRExternalPumpBrowserFrm
OnPopupShow = chrmosrPopupShow
OnPopupSize = chrmosrPopupSize
OnPaint = chrmosrPaint
OnCursorChange = chrmosrCursorChange
OnIMECompositionRangeChanged = chrmosrIMECompositionRangeChanged
Left = 24
Top = 56

View File

@ -44,6 +44,7 @@ object ChildForm: TChildForm
object Chromium1: TChromium
OnTitleChange = Chromium1TitleChange
OnTooltip = Chromium1Tooltip
OnCursorChange = Chromium1CursorChange
OnBeforeClose = Chromium1BeforeClose
OnGetViewRect = Chromium1GetViewRect
OnGetScreenPoint = Chromium1GetScreenPoint
@ -51,7 +52,6 @@ object ChildForm: TChildForm
OnPopupShow = Chromium1PopupShow
OnPopupSize = Chromium1PopupSize
OnPaint = Chromium1Paint
OnCursorChange = Chromium1CursorChange
Left = 24
Top = 56
end

View File

@ -69,6 +69,9 @@ type
implementation
uses
uCEFConstants;
constructor THelloScheme.Create(const browser : ICefBrowser;
const frame : ICefFrame;
const schemeName : ustring;
@ -115,15 +118,17 @@ end;
function THelloScheme.ProcessRequest(const request : ICefRequest; const callback : ICefCallback): Boolean;
var
TempFilename, TempExt : string;
TempFilename, TempExt, TempMessageTxt : string;
TempParts : TUrlParts;
TempFile : TFileStream;
TempResp : TStringStream;
begin
Result := False;
FStatus := 404;
FStatusText := 'ERROR';
FMimeType := '';
TempFile := nil;
TempResp := nil;
try
try
@ -132,54 +137,51 @@ begin
TempFilename := '';
FStream.Clear;
if CefParseUrl(Request.URL, TempParts) then
if CefParseUrl(Request.URL, TempParts) and
(length(TempParts.path) > 0) and
(TempParts.path <> '/') then
begin
if (length(TempParts.path) > 0) and
(TempParts.path <> '/') then
begin
TempFilename := TempParts.path;
TempFilename := TempParts.path;
if (length(TempFilename) > 0) and (TempFilename[1] = '/') then
TempFilename := copy(TempFilename, 2, length(TempFilename));
if (length(TempFilename) > 0) and (TempFilename[1] = '/') then
TempFilename := copy(TempFilename, 2, length(TempFilename));
if (length(TempFilename) > 0) and (TempFilename[length(TempFilename)] = '/') then
TempFilename := copy(TempFilename, 1, length(TempFilename) - 1);
if (length(TempFilename) > 0) and not(FileExists(TempFilename)) then
TempFilename := '';
end;
if (length(TempFilename) = 0) and
(length(TempParts.host) > 0) and
(TempParts.host <> '/') then
begin
TempFilename := TempParts.host;
if (length(TempFilename) > 0) and (TempFilename[1] = '/') then
TempFilename := copy(TempFilename, 2, length(TempFilename));
if (length(TempFilename) > 0) and (TempFilename[length(TempFilename)] = '/') then
TempFilename := copy(TempFilename, 1, length(TempFilename) - 1);
if (length(TempFilename) > 0) and not(FileExists(TempFilename)) then
TempFilename := '';
end;
if (length(TempFilename) > 0) and (TempFilename[length(TempFilename)] = '/') then
TempFilename := copy(TempFilename, 1, length(TempFilename) - 1);
end;
if (length(TempFilename) > 0) then
begin
TempExt := ExtractFileExt(TempFilename);
if (CompareText(TempFilename, 'customrequest') = 0) then
begin
Result := True;
FStatus := 200;
FStatusText := 'OK';
if (length(TempExt) > 0) and (TempExt[1] = '.') then
TempExt := copy(TempExt, 2, length(TempExt));
// This could be any information that your application needs to send to JS.
TempMessageTxt := 'This is the response from Delphi!' + CRLF + CRLF +
'Request query : ' + TempParts.query;
Result := True;
FStatus := 200;
FStatusText := 'OK';
FMimeType := CefGetMimeType(TempExt);
TempFile := TFileStream.Create(TempFilename, fmOpenRead);
TempFile.Seek(0, soFromBeginning);
FStream.LoadFromStream(TStream(TempFile));
TempResp := TStringStream.Create(TempMessageTxt);
TempResp.Seek(0, soFromBeginning);
FStream.LoadFromStream(TStream(TempResp));
end
else
if FileExists(TempFilename) then
begin
TempExt := ExtractFileExt(TempFilename);
if (length(TempExt) > 0) and (TempExt[1] = '.') then
TempExt := copy(TempExt, 2, length(TempExt));
FMimeType := CefGetMimeType(TempExt);
Result := True;
FStatus := 200;
FStatusText := 'OK';
TempFile := TFileStream.Create(TempFilename, fmOpenRead);
TempFile.Seek(0, soFromBeginning);
FStream.LoadFromStream(TStream(TempFile));
end;
end;
FStream.Seek(0, soFromBeginning);
@ -191,6 +193,7 @@ begin
finally
if (callback <> nil) then callback.Cont;
if (TempFile <> nil) then FreeAndNil(TempFile);
if (TempResp <> nil) then FreeAndNil(TempResp);
end;
end;

View File

@ -51,10 +51,10 @@ object SchemeRegistrationBrowserFrm: TSchemeRegistrationBrowserFrm
Align = alClient
ItemIndex = 1
TabOrder = 1
Text = 'hello://test.html'
Text = 'hello://localhost/test.html'
Items.Strings = (
'https://www.google.com'
'hello://test.html'
'hello://localhost/test.html'
'file://test.html')
end
end

View File

@ -56,6 +56,7 @@ uses
const
MINIBROWSER_CONTEXTMENU_REGSCHEME = MENU_ID_USER_FIRST + 1;
MINIBROWSER_CONTEXTMENU_CLEARFACT = MENU_ID_USER_FIRST + 2;
MINIBROWSER_CONTEXTMENU_SHOWDEVTOOLS = MENU_ID_USER_FIRST + 3;
CUSTOM_SCHEME_NAME = 'hello';
@ -148,6 +149,7 @@ procedure CreateGlobalCEFApp;
begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.OnRegCustomSchemes := GlobalCEFApp_OnRegCustomSchemes;
GlobalCEFApp.DisableWebSecurity := True;
// GlobalCEFApp.LogFile := 'debug.log';
// GlobalCEFApp.LogSeverity := LOGSEVERITY_VERBOSE;
@ -171,6 +173,7 @@ procedure TSchemeRegistrationBrowserFrm.Chromium1BeforeContextMenu(
begin
model.AddItem(MINIBROWSER_CONTEXTMENU_REGSCHEME, 'Register scheme');
model.AddItem(MINIBROWSER_CONTEXTMENU_CLEARFACT, 'Clear schemes');
model.AddItem(MINIBROWSER_CONTEXTMENU_SHOWDEVTOOLS, 'Show DevTools');
end;
procedure TSchemeRegistrationBrowserFrm.Chromium1BeforePopup(
@ -198,6 +201,7 @@ procedure TSchemeRegistrationBrowserFrm.Chromium1ContextMenuCommand(
const params: ICefContextMenuParams; commandId: Integer;
eventFlags: Cardinal; out Result: Boolean);
var
TempPoint : TPoint;
TempFactory: ICefSchemeHandlerFactory;
begin
Result := False;
@ -222,6 +226,13 @@ begin
if not(browser.host.RequestContext.ClearSchemeHandlerFactories) then
MessageDlg('ClearSchemeHandlerFactories error !', mtError, [mbOk], 0);
end;
MINIBROWSER_CONTEXTMENU_SHOWDEVTOOLS :
begin
TempPoint.x := params.XCoord;
TempPoint.y := params.YCoord;
Chromium1.ShowDevTools(TempPoint, nil);
end;
end;
end;
@ -245,6 +256,7 @@ end;
procedure TSchemeRegistrationBrowserFrm.FormShow(Sender: TObject);
begin
Chromium1.DefaultURL := AddressCbx.Text;
// GlobalCEFApp.GlobalContextInitialized has to be TRUE before creating any browser
// If it's not initialized yet, we use a simple timer to create the browser later.
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) then Timer1.Enabled := True;
@ -266,7 +278,6 @@ procedure TSchemeRegistrationBrowserFrm.BrowserCreatedMsg(var aMessage : TMessag
begin
CEFWindowParent1.UpdateSize;
AddressBarPnl.Enabled := True;
GoBtn.Click;
end;
procedure TSchemeRegistrationBrowserFrm.BrowserDestroyMsg(var aMessage : TMessage);

View File

@ -45,13 +45,13 @@ uses
{$IFDEF DELPHI16_UP}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
System.SyncObjs, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
Vcl.ExtCtrls, Vcl.AppEvnts, WinApi.imm,
Vcl.ExtCtrls, Vcl.AppEvnts, WinApi.imm, Vcl.ComCtrls,
{$ELSE}
Windows, Messages, SysUtils, Variants, Classes, SyncObjs,
Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, AppEvnts,
Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, AppEvnts, ComCtrls,
{$ENDIF}
uCEFChromium, uCEFTypes, uCEFInterfaces, uCEFConstants, uCEFBufferPanel,
uCEFSentinel, uCEFChromiumCore, Vcl.ComCtrls;
uCEFChromiumCore;
const
// Set this constant to True and load "file://transparency.html" to test a

View File

@ -0,0 +1,18 @@
del /s /q *.dcu
del /s /q *.exe
del /s /q *.res
del /s /q *.rsm
del /s /q *.log
del /s /q *.dsk
del /s /q *.identcache
del /s /q *.stat
del /s /q *.local
del /s /q *.~*
rmdir Win32\Debug
rmdir Win32\Release
rmdir Win32
rmdir Win64\Debug
rmdir Win64\Release
rmdir Win64
rmdir __history
rmdir __recovery

View File

@ -0,0 +1,71 @@
// ************************************************************************
// ***************************** 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 © 2020 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 <hgourvest@gmail.com>
* 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.
*
*)
program WebpageSnapshot;
{$I cef.inc}
uses
{$IFDEF DELPHI16_UP}
Vcl.Forms,
{$ELSE}
Forms,
{$ENDIF}
uCEFApplication,
uCEFBrowserThread in 'uCEFBrowserThread.pas',
uWebpageSnapshot in 'uWebpageSnapshot.pas' {WebpageSnapshotFrm};
{$R *.res}
{$IFDEF WIN32}
// CEF3 needs to set the LARGEADDRESSAWARE ($20) flag which allows 32-bit processes to use up to 3GB of RAM.
{$SetPEFlags $20}
{$ENDIF}
begin
CreateGlobalCEFApp;
if GlobalCEFApp.StartMainProcess then
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TWebpageSnapshotFrm, WebpageSnapshotFrm);
Application.Run;
end;
DestroyGlobalCEFApp;
end.

View File

@ -0,0 +1,940 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{54265C7D-F5FB-4C27-A683-6F968C4157F1}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>WebpageSnapshot.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>3</TargetedPlatforms>
<AppType>Application</AppType>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win64)'!=''">
<Cfg_1_Win64>true</Cfg_1_Win64>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win64)'!=''">
<Cfg_2_Win64>true</Cfg_2_Win64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>..\..\..\bin</DCC_ExeOutput>
<DCC_E>false</DCC_E>
<DCC_N>false</DCC_N>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
<SanitizedProjectName>WebpageSnapshot</SanitizedProjectName>
<VerInfo_Locale>3082</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;bindcompvclsmp;emsclientfiredac;tethering;svnui;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;VisualStyles_runtime;vcltouch;vcldb;bindcompfmx;svn;DBXOracleDriver;inetdb;fmx;FireDACIBDriver;fmxdae;vcledge;FireDACDBXDriver;dbexpress;vclx;dsnap;emsclient;DataSnapCommon;FireDACCommon;IndySystem260;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;CEF4Delphi_FMX;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;IndyProtocols260;bindcompdbx;vcl;DBXSybaseASEDriver;IndyCore260;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;Componentes_UI;FireDAC;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;SVGPackage;soaprtl;DbxCommonDriver;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;bindcompvclsmp;emsclientfiredac;tethering;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;VisualStyles_runtime;vcltouch;vcldb;bindcompfmx;DBXOracleDriver;inetdb;fmx;FireDACIBDriver;fmxdae;vcledge;FireDACDBXDriver;dbexpress;vclx;dsnap;emsclient;DataSnapCommon;FireDACCommon;IndySystem260;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;CEF4Delphi_FMX;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;IndyProtocols260;bindcompdbx;vcl;DBXSybaseASEDriver;IndyCore260;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;Componentes_UI;FireDAC;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;SVGPackage;soaprtl;DbxCommonDriver;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_DebugDCUs>true</DCC_DebugDCUs>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win64)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="uCEFBrowserThread.pas"/>
<DCCReference Include="uWebpageSnapshot.pas">
<Form>WebpageSnapshotFrm</Form>
</DCCReference>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>Application</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">WebpageSnapshot.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\DataExplorerFireDACPlugin270.bpl">FireDAC Data Explorer Integration</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclIPIndyImpl270.bpl">IP Abstraction Indy Implementation Design Time</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k270.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp270.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="..\..\..\bin\WebpageSnapshot.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>WebpageSnapshot.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClassesDexFile">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidFileProvider">
<Platform Name="Android">
<RemoteDir>res\xml</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\xml</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidGDBServer">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiFile">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiv7aFile">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeMipsFile">
<Platform Name="Android">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidServiceOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\arm64-v8a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidServiceOutput_Android32">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashImageDef">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStyles">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStylesV21">
<Platform Name="Android">
<RemoteDir>res\values-v21</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values-v21</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Colors">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_DefaultAppIcon">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon144">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon24">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage426">
<Platform Name="Android">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage470">
<Platform Name="Android">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage640">
<Platform Name="Android">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage960">
<Platform Name="Android">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Strings">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyFramework">
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyModule">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="DependencyPackage">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Name="File">
<Platform Name="Android">
<Operation>0</Operation>
</Platform>
<Platform Name="Android64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>0</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iOS_AppStore1024">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon152">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon167">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_SpotLight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon180">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification60">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting87">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectAndroidManifest">
<Platform Name="Android">
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSEntitlements">
<Platform Name="iOSDevice32">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSInfoPList">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSLaunchScreen">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen</RemoteDir>
<Operation>64</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen</RemoteDir>
<Operation>64</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSResource">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXDebug">
<Platform Name="OSX64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXEntitlements">
<Platform Name="OSX32">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXInfoPList">
<Platform Name="OSX32">
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\arm64-v8a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="Linux64">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOutput_Android32">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectUWPManifest">
<Platform Name="Win32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo150">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
</Deployment>
<Platforms>
<Platform value="Win32">True</Platform>
<Platform value="Win64">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
</Project>

View File

@ -0,0 +1,662 @@
// ************************************************************************
// ***************************** 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 © 2020 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 <hgourvest@gmail.com>
* 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 uCEFBrowserThread;
{$I cef.inc}
interface
uses
{$IFDEF DELPHI16_UP}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, System.SyncObjs, System.Math,
{$ELSE}
Windows, Messages, SysUtils, Classes, Graphics, SyncObjs, Math,
{$ENDIF}
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;
FPanelSize : TSize;
FScreenScale : single;
FPopUpBitmap : TBitmap;
FPopUpRect : TRect;
FResizeCS : TCriticalSection;
FBrowserInfoCS : TCriticalSection;
FShowPopUp : boolean;
FClosing : boolean;
FResizing : boolean;
FPendingResize : boolean;
FInitialized : boolean;
FDefaultURL : ustring;
FSnapshot : TBitmap;
FDelayMs : integer;
FOnSnapshotAvailable : TNotifyEvent;
FOnError : TNotifyEvent;
FErrorCode : integer;
FErrorText : ustring;
FFailedUrl : ustring;
FPendingUrl : ustring;
function GetErrorCode : integer;
function GetErrorText : ustring;
function GetFailedUrl : ustring;
function GetInitialized : boolean;
procedure Panel_OnResize(Sender: TObject);
procedure Browser_OnAfterCreated(Sender: TObject; const browser: ICefBrowser);
procedure Browser_OnPaint(Sender: TObject; const browser: ICefBrowser; kind: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; width, height: Integer);
procedure Browser_OnGetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect);
procedure Browser_OnGetScreenPoint(Sender: TObject; const browser: ICefBrowser; viewX, viewY: Integer; var screenX, screenY: Integer; out Result: Boolean);
procedure Browser_OnGetScreenInfo(Sender: TObject; const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out Result: Boolean);
procedure Browser_OnPopupShow(Sender: TObject; const browser: ICefBrowser; show: Boolean);
procedure Browser_OnPopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect);
procedure 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 Browser_OnBeforeClose(Sender: TObject; const browser: ICefBrowser);
procedure Browser_OnLoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring);
procedure Browser_OnLoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
procedure DoOnError;
procedure DoOnSnapshotAvailable;
procedure Resize;
function CreateBrowser : boolean;
procedure TakeSnapshot;
procedure CloseBrowser;
procedure WebpagePostProcessing;
procedure LoadPendingURL;
procedure Execute; override;
public
constructor Create(const aDefaultURL : ustring; aWidth, aHeight : integer; aDelayMs : integer = 500; const aScreenScale : single = 1);
destructor Destroy; override;
procedure AfterConstruction; override;
function TerminateBrowserThread : boolean;
function CopySnapshot(var aSnapshot : TBitmap) : boolean;
procedure LoadUrl(const aURL : ustring);
property ErrorCode : integer read GetErrorCode;
property ErrorText : ustring read GetErrorText;
property FailedUrl : ustring read GetFailedUrl;
property Initialized : boolean read GetInitialized;
property OnSnapshotAvailable : TNotifyEvent read FOnSnapshotAvailable write FOnSnapshotAvailable;
property OnError : TNotifyEvent read FOnError write FOnError;
end;
implementation
const
CEF_WEBPAGE_LOADED_MSG = WM_APP + 1;
CEF_WEBPAGE_ERROR_MSG = WM_APP + 2;
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);
FreeOnTerminate := False;
FInitialized := False;
FBrowser := nil;
FPanel := nil;
FPanelSize.cx := aWidth;
FPanelSize.cy := aHeight;
FScreenScale := aScreenScale;
FDefaultURL := aDefaultURL;
FPopUpBitmap := nil;
FPopUpRect := rect(0, 0, 0, 0);
FShowPopUp := False;
FResizing := False;
FPendingResize := False;
FResizeCS := nil;
FBrowserInfoCS := nil;
FSnapshot := nil;
FDelayMs := aDelayMs;
FOnSnapshotAvailable := nil;
FOnError := nil;
FClosing := False;
end;
destructor TCEFBrowserThread.Destroy;
begin
if (FBrowser <> nil) then
FreeAndNil(FBrowser);
if (FPanel <> nil) then
FreeAndNil(FPanel);
if (FPopUpBitmap <> nil) then
FreeAndNil(FPopUpBitmap);
if (FSnapshot <> nil) then
FreeAndNil(FSnapshot);
if (FResizeCS <> nil) then
FreeAndNil(FResizeCS);
if (FBrowserInfoCS <> nil) then
FreeAndNil(FBrowserInfoCS);
inherited Destroy;
end;
procedure TCEFBrowserThread.AfterConstruction;
begin
inherited AfterConstruction;
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;
FBrowser := TChromium.Create(nil);
FBrowser.DefaultURL := FDefaultURL;
FBrowser.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF);
FBrowser.OnAfterCreated := Browser_OnAfterCreated;
FBrowser.OnPaint := Browser_OnPaint;
FBrowser.OnGetViewRect := Browser_OnGetViewRect;
FBrowser.OnGetScreenPoint := Browser_OnGetScreenPoint;
FBrowser.OnGetScreenInfo := Browser_OnGetScreenInfo;
FBrowser.OnPopupShow := Browser_OnPopupShow;
FBrowser.OnPopupSize := Browser_OnPopupSize;
FBrowser.OnBeforePopup := Browser_OnBeforePopup;
FBrowser.OnBeforeClose := Browser_OnBeforeClose;
FBrowser.OnLoadError := Browser_OnLoadError;
FBrowser.OnLoadingStateChange := Browser_OnLoadingStateChange;
end;
function TCEFBrowserThread.GetErrorCode : integer;
begin
FBrowserInfoCS.Acquire;
Result := FErrorCode;
FBrowserInfoCS.Release;
end;
function TCEFBrowserThread.GetErrorText : ustring;
begin
FBrowserInfoCS.Acquire;
Result := FErrorText;
FBrowserInfoCS.Release;
end;
function TCEFBrowserThread.GetFailedUrl : ustring;
begin
FBrowserInfoCS.Acquire;
Result := FFailedUrl;
FBrowserInfoCS.Release;
end;
function TCEFBrowserThread.GetInitialized : boolean;
begin
Result := False;
if assigned(FBrowserInfoCS) and assigned(FBrowser) then
try
FBrowserInfoCS.Acquire;
Result := FInitialized and FBrowser.Initialized;
finally
FBrowserInfoCS.Release;
end;
end;
function TCEFBrowserThread.CopySnapshot(var aSnapshot : TBitmap) : boolean;
begin
Result := False;
if FClosing or Terminated or (FBrowserInfoCS = nil) then exit;
try
try
FBrowserInfoCS.Acquire;
if assigned(FSnapshot) and not(FSnapshot.Empty) then
begin
if (aSnapshot = nil) then
begin
aSnapshot := TBitmap.Create;
aSnapshot.PixelFormat := pf32bit;
aSnapshot.HandleType := bmDIB;
aSnapshot.Width := FSnapshot.Width;
aSnapshot.Height := FSnapshot.Height;
end;
aSnapshot.Assign(FSnapshot);
Result := True;
end;
except
on e : exception do
if CustomExceptionHandler('TCEFBrowserThread.CopySnapshot', e) then raise;
end;
finally
FBrowserInfoCS.Release;
end;
end;
procedure TCEFBrowserThread.LoadUrl(const aURL : ustring);
begin
if FClosing or Terminated or (FBrowserInfoCS = nil) then
exit;
if Initialized then
try
FBrowserInfoCS.Acquire;
FPendingUrl := aURL;
PostThreadMessage(ThreadID, CEF_LOAD_PENDING_URL_MSG, 0, 0);
finally
FBrowserInfoCS.Release;
end;
end;
function TCEFBrowserThread.TerminateBrowserThread : boolean;
begin
Result := Initialized and
PostThreadMessage(ThreadID, CEF_CLOSE_BROWSER_MSG, 0, 0);
end;
procedure TCEFBrowserThread.Panel_OnResize(Sender: TObject);
begin
Resize;
end;
procedure TCEFBrowserThread.Browser_OnAfterCreated(Sender: TObject; const browser: ICefBrowser);
begin
FBrowserInfoCS.Acquire;
FInitialized := True;
FBrowserInfoCS.Release;
end;
procedure TCEFBrowserThread.Browser_OnPaint(Sender: TObject; const browser: ICefBrowser; kind: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; width, height: Integer);
var
src, dst: PByte;
i, j, TempLineSize, TempSrcOffset, TempDstOffset, SrcStride, DstStride : Integer;
n : NativeUInt;
TempWidth, TempHeight, TempScanlineSize : integer;
TempBufferBits : Pointer;
TempForcedResize : boolean;
TempSrcRect : TRect;
begin
try
FResizeCS.Acquire;
TempForcedResize := False;
if FPanel.BeginBufferDraw then
begin
if (kind = PET_POPUP) then
begin
if (FPopUpBitmap = nil) or
(width <> FPopUpBitmap.Width) or
(height <> FPopUpBitmap.Height) then
begin
if (FPopUpBitmap <> nil) then FPopUpBitmap.Free;
FPopUpBitmap := TBitmap.Create;
FPopUpBitmap.PixelFormat := pf32bit;
FPopUpBitmap.HandleType := bmDIB;
FPopUpBitmap.Width := width;
FPopUpBitmap.Height := height;
end;
TempWidth := FPopUpBitmap.Width;
TempHeight := FPopUpBitmap.Height;
TempScanlineSize := FPopUpBitmap.Width * SizeOf(TRGBQuad);
TempBufferBits := FPopUpBitmap.Scanline[pred(FPopUpBitmap.Height)];
end
else
begin
TempForcedResize := FPanel.UpdateBufferDimensions(Width, Height) or not(FPanel.BufferIsResized(False));
TempWidth := FPanel.BufferWidth;
TempHeight := FPanel.BufferHeight;
TempScanlineSize := FPanel.ScanlineSize;
TempBufferBits := FPanel.BufferBits;
end;
if (TempBufferBits <> nil) then
begin
SrcStride := Width * SizeOf(TRGBQuad);
DstStride := - TempScanlineSize;
n := 0;
while (n < dirtyRectsCount) do
begin
if (dirtyRects[n].x >= 0) and (dirtyRects[n].y >= 0) then
begin
TempLineSize := min(dirtyRects[n].width, TempWidth - dirtyRects[n].x) * SizeOf(TRGBQuad);
if (TempLineSize > 0) then
begin
TempSrcOffset := ((dirtyRects[n].y * Width) + dirtyRects[n].x) * SizeOf(TRGBQuad);
TempDstOffset := ((TempScanlineSize * pred(TempHeight)) - (dirtyRects[n].y * TempScanlineSize)) +
(dirtyRects[n].x * SizeOf(TRGBQuad));
src := @PByte(buffer)[TempSrcOffset];
dst := @PByte(TempBufferBits)[TempDstOffset];
i := 0;
j := min(dirtyRects[n].height, TempHeight - dirtyRects[n].y);
while (i < j) do
begin
Move(src^, dst^, TempLineSize);
Inc(dst, DstStride);
Inc(src, SrcStride);
inc(i);
end;
end;
end;
inc(n);
end;
if FShowPopup and (FPopUpBitmap <> nil) then
begin
TempSrcRect := Rect(0, 0,
min(FPopUpRect.Right - FPopUpRect.Left, FPopUpBitmap.Width),
min(FPopUpRect.Bottom - FPopUpRect.Top, FPopUpBitmap.Height));
FPanel.BufferDraw(FPopUpBitmap, TempSrcRect, FPopUpRect);
end;
end;
FPanel.EndBufferDraw;
FPanel.InvalidatePanel;
if (kind = PET_VIEW) then
begin
if TempForcedResize or FPendingResize then PostThreadMessage(ThreadID, CEF_PENDINGRESIZE, 0, 0);
FResizing := False;
FPendingResize := False;
end;
end;
finally
FResizeCS.Release;
end;
end;
procedure TCEFBrowserThread.Browser_OnGetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect);
begin
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(FPanel.Width, FScreenScale);
rect.height := DeviceToLogical(FPanel.Height, FScreenScale);
end;
procedure TCEFBrowserThread.Browser_OnGetScreenPoint(Sender: TObject; const browser: ICefBrowser; viewX, viewY: Integer; var screenX, screenY: Integer; out Result: Boolean);
begin
screenX := LogicalToDevice(viewX, FScreenScale);
screenY := LogicalToDevice(viewY, FScreenScale);
Result := True;
end;
procedure TCEFBrowserThread.Browser_OnGetScreenInfo(Sender: TObject; const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out Result: Boolean);
var
TempRect : TCEFRect;
begin
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(FPanel.Width, FScreenScale);
TempRect.height := DeviceToLogical(FPanel.Height, FScreenScale);
screenInfo.device_scale_factor := FScreenScale;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
Result := True;
end;
procedure TCEFBrowserThread.Browser_OnPopupShow(Sender: TObject; const browser: ICefBrowser; show: Boolean);
begin
if show then
FShowPopUp := True
else
begin
FShowPopUp := False;
FPopUpRect := rect(0, 0, 0, 0);
if (FBrowser <> nil) then FBrowser.Invalidate(PET_VIEW);
end;
end;
procedure TCEFBrowserThread.Browser_OnPopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect);
begin
LogicalToDevice(rect^, FScreenScale);
FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1;
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);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TCEFBrowserThread.Browser_OnBeforeClose(Sender: TObject; const browser: ICefBrowser);
begin
PostThreadMessage(ThreadID, WM_QUIT, 0, 0);
end;
procedure TCEFBrowserThread.Browser_OnLoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring);
begin
if not(FClosing) and not(Terminated) and (frame <> nil) and frame.IsValid and frame.IsMain then
try
FBrowserInfoCS.Acquire;
FErrorCode := errorCode;
FErrorText := errorText;
FFailedUrl := failedUrl;
PostThreadMessage(ThreadID, CEF_WEBPAGE_ERROR_MSG, 0, 0);
finally
FBrowserInfoCS.Release;
end;
end;
procedure TCEFBrowserThread.Browser_OnLoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
begin
if not(FClosing) and not(Terminated) and not(isLoading) then
PostThreadMessage(ThreadID, CEF_WEBPAGE_LOADED_MSG, 0, 0);
end;
procedure TCEFBrowserThread.DoOnError;
begin
FOnError(self);
end;
procedure TCEFBrowserThread.DoOnSnapshotAvailable;
begin
FOnSnapshotAvailable(self);
end;
procedure TCEFBrowserThread.Resize;
begin
if FClosing or Terminated or (FPanel = nil) or (FResizeCS = nil) or (FBrowser = nil) then
exit;
try
FResizeCS.Acquire;
if FResizing then
FPendingResize := True
else
if FPanel.BufferIsResized then
FBrowser.Invalidate(PET_VIEW)
else
begin
FResizing := True;
FBrowser.WasResized;
end;
finally
FResizeCS.Release;
end;
end;
function TCEFBrowserThread.CreateBrowser : boolean;
begin
Result := (FBrowser <> nil) and FBrowser.CreateBrowser;
end;
procedure TCEFBrowserThread.LoadPendingURL;
begin
if FClosing or Terminated or (FBrowser = nil) or (FBrowserInfoCS = nil) then
exit;
try
FBrowserInfoCS.Acquire;
if (length(FPendingURL) > 0) then
begin
FBrowser.LoadURL(FPendingURL);
FPendingURL := '';
end;
finally
FBrowserInfoCS.Release;
end;
end;
procedure TCEFBrowserThread.WebpagePostProcessing;
begin
if FClosing or Terminated then
exit;
if (FDelayMs > 0) then
sleep(FDelayMs);
TakeSnapshot;
if assigned(FOnSnapshotAvailable) then
Synchronize(DoOnSnapshotAvailable);
end;
procedure TCEFBrowserThread.TakeSnapshot;
begin
if (FPanel = nil) or (FPanel.Buffer = nil) or (FBrowserInfoCS = nil) then
exit;
try
FBrowserInfoCS.Acquire;
if (FSnapshot = nil) then
begin
FSnapshot := TBitmap.Create;
FSnapshot.PixelFormat := pf32bit;
FSnapshot.HandleType := bmDIB;
FSnapshot.Width := FPanel.BufferWidth;
FSnapshot.Height := FPanel.BufferHeight;
end;
FSnapshot.Assign(FPanel.Buffer);
finally
FBrowserInfoCS.Release;
end;
end;
procedure TCEFBrowserThread.CloseBrowser;
begin
if not(FClosing) and assigned(FBrowser) then
begin
FClosing := True;
FBrowser.CloseBrowser(True);
end;
end;
procedure TCEFBrowserThread.Execute;
var
TempCont : boolean;
TempMsg : TMsg;
begin
if CreateBrowser then
begin
TempCont := True;
PeekMessage(TempMsg, 0, WM_USER, WM_USER, PM_NOREMOVE);
while TempCont and GetMessage(TempMsg, 0, 0, 0) and not(Terminated) do
begin
case TempMsg.Message of
WM_QUIT : TempCont := False;
CEF_PENDINGRESIZE : Resize;
CEF_CLOSE_BROWSER_MSG : CloseBrowser;
CEF_LOAD_PENDING_URL_MSG : LoadPendingURL;
CEF_WEBPAGE_LOADED_MSG : WebpagePostProcessing;
CEF_WEBPAGE_ERROR_MSG : if assigned(FOnError) then Synchronize(DoOnError);
end;
DispatchMessage(TempMsg);
end;
end;
end;
end.

View File

@ -0,0 +1,75 @@
object WebpageSnapshotFrm: TWebpageSnapshotFrm
Left = 0
Top = 0
Caption = 'Web page snapshot'
ClientHeight = 486
ClientWidth = 711
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Image1: TImage
Left = 0
Top = 25
Width = 711
Height = 442
Align = alClient
AutoSize = True
Center = True
Proportional = True
ExplicitLeft = 104
ExplicitTop = 112
ExplicitWidth = 105
ExplicitHeight = 105
end
object StatusBar1: TStatusBar
Left = 0
Top = 467
Width = 711
Height = 19
Panels = <
item
Width = 1000
end>
end
object NavigationPnl: TPanel
Left = 0
Top = 0
Width = 711
Height = 25
Align = alTop
BevelOuter = bvNone
Padding.Left = 2
Padding.Top = 2
Padding.Right = 2
Padding.Bottom = 2
TabOrder = 1
object GoBtn: TButton
Left = 634
Top = 2
Width = 75
Height = 21
Align = alRight
Caption = 'Go'
TabOrder = 0
OnClick = GoBtnClick
end
object AddressEdt: TEdit
Left = 2
Top = 2
Width = 632
Height = 21
Align = alClient
TabOrder = 1
Text = 'https://www.google.com'
end
end
end

View File

@ -0,0 +1,165 @@
// ************************************************************************
// ***************************** 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 © 2020 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 <hgourvest@gmail.com>
* 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 uWebpageSnapshot;
{$I cef.inc}
interface
uses
{$IFDEF DELPHI16_UP}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls,
{$ELSE}
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls,
{$ENDIF}
uCEFBrowserThread;
type
TWebpageSnapshotFrm = class(TForm)
StatusBar1: TStatusBar;
Image1: TImage;
NavigationPnl: TPanel;
GoBtn: TButton;
AddressEdt: TEdit;
procedure GoBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
FThread : TCEFBrowserThread;
procedure Thread_OnError(Sender: TObject);
procedure Thread_OnSnapshotAvailable(Sender: TObject);
end;
var
WebpageSnapshotFrm: TWebpageSnapshotFrm;
// This demo shows how to encapsulate a browser without user interface in a thread.
// The thread in the uCEFBrowserThread unit has a browser in "off-screen" mode
// and it takes a snapshot when the browser has loaded a web page.
// The thread triggers the TCEFBrowserThread.OnSnapshotAvailable when the main thread
// can copy the snapshot in a bitmap.
// If there's an error loading the page then TCEFBrowserThread.OnError will be
// triggered and the error information will be available in the
// TCEFBrowserThread.ErrorCode, TCEFBrowserThread.ErrorText and
// TCEFBrowserThread.FailedUrl properties.
// The TCEFBrowserThread.Create constructor has the default URL, virtual screen size,
// virtual screen scale and a delay as parameters. The delay is applied after the browser
// has finished loading the main frame and before taking the snapshot.
procedure CreateGlobalCEFApp;
implementation
{$R *.dfm}
uses
uCEFApplication;
procedure CreateGlobalCEFApp;
begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
end;
procedure TWebpageSnapshotFrm.GoBtnClick(Sender: TObject);
begin
StatusBar1.Panels[0].Text := 'Loading...';
screen.cursor := crAppStart;
if (FThread = nil) then
begin
FThread := TCEFBrowserThread.Create(AddressEdt.Text, 1024, 768);
FThread.OnError := Thread_OnError;
FThread.OnSnapshotAvailable := Thread_OnSnapshotAvailable;
FThread.Start;
end
else
FThread.LoadUrl(AddressEdt.Text);
end;
procedure TWebpageSnapshotFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if (FThread <> nil) then
begin
if FThread.TerminateBrowserThread then
FThread.WaitFor;
FreeAndNil(FThread);
end;
CanClose := True;
end;
procedure TWebpageSnapshotFrm.FormCreate(Sender: TObject);
begin
FThread := nil;
end;
procedure TWebpageSnapshotFrm.Thread_OnError(Sender: TObject);
begin
StatusBar1.Panels[0].Text := 'Error ' + inttostr(FThread.ErrorCode) + ' : ' + FThread.ErrorText + ' - ' + FThread.FailedUrl;
screen.cursor := crDefault;
end;
procedure TWebpageSnapshotFrm.Thread_OnSnapshotAvailable(Sender: TObject);
var
TempBitmap : TBitmap;
begin
TempBitmap := nil;
screen.cursor := crDefault;
if (FThread <> nil) and FThread.CopySnapshot(TempBitmap) then
begin
Image1.Picture.Assign(TempBitmap);
StatusBar1.Panels[0].Text := 'Snapshot copied successfully';
TempBitmap.Free;
end
else
StatusBar1.Panels[0].Text := 'There was an error copying the snapshot';
end;
end.

View File

@ -1,182 +0,0 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="11"/>
<BuildModes Active="Default"/>
<Units Count="5">
<Unit0>
<Filename Value="SimpleOSRBrowser.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="2"/>
<TopLine Value="31"/>
<CursorPos X="56" Y="52"/>
<UsageCount Value="22"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="usimpleosrbrowser.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uSimpleOSRBrowser"/>
<IsVisibleTab Value="True"/>
<TopLine Value="153"/>
<CursorPos X="65" Y="176"/>
<ComponentState Value="1"/>
<UsageCount Value="22"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="/usr/share/lazarus/2.0.6/lcl/lcltype.pp"/>
<UnitName Value="LCLType"/>
<EditorIndex Value="-1"/>
<TopLine Value="52"/>
<CursorPos X="3" Y="68"/>
<UsageCount Value="10"/>
</Unit2>
<Unit3>
<Filename Value="../../../../source/uCEFMiscFunctions.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="1889"/>
<CursorPos X="27" Y="1907"/>
<UsageCount Value="10"/>
</Unit3>
<Unit4>
<Filename Value="../../../../source/uCEFApplicationCore.pas"/>
<EditorIndex Value="1"/>
<TopLine Value="432"/>
<CursorPos X="29" Y="445"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit4>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="584" Column="18" TopLine="567"/>
</Position1>
<Position2>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="710" Column="5" TopLine="688"/>
</Position2>
<Position3>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="776" Column="43" TopLine="751"/>
</Position3>
<Position4>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="147" Column="34" TopLine="132"/>
</Position4>
<Position5>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="300" Column="33" TopLine="284"/>
</Position5>
<Position6>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="328" Column="29" TopLine="309"/>
</Position6>
<Position7>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="771" Column="48" TopLine="751"/>
</Position7>
<Position8>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="774" TopLine="742"/>
</Position8>
<Position9>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="135" Column="34" TopLine="132"/>
</Position9>
<Position10>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="294" Column="7" TopLine="281"/>
</Position10>
<Position11>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="141" TopLine="122"/>
</Position11>
<Position12>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="297" Column="76" TopLine="277"/>
</Position12>
<Position13>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="328" Column="75" TopLine="311"/>
</Position13>
<Position14>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="641" TopLine="625"/>
</Position14>
<Position15>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="740" Column="10" TopLine="710"/>
</Position15>
<Position16>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="142" Column="30" TopLine="172"/>
</Position16>
<Position17>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="712" Column="61" TopLine="612"/>
</Position17>
<Position18>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="725" Column="41" TopLine="705"/>
</Position18>
<Position19>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="726" Column="20" TopLine="705"/>
</Position19>
<Position20>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="388" Column="34" TopLine="368"/>
</Position20>
<Position21>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="726" Column="20" TopLine="694"/>
</Position21>
<Position22>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="388" TopLine="161"/>
</Position22>
<Position23>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="674" TopLine="649"/>
</Position23>
<Position24>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="79" Column="33" TopLine="70"/>
</Position24>
<Position25>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="203" TopLine="198"/>
</Position25>
<Position26>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="674" TopLine="654"/>
</Position26>
<Position27>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="682" TopLine="654"/>
</Position27>
<Position28>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="683" TopLine="654"/>
</Position28>
<Position29>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="181" Column="6" TopLine="155"/>
</Position29>
<Position30>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="183" Column="63" TopLine="155"/>
</Position30>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0" ActiveMode=""/>
</RunParams>
</ProjectSession>
</CONFIG>

View File

@ -0,0 +1,91 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="OSRExternalPumpBrowser"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="CEF4Delphi_Lazarus"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="OSRExternalPumpBrowser.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="OSRExternalPumpBrowserFrm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="..\..\..\bin\OSRExternalPumpBrowser"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<SyntaxMode Value="Delphi"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL -dUseCthreads"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,78 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 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 © 2018 Salvador Díaz 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 <hgourvest@gmail.com>
* 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.
*
*)
program OSRExternalPumpBrowser;
{$MODE Delphi}
{$I cef.inc}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
cmem,
{$ENDIF}{$ENDIF}
Interfaces, Forms,
uCEFApplication,
uCEFWorkScheduler,
uOSRExternalPumpBrowser in 'uOSRExternalPumpBrowser.pas' {OSRExternalPumpBrowserFrm};
{.$R *.res}
// CEF3 needs to set the LARGEADDRESSAWARE flag which allows 32-bit processes to use up to 3GB of RAM.
{$SetPEFlags $20}
begin
// GlobalCEFApp creation and initialization moved to a different unit to fix the memory leak described in the bug #89
// https://github.com/salvadordf/CEF4Delphi/issues/89
CreateGlobalCEFApp;
if GlobalCEFApp.StartMainProcess then
begin
Application.Initialize;
Application.CreateForm(TOSRExternalPumpBrowserFrm, OSRExternalPumpBrowserFrm);
Application.Run;
// The form needs to be destroyed *BEFORE* stopping the scheduler.
OSRExternalPumpBrowserFrm.Free;
GlobalCEFWorkScheduler.StopScheduler;
end;
DestroyGlobalCEFApp;
DestroyGlobalCEFWorkScheduler;
end.

View File

@ -0,0 +1,202 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="11"/>
<BuildModes Active="Default"/>
<Units Count="12">
<Unit0>
<Filename Value="OSRExternalPumpBrowser.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="39"/>
<CursorPos X="30" Y="66"/>
<UsageCount Value="28"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit0>
<Unit1>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="OSRExternalPumpBrowserFrm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<TopLine Value="67"/>
<CursorPos X="63" Y="108"/>
<UsageCount Value="28"/>
<Bookmarks Count="1">
<Item0 X="72" Y="518" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit1>
<Unit2>
<Filename Value="..\..\..\source\uCEFApplication.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="412"/>
<CursorPos X="39" Y="425"/>
<UsageCount Value="11"/>
</Unit2>
<Unit3>
<Filename Value="..\..\..\source\uCEFInterfaces.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="157"/>
<CursorPos X="100" Y="168"/>
<UsageCount Value="11"/>
</Unit3>
<Unit4>
<Filename Value="C:\lazarus\lcl\lcltype.pp"/>
<UnitName Value="LCLType"/>
<EditorIndex Value="-1"/>
<TopLine Value="59"/>
<CursorPos X="32" Y="68"/>
<UsageCount Value="10"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit4>
<Unit5>
<Filename Value="C:\lazarus\lcl\include\wincontrol.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="5667"/>
<CursorPos Y="5683"/>
<UsageCount Value="10"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit5>
<Unit6>
<Filename Value="..\..\..\source\uCEFMediaObserver.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="266"/>
<CursorPos X="13" Y="86"/>
<UsageCount Value="10"/>
</Unit6>
<Unit7>
<Filename Value="..\..\..\source\uCEFLinkedWindowParent.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="61"/>
<UsageCount Value="10"/>
</Unit7>
<Unit8>
<Filename Value="..\..\..\source\uCEFChromiumCore.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="904"/>
<CursorPos Y="925"/>
<UsageCount Value="10"/>
</Unit8>
<Unit9>
<Filename Value="..\..\..\source\uCEFMediaObserverComponent.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="115"/>
<UsageCount Value="10"/>
</Unit9>
<Unit10>
<Filename Value="..\..\..\..\..\..\..\usr\share\fpcsrc\3.2.0\rtl\wince\windows.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="25"/>
<CursorPos X="5" Y="44"/>
<UsageCount Value="10"/>
</Unit10>
<Unit11>
<Filename Value="..\SimpleOSRBrowser\usimpleosrbrowser.pas"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uSimpleOSRBrowser"/>
<EditorIndex Value="-1"/>
<TopLine Value="150"/>
<CursorPos X="80" Y="175"/>
<UsageCount Value="10"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit11>
</Units>
<JumpHistory Count="21" HistoryIndex="20">
<Position1>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="762" Column="73" TopLine="739"/>
</Position1>
<Position2>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="123" Column="30" TopLine="104"/>
</Position2>
<Position3>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="203" Column="18" TopLine="171"/>
</Position3>
<Position4>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="209" Column="18" TopLine="177"/>
</Position4>
<Position5>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="415" Column="24" TopLine="383"/>
</Position5>
<Position6>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="420" Column="30" TopLine="388"/>
</Position6>
<Position7>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="468" Column="74" TopLine="447"/>
</Position7>
<Position8>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="50" Column="20" TopLine="27"/>
</Position8>
<Position9>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="162" Column="52" TopLine="125"/>
</Position9>
<Position10>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="170" Column="65" TopLine="133"/>
</Position10>
<Position11>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="162" Column="37" TopLine="130"/>
</Position11>
<Position12>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="616" Column="82" TopLine="596"/>
</Position12>
<Position13>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="77" TopLine="58"/>
</Position13>
<Position14>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="668" Column="56" TopLine="651"/>
</Position14>
<Position15>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="127" Column="34" TopLine="109"/>
</Position15>
<Position16>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="595" Column="42" TopLine="573"/>
</Position16>
<Position17>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="115" Column="41" TopLine="100"/>
</Position17>
<Position18>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="641" Column="54" TopLine="614"/>
</Position18>
<Position19>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="121" TopLine="102"/>
</Position19>
<Position20>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="537" TopLine="506"/>
</Position20>
<Position21>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="639" Column="84" TopLine="632"/>
</Position21>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0" ActiveMode=""/>
</RunParams>
</ProjectSession>
</CONFIG>

View File

@ -0,0 +1,143 @@
object OSRExternalPumpBrowserFrm: TOSRExternalPumpBrowserFrm
Left = 293
Height = 584
Top = 210
Width = 913
Caption = 'Initializing browser. Please wait...'
ClientHeight = 584
ClientWidth = 913
Color = clBtnFace
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
OnHide = FormHide
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '2.0.10.0'
object NavControlPnl: TPanel
Left = 0
Height = 21
Top = 0
Width = 913
Align = alTop
BevelOuter = bvNone
ClientHeight = 21
ClientWidth = 913
Enabled = False
TabOrder = 0
object ComboBox1: TComboBox
Left = 0
Height = 21
Top = 0
Width = 844
Align = alClient
ItemHeight = 0
ItemIndex = 0
Items.Strings = (
'https://www.google.com'
'https://html5demos.com/drag'
'https://www.w3schools.com/tags/tryit.asp?filename=tryhtml5_select_form'
'https://www.briskbard.com'
'https://frames-per-second.appspot.com/'
'https://www.youtube.com'
)
OnEnter = ComboBox1Enter
TabOrder = 0
Text = 'https://www.google.com'
end
object Panel2: TPanel
Left = 844
Height = 21
Top = 0
Width = 69
Align = alRight
BevelOuter = bvNone
ClientHeight = 21
ClientWidth = 69
TabOrder = 1
object GoBtn: TButton
Left = 0
Height = 21
Top = 0
Width = 31
Align = alLeft
Caption = 'Go'
OnClick = GoBtnClick
OnEnter = GoBtnEnter
TabOrder = 0
end
object SnapshotBtn: TButton
Left = 38
Height = 21
Hint = 'Take snapshot'
Top = 0
Width = 31
Align = alRight
Caption = 'µ'
Font.CharSet = SYMBOL_CHARSET
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'Webdings'
OnClick = SnapshotBtnClick
OnEnter = SnapshotBtnEnter
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 1
end
end
end
object Panel1: TBufferPanel
Left = 0
Height = 563
Top = 21
Width = 913
Align = alClient
OnUTF8KeyPress = Panel1UTF8KeyPress
Caption = 'Panel1'
TabOrder = 1
TabStop = True
OnClick = Panel1Click
OnEnter = Panel1Enter
OnExit = Panel1Exit
OnMouseDown = Panel1MouseDown
OnMouseMove = Panel1MouseMove
OnMouseUp = Panel1MouseUp
OnMouseWheel = Panel1MouseWheel
OnKeyDown = Panel1KeyDown
OnKeyUp = Panel1KeyUp
OnResize = Panel1Resize
end
object chrmosr: TChromium
OnTooltip = chrmosrTooltip
OnCursorChange = chrmosrCursorChange
OnBeforePopup = chrmosrBeforePopup
OnAfterCreated = chrmosrAfterCreated
OnBeforeClose = chrmosrBeforeClose
OnGetViewRect = chrmosrGetViewRect
OnGetScreenPoint = chrmosrGetScreenPoint
OnGetScreenInfo = chrmosrGetScreenInfo
OnPopupShow = chrmosrPopupShow
OnPopupSize = chrmosrPopupSize
OnPaint = chrmosrPaint
Left = 24
Top = 56
end
object SaveDialog1: TSaveDialog
Title = 'Save snapshot'
DefaultExt = '.bmp'
Filter = 'Bitmap files (*.bmp)|*.BMP'
Left = 24
Top = 278
end
object Timer1: TTimer
Enabled = False
Interval = 300
OnTimer = Timer1Timer
Left = 24
Top = 206
end
end

View File

@ -0,0 +1,732 @@
// ************************************************************************
// ***************************** 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 © 2020 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 <hgourvest@gmail.com>
* 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 uOSRExternalPumpBrowser;
{$MODE OBJFPC}{$H+}
{$I cef.inc}
interface
uses
Classes, SysUtils, LCLType, Variants, SyncObjs, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, Types,
uCEFChromium, uCEFTypes, uCEFInterfaces, uCEFConstants, uCEFBufferPanel,
uCEFWorkScheduler;
type
{ TOSRExternalPumpBrowserFrm }
TOSRExternalPumpBrowserFrm = class(TForm)
NavControlPnl: TPanel;
chrmosr: TChromium;
ComboBox1: TComboBox;
Panel2: TPanel;
GoBtn: TButton;
SnapshotBtn: TButton;
SaveDialog1: TSaveDialog;
Timer1: TTimer;
Panel1: TBufferPanel;
procedure GoBtnClick(Sender: TObject);
procedure GoBtnEnter(Sender: TObject);
procedure Panel1Enter(Sender: TObject);
procedure Panel1Exit(Sender: TObject);
procedure Panel1Resize(Sender: TObject);
procedure Panel1Click(Sender: TObject);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure Panel1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Panel1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Panel1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure chrmosrPaint(Sender: TObject; const browser: ICefBrowser; kind: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; aWidth, aHeight: Integer);
procedure chrmosrCursorChange(Sender: TObject; const browser: ICefBrowser; aCursor: HICON; cursorType: TCefCursorType; const customCursorInfo: PCefCursorInfo; var aResult : boolean);
procedure chrmosrGetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect);
procedure chrmosrGetScreenPoint(Sender: TObject; const browser: ICefBrowser; viewX, viewY: Integer; var screenX, screenY: Integer; out Result: Boolean);
procedure chrmosrGetScreenInfo(Sender: TObject; const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out Result: Boolean);
procedure chrmosrPopupShow(Sender: TObject; const browser: ICefBrowser; aShow: Boolean);
procedure chrmosrPopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect);
procedure chrmosrAfterCreated(Sender: TObject; const browser: ICefBrowser);
procedure chrmosrTooltip(Sender: TObject; const browser: ICefBrowser; var aText: ustring; out Result: Boolean);
procedure chrmosrBeforePopup(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 chrmosrBeforeClose(Sender: TObject; const browser: ICefBrowser);
procedure SnapshotBtnClick(Sender: TObject);
procedure SnapshotBtnEnter(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure ComboBox1Enter(Sender: TObject);
protected
FbFirst : boolean;
FPopUpBitmap : TBitmap;
FPopUpRect : TRect;
FShowPopUp : boolean;
FResizing : boolean;
FPendingResize : boolean;
FCanClose : boolean;
FClosing : boolean;
FResizeCS : TCriticalSection;
function SendCompMessage(aMsg : cardinal) : boolean;
function getModifiers(Shift: TShiftState): TCefEventFlags;
function GetButton(Button: TMouseButton): TCefMouseButtonType;
procedure DoResize;
procedure BrowserCreated(Data: PtrInt);
procedure BrowserCloseForm(Data: PtrInt);
procedure PendingResize(Data: PtrInt);
procedure PendingInvalidate(Data: PtrInt);
public
{ Public declarations }
end;
var
OSRExternalPumpBrowserFrm : TOSRExternalPumpBrowserFrm;
// This is a simple browser in OSR mode (off-screen rendering).
// It was necessary to destroy the browser following the destruction sequence described in
// the MDIBrowser demo but in OSR mode there are some modifications.
// This is the destruction sequence in OSR mode :
// 1- FormCloseQuery sets CanClose to the initial FCanClose value (False) and calls chrmosr.CloseBrowser(True).
// 2- chrmosr.CloseBrowser(True) will trigger chrmosr.OnClose and we have to
// set "Result" to false and CEF will destroy the internal browser immediately.
// 3- chrmosr.OnBeforeClose is triggered because the internal browser was destroyed.
// FCanClose is set to True and sends WM_CLOSE to the form.
procedure CreateGlobalCEFApp;
procedure GlobalCEFApp_OnScheduleMessagePumpWork(const aDelayMS : int64);
implementation
{$R *.lfm}
uses
Math,
uCEFMiscFunctions, uCEFApplication;
procedure GlobalCEFApp_OnScheduleMessagePumpWork(const aDelayMS : int64);
begin
if (GlobalCEFWorkScheduler <> nil) then
GlobalCEFWorkScheduler.ScheduleMessagePumpWork(aDelayMS);
end;
procedure CreateGlobalCEFApp;
var
TempHome, TempBinDir : ustring;
begin
TempHome := IncludeTrailingPathDelimiter(GetEnvironmentVariable('HOME'));
TempBinDir := TempHome + 'Lazarus/CEF4Delphi/bin';
// TCEFWorkScheduler will call cef_do_message_loop_work when
// it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event.
// GlobalCEFWorkScheduler needs to be created before the
// GlobalCEFApp.StartMainProcess call.
GlobalCEFWorkScheduler := TCEFWorkScheduler.Create(nil);
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
GlobalCEFApp.ExternalMessagePump := True;
GlobalCEFApp.MultiThreadedMessageLoop := False;
GlobalCEFApp.OnScheduleMessagePumpWork := @GlobalCEFApp_OnScheduleMessagePumpWork;
GlobalCEFApp.SetCurrentDir := True;
if DirectoryExists(TempBinDir) then
begin
GlobalCEFApp.FrameworkDirPath := TempBinDir;
GlobalCEFApp.ResourcesDirPath := TempBinDir;
GlobalCEFApp.LocalesDirPath := TempBinDir + '/locales';
end;
// Add a debug log in the BIN directory
GlobalCEFApp.LogFile := 'cef.log';
GlobalCEFApp.LogSeverity := LOGSEVERITY_VERBOSE;
end;
procedure TOSRExternalPumpBrowserFrm.GoBtnClick(Sender: TObject);
begin
FResizeCS.Acquire;
FResizing := False;
FPendingResize := False;
FResizeCS.Release;
chrmosr.LoadURL(ComboBox1.Text);
end;
procedure TOSRExternalPumpBrowserFrm.GoBtnEnter(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrAfterCreated(Sender: TObject; const browser: ICefBrowser);
begin
SendCompMessage(CEF_AFTERCREATED);
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrBeforeClose(Sender: TObject; const browser: ICefBrowser);
begin
FCanClose := True;
SendCompMessage(CEF_BEFORECLOSE);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
var
TempKeyEvent : TCefKeyEvent;
TempString : UnicodeString;
begin
if Panel1.Focused then
begin
TempString := UTF8Decode(UTF8Key);
if (length(TempString) > 0) then
begin
TempKeyEvent.kind := KEYEVENT_CHAR;
TempKeyEvent.modifiers := EVENTFLAG_NONE;
TempKeyEvent.windows_key_code := ord(TempString[1]);
TempKeyEvent.native_key_code := 0;
TempKeyEvent.is_system_key := ord(False);
TempKeyEvent.character := #0;
TempKeyEvent.unmodified_character := #0;
TempKeyEvent.focus_on_editable_field := ord(False);
chrmosr.SendKeyEvent(@TempKeyEvent);
end;
end;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrBeforePopup(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);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrCursorChange(Sender : TObject;
const browser : ICefBrowser;
aCursor : HICON;
cursorType : TCefCursorType;
const customCursorInfo : PCefCursorInfo;
var aResult : boolean);
begin
Panel1.Cursor := CefCursorToWindowsCursor(cursorType);
aResult := True;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrGetScreenInfo(Sender : TObject;
const browser : ICefBrowser;
var screenInfo : TCefScreenInfo;
out Result : Boolean);
var
TempRect : TCEFRect;
TempScale : single;
begin
TempScale := Panel1.ScreenScale;
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(Panel1.Width, TempScale);
TempRect.height := DeviceToLogical(Panel1.Height, TempScale);
screenInfo.device_scale_factor := TempScale;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
Result := True;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrGetScreenPoint(Sender: TObject;
const browser: ICefBrowser; viewX, viewY: Integer; var screenX,
screenY: Integer; out Result: Boolean);
var
TempScreenPt, TempViewPt : TPoint;
TempScale : single;
begin
TempScale := Panel1.ScreenScale;
TempViewPt.x := LogicalToDevice(viewX, TempScale);
TempViewPt.y := LogicalToDevice(viewY, TempScale);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrGetViewRect(Sender : TObject;
const browser : ICefBrowser;
var rect : TCefRect);
var
TempScale : single;
begin
TempScale := Panel1.ScreenScale;
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(Panel1.Width, TempScale);
rect.height := DeviceToLogical(Panel1.Height, TempScale);
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrPaint(Sender: TObject; const browser: ICefBrowser;
kind: TCefPaintElementType; dirtyRectsCount: NativeUInt;
const dirtyRects: PCefRectArray; const buffer: Pointer; aWidth,
aHeight: Integer);
var
src, dst: PByte;
i, j, TempLineSize, TempSrcOffset, TempDstOffset, SrcStride : Integer;
n : NativeUInt;
TempWidth, TempHeight : integer;
TempBufferBits : Pointer;
TempForcedResize : boolean;
TempBitmap : TBitmap;
TempSrcRect : TRect;
begin
try
FResizeCS.Acquire;
TempForcedResize := False;
if Panel1.BeginBufferDraw then
begin
if (kind = PET_POPUP) then
begin
if (FPopUpBitmap = nil) or
(aWidth <> FPopUpBitmap.Width) or
(aHeight <> FPopUpBitmap.Height) then
begin
if (FPopUpBitmap <> nil) then FPopUpBitmap.Free;
FPopUpBitmap := TBitmap.Create;
FPopUpBitmap.PixelFormat := pf32bit;
FPopUpBitmap.HandleType := bmDIB;
FPopUpBitmap.Width := aWidth;
FPopUpBitmap.Height := aHeight;
end;
TempBitmap := FPopUpBitmap;
TempBitmap.BeginUpdate;
TempWidth := FPopUpBitmap.Width;
TempHeight := FPopUpBitmap.Height;
end
else
begin
TempForcedResize := Panel1.UpdateBufferDimensions(aWidth, aHeight) or not(Panel1.BufferIsResized(False));
TempBitmap := Panel1.Buffer;
TempBitmap.BeginUpdate;
TempWidth := Panel1.BufferWidth;
TempHeight := Panel1.BufferHeight;
end;
SrcStride := aWidth * SizeOf(TRGBQuad);
n := 0;
while (n < dirtyRectsCount) do
begin
if (dirtyRects^[n].x >= 0) and (dirtyRects^[n].y >= 0) then
begin
TempLineSize := min(dirtyRects^[n].width, TempWidth - dirtyRects^[n].x) * SizeOf(TRGBQuad);
if (TempLineSize > 0) then
begin
TempSrcOffset := ((dirtyRects^[n].y * aWidth) + dirtyRects^[n].x) * SizeOf(TRGBQuad);
TempDstOffset := (dirtyRects^[n].x * SizeOf(TRGBQuad));
src := @PByte(buffer)[TempSrcOffset];
i := 0;
j := min(dirtyRects^[n].height, TempHeight - dirtyRects^[n].y);
while (i < j) do
begin
TempBufferBits := TempBitmap.Scanline[dirtyRects^[n].y + i];
dst := @PByte(TempBufferBits)[TempDstOffset];
Move(src^, dst^, TempLineSize);
Inc(src, SrcStride);
inc(i);
end;
end;
end;
inc(n);
end;
TempBitmap.EndUpdate;
if FShowPopup and (FPopUpBitmap <> nil) then
begin
TempSrcRect := Rect(0, 0,
min(FPopUpRect.Right - FPopUpRect.Left, FPopUpBitmap.Width),
min(FPopUpRect.Bottom - FPopUpRect.Top, FPopUpBitmap.Height));
Panel1.BufferDraw(FPopUpBitmap, TempSrcRect, FPopUpRect);
end;
Panel1.EndBufferDraw;
SendCompMessage(CEF_PENDINGINVALIDATE);
if (kind = PET_VIEW) then
begin
if TempForcedResize or FPendingResize then
SendCompMessage(CEF_PENDINGRESIZE);
FResizing := False;
FPendingResize := False;
end;
end;
finally
FResizeCS.Release;
end;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrPopupShow(Sender : TObject;
const browser : ICefBrowser;
aShow : Boolean);
begin
if aShow then
FShowPopUp := True
else
begin
FShowPopUp := False;
FPopUpRect := rect(0, 0, 0, 0);
if (chrmosr <> nil) then chrmosr.Invalidate(PET_VIEW);
end;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrPopupSize(Sender : TObject;
const browser : ICefBrowser;
const rect : PCefRect);
begin
LogicalToDevice(rect^, Panel1.ScreenScale);
FPopUpRect.Left := rect^.x;
FPopUpRect.Top := rect^.y;
FPopUpRect.Right := rect^.x + rect^.width - 1;
FPopUpRect.Bottom := rect^.y + rect^.height - 1;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrTooltip(Sender: TObject; const browser: ICefBrowser; var aText: ustring; out Result: Boolean);
begin
Panel1.hint := aText;
Panel1.ShowHint := (length(aText) > 0);
Result := True;
end;
procedure TOSRExternalPumpBrowserFrm.ComboBox1Enter(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
end;
function TOSRExternalPumpBrowserFrm.SendCompMessage(aMsg : cardinal) : boolean;
begin
case aMsg of
CEF_AFTERCREATED : Application.QueueAsyncCall(@BrowserCreated, 0);
CEF_BEFORECLOSE : Application.QueueAsyncCall(@BrowserCloseForm, 0);
CEF_PENDINGRESIZE : Application.QueueAsyncCall(@PendingResize, 0);
CEF_PENDINGINVALIDATE : Application.QueueAsyncCall(@PendingInvalidate, 0);
end;
end;
function TOSRExternalPumpBrowserFrm.getModifiers(Shift: TShiftState): TCefEventFlags;
begin
Result := EVENTFLAG_NONE;
if (ssShift in Shift) then Result := Result or EVENTFLAG_SHIFT_DOWN;
if (ssAlt in Shift) then Result := Result or EVENTFLAG_ALT_DOWN;
if (ssCtrl in Shift) then Result := Result or EVENTFLAG_CONTROL_DOWN;
if (ssLeft in Shift) then Result := Result or EVENTFLAG_LEFT_MOUSE_BUTTON;
if (ssRight in Shift) then Result := Result or EVENTFLAG_RIGHT_MOUSE_BUTTON;
if (ssMiddle in Shift) then Result := Result or EVENTFLAG_MIDDLE_MOUSE_BUTTON;
end;
function TOSRExternalPumpBrowserFrm.GetButton(Button: TMouseButton): TCefMouseButtonType;
begin
case Button of
TMouseButton.mbRight : Result := MBT_RIGHT;
TMouseButton.mbMiddle : Result := MBT_MIDDLE;
else Result := MBT_LEFT;
end;
end;
procedure TOSRExternalPumpBrowserFrm.BrowserCreated(Data: PtrInt);
begin
Caption := 'Simple Lazarus OSR Browser';
NavControlPnl.Enabled := True;
end;
procedure TOSRExternalPumpBrowserFrm.BrowserCloseForm(Data: PtrInt);
begin
Close;
end;
procedure TOSRExternalPumpBrowserFrm.PendingResize(Data: PtrInt);
begin
DoResize;
end;
procedure TOSRExternalPumpBrowserFrm.PendingInvalidate(Data: PtrInt);
begin
Panel1.Invalidate;
end;
procedure TOSRExternalPumpBrowserFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := FCanClose;
if not(FClosing) then
begin
FClosing := True;
Visible := False;
chrmosr.CloseBrowser(True);
end;
end;
procedure TOSRExternalPumpBrowserFrm.FormCreate(Sender: TObject);
begin
FbFirst := False;
FPopUpBitmap := nil;
FPopUpRect := rect(0, 0, 0, 0);
FShowPopUp := False;
FResizing := False;
FPendingResize := False;
FCanClose := False;
FClosing := False;
FResizeCS := TCriticalSection.Create;
end;
procedure TOSRExternalPumpBrowserFrm.FormDestroy(Sender: TObject);
begin
if (FPopUpBitmap <> nil) then FreeAndNil(FPopUpBitmap);
if (FResizeCS <> nil) then FreeAndNil(FResizeCS);
end;
procedure TOSRExternalPumpBrowserFrm.FormHide(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
chrmosr.WasHidden(True);
end;
procedure TOSRExternalPumpBrowserFrm.FormShow(Sender: TObject);
begin
if chrmosr.Initialized then
begin
chrmosr.WasHidden(False);
chrmosr.SendFocusEvent(True);
end
else
begin
// opaque white background color
chrmosr.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF);
chrmosr.DefaultURL := ComboBox1.Text;
if not(chrmosr.CreateBrowser(nil, '')) then
Timer1.Enabled := True;
end;
end;
procedure TOSRExternalPumpBrowserFrm.Panel1Click(Sender: TObject);
begin
Panel1.SetFocus;
end;
procedure TOSRExternalPumpBrowserFrm.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
TempEvent : TCefMouseEvent;
begin
Panel1.SetFocus;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, 1);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
TempEvent : TCefMouseEvent;
begin
TempEvent.x := x;
TempEvent.y := y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
TempEvent : TCefMouseEvent;
begin
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, 1);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1Resize(Sender: TObject);
begin
DoResize;
end;
procedure TOSRExternalPumpBrowserFrm.DoResize;
begin
try
FResizeCS.Acquire;
if FResizing then
FPendingResize := True
else
if Panel1.BufferIsResized then
chrmosr.Invalidate(PET_VIEW)
else
begin
FResizing := True;
chrmosr.WasResized;
end;
finally
FResizeCS.Release;
end;
end;
procedure TOSRExternalPumpBrowserFrm.Panel1Enter(Sender: TObject);
begin
chrmosr.SendFocusEvent(True);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1Exit(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
TempKeyEvent : TCefKeyEvent;
begin
if (Key <> 0) and (chrmosr <> nil) then
begin
TempKeyEvent.kind := KEYEVENT_RAWKEYDOWN;
TempKeyEvent.modifiers := getModifiers(Shift);
TempKeyEvent.windows_key_code := Key;
TempKeyEvent.native_key_code := 0;
TempKeyEvent.is_system_key := ord(False);
TempKeyEvent.character := #0;
TempKeyEvent.unmodified_character := #0;
TempKeyEvent.focus_on_editable_field := ord(False);
chrmosr.SendKeyEvent(@TempKeyEvent);
if (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_TAB]) then Key := 0;
end;
end;
procedure TOSRExternalPumpBrowserFrm.Panel1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
TempKeyEvent : TCefKeyEvent;
begin
if (Key <> 0) and (chrmosr <> nil) then
begin
TempKeyEvent.kind := KEYEVENT_KEYUP;
TempKeyEvent.modifiers := getModifiers(Shift);
TempKeyEvent.windows_key_code := Key;
TempKeyEvent.native_key_code := 0;
TempKeyEvent.is_system_key := ord(False);
TempKeyEvent.character := #0;
TempKeyEvent.unmodified_character := #0;
TempKeyEvent.focus_on_editable_field := ord(False);
chrmosr.SendKeyEvent(@TempKeyEvent);
end;
end;
procedure TOSRExternalPumpBrowserFrm.Panel1MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
TempEvent : TCefMouseEvent;
begin
TempEvent.x := MousePos.x;
TempEvent.y := MousePos.y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseWheelEvent(@TempEvent, 0, WheelDelta);
end;
procedure TOSRExternalPumpBrowserFrm.SnapshotBtnClick(Sender: TObject);
begin
if SaveDialog1.Execute then Panel1.SaveToFile(SaveDialog1.FileName);
end;
procedure TOSRExternalPumpBrowserFrm.SnapshotBtnEnter(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
end;
procedure TOSRExternalPumpBrowserFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(chrmosr.CreateBrowser(nil, '')) and
not(chrmosr.Initialized) then
Timer1.Enabled := True;
end;
end.

View File

Before

Width:  |  Height:  |  Size: 134 KiB

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -51,7 +51,7 @@
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="../../../../bin/SimpleBrowser2"/>
<Filename Value="../../../bin/SimpleBrowser2"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>

View File

@ -42,6 +42,7 @@ program SimpleBrowser2;
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
cmem,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, uSimpleBrowser2,

View File

@ -8,8 +8,8 @@
<Filename Value="SimpleBrowser2.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="34"/>
<CursorPos Y="56"/>
<TopLine Value="27"/>
<CursorPos X="49" Y="58"/>
<UsageCount Value="22"/>
<Loaded Value="True"/>
</Unit0>
@ -22,7 +22,7 @@
<UnitName Value="uSimpleBrowser2"/>
<IsVisibleTab Value="True"/>
<TopLine Value="122"/>
<CursorPos X="30" Y="139"/>
<CursorPos X="66" Y="149"/>
<UsageCount Value="22"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>

View File

Before

Width:  |  Height:  |  Size: 134 KiB

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -51,7 +51,7 @@
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="../../../../bin/SimpleOSRBrowser"/>
<Filename Value="../../../bin/SimpleOSRBrowser"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>

View File

@ -42,6 +42,7 @@ program SimpleOSRBrowser;
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
cmem,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, uSimpleOSRBrowser,

View File

@ -0,0 +1,86 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="11"/>
<BuildModes Active="Default"/>
<Units Count="6">
<Unit0>
<Filename Value="SimpleOSRBrowser.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="13"/>
<CursorPos X="8" Y="45"/>
<UsageCount Value="23"/>
</Unit0>
<Unit1>
<Filename Value="usimpleosrbrowser.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uSimpleOSRBrowser"/>
<IsVisibleTab Value="True"/>
<TopLine Value="165"/>
<CursorPos X="32" Y="726"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="/usr/share/lazarus/2.0.6/lcl/lcltype.pp"/>
<UnitName Value="LCLType"/>
<EditorIndex Value="-1"/>
<TopLine Value="52"/>
<CursorPos X="3" Y="68"/>
<UsageCount Value="10"/>
</Unit2>
<Unit3>
<Filename Value="../../../../source/uCEFMiscFunctions.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="1889"/>
<CursorPos X="27" Y="1907"/>
<UsageCount Value="10"/>
</Unit3>
<Unit4>
<Filename Value="../../../../source/uCEFApplicationCore.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="432"/>
<CursorPos X="29" Y="445"/>
<UsageCount Value="10"/>
</Unit4>
<Unit5>
<Filename Value="/usr/share/fpcsrc/3.2.0/rtl/objpas/sysutils/finah.inc"/>
<EditorIndex Value="-1"/>
<CursorPos X="10" Y="33"/>
<UsageCount Value="10"/>
</Unit5>
</Units>
<JumpHistory Count="5" HistoryIndex="4">
<Position1>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="137" Column="44" TopLine="124"/>
</Position1>
<Position2>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="138" Column="30" TopLine="124"/>
</Position2>
<Position3>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="389" Column="18" TopLine="360"/>
</Position3>
<Position4>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="575" Column="48" TopLine="555"/>
</Position4>
<Position5>
<Filename Value="usimpleosrbrowser.pas"/>
<Caret Line="581" Column="30" TopLine="555"/>
</Position5>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0" ActiveMode=""/>
</RunParams>
</ProjectSession>
</CONFIG>

View File

@ -0,0 +1,88 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="TinyBrowser2"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="CEF4Delphi_Lazarus"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="TinyBrowser2.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="uTinyBrowser2.pas"/>
<IsPartOfProject Value="True"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="..\..\..\bin\TinyBrowser2"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<SyntaxMode Value="Delphi"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL -dUseCthreads"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,68 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 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 © 2018 Salvador Díaz 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 <hgourvest@gmail.com>
* 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.
*
*)
program TinyBrowser2;
{$MODE Delphi}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
cmem,
{$ENDIF}{$ENDIF}
Interfaces,
uCEFApplication,
uTinyBrowser2 in 'uTinyBrowser2.pas';
{.$R *.res}
{$IFDEF WIN32}
// CEF needs to set the LARGEADDRESSAWARE ($20) flag which allows 32-bit processes to use up to 3GB of RAM.
{$SetPEFlags $20}
{$ENDIF}
begin
CreateGlobalCEFApp;
if GlobalCEFApp.StartMainProcess then
begin
GlobalCEFApp.RunMessageLoop;
DestroyTinyBrowser;
end;
DestroyGlobalCEFApp;
end.

View File

@ -0,0 +1,57 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="11"/>
<BuildModes Active="Default"/>
<Units Count="5">
<Unit0>
<Filename Value="TinyBrowser2.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="28"/>
<CursorPos X="36" Y="66"/>
<UsageCount Value="21"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit0>
<Unit1>
<Filename Value="uTinyBrowser2.pas"/>
<IsPartOfProject Value="True"/>
<IsVisibleTab Value="True"/>
<TopLine Value="83"/>
<CursorPos X="86" Y="108"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit1>
<Unit2>
<Filename Value="..\..\..\source\uCEFChromiumCore.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="46"/>
<CursorPos X="95" Y="60"/>
<UsageCount Value="10"/>
</Unit2>
<Unit3>
<Filename Value="..\..\..\..\source\cef.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="22"/>
<CursorPos Y="43"/>
<UsageCount Value="10"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit3>
<Unit4>
<Filename Value="..\..\..\..\source\uCEFApplicationCore.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="2207"/>
<CursorPos Y="2239"/>
<UsageCount Value="10"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit4>
</Units>
<JumpHistory HistoryIndex="-1"/>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0" ActiveMode=""/>
</RunParams>
</ProjectSession>
</CONFIG>

View File

@ -0,0 +1,193 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 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 © 2018 Salvador Díaz 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 <hgourvest@gmail.com>
* 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 uTinyBrowser2;
{$MODE Delphi}
interface
uses
SysUtils,
uCEFInterfaces, uCEFTypes, uCEFChromiumCore;
type
TTinyBrowser2 = class
private
FChromium : TChromiumCore;
procedure Chromium_OnClose(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
procedure Chromium_OnBeforeClose(Sender: TObject; const browser: ICefBrowser);
procedure Chromium_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 Chromium_OnOpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; out Result: Boolean);
public
constructor Create;
destructor Destroy; override;
procedure AfterConstruction; override;
end;
procedure CreateGlobalCEFApp;
procedure DestroyTinyBrowser;
implementation
// This demo is similar to the cefsimple demo in the official CEF project.
// It doesn't use LCL to create forms from Lazarus code.
// It just uses CEF to create a browser window as if it was a popup browser window.
// This browser doesn't use multiple threads to handle the browser and it doesn't use an external message pump.
// For this reason we have to call GlobalCEFApp.RunMessageLoop to let CEF handle the message loop and
// GlobalCEFApp.QuitMessageLoop when the browser has been destroyed.
// The destruction steps are much simpler for that reason.
// In this demo it's only necessary to implement the TChromium.OnClose and TChromium.OnBeforeClose events.
// The TChromium.OnClose event only sets aAction to cbaClose to continue closing the browser.
// The TChromium.OnBeforeClose event calls GlobalCEFApp.QuitMessageLoop because the browser has been destroyed
// and it's necessary to close the message loop.
uses
uCEFApplication, uCEFConstants;
var
TinyBrowser : TTinyBrowser2 = nil;
procedure GlobalCEFApp_OnContextInitialized;
begin
TinyBrowser := TTinyBrowser2.Create;
end;
procedure CreateGlobalCEFApp;
var
TempHome, TempBinDir : ustring;
begin
TempHome := IncludeTrailingPathDelimiter(GetEnvironmentVariable('HOME'));
TempBinDir := TempHome + 'Lazarus/CEF4Delphi/bin';
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.MultiThreadedMessageLoop := False;
GlobalCEFApp.ExternalMessagePump := False;
GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized;
GlobalCEFApp.SetCurrentDir := True;
// This is a workaround for the CEF4Delphi issue #324 :
// https://github.com/salvadordf/CEF4Delphi/issues/324
GlobalCEFApp.DisableFeatures := 'WinUseBrowserSpellChecker';
if DirectoryExists(TempBinDir) then
begin
GlobalCEFApp.FrameworkDirPath := TempBinDir;
GlobalCEFApp.ResourcesDirPath := TempBinDir;
GlobalCEFApp.LocalesDirPath := TempBinDir + '/locales';
end;
// Add a debug log in the BIN directory
GlobalCEFApp.LogFile := 'cef.log';
GlobalCEFApp.LogSeverity := LOGSEVERITY_VERBOSE;
end;
procedure DestroyTinyBrowser;
begin
if (TinyBrowser <> nil) then
begin
TinyBrowser.Free;
TinyBrowser := nil;
end;
end;
constructor TTinyBrowser2.Create;
begin
inherited Create;
FChromium := nil;
end;
destructor TTinyBrowser2.Destroy;
begin
if (FChromium <> nil) then
begin
FChromium.Free;
FChromium := nil;
end;
inherited Destroy;
end;
procedure TTinyBrowser2.AfterConstruction;
begin
inherited AfterConstruction;
FChromium := TChromiumCore.Create(nil);
FChromium.DefaultURL := 'https://www.google.com';
FChromium.OnClose := Chromium_OnClose;
FChromium.OnBeforeClose := Chromium_OnBeforeClose;
FChromium.OnBeforePopup := Chromium_OnBeforePopup;
FChromium.OnOpenUrlFromTab := Chromium_OnOpenUrlFromTab;
FChromium.CreateBrowser('Tiny Browser 2');
end;
procedure TTinyBrowser2.Chromium_OnClose(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
begin
aAction := cbaClose;
end;
procedure TTinyBrowser2.Chromium_OnBeforeClose(Sender: TObject; const browser: ICefBrowser);
begin
GlobalCEFApp.QuitMessageLoop;
end;
procedure TTinyBrowser2.Chromium_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);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TTinyBrowser2.Chromium_OnOpenUrlFromTab(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition;
userGesture: Boolean; out Result: Boolean);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
end.

View File

@ -0,0 +1,85 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="ConsoleBrowser2"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="CEF4Delphi_Lazarus"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="3">
<Unit0>
<Filename Value="ConsoleBrowser2.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="uEncapsulatedBrowser.pas"/>
<IsPartOfProject Value="True"/>
</Unit1>
<Unit2>
<Filename Value="uCEFBrowserThread.pas"/>
<IsPartOfProject Value="True"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="..\..\..\bin\ConsoleBrowser2"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<SyntaxMode Value="Delphi"/>
</SyntaxOptions>
</Parsing>
<Other>
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,111 @@
// ************************************************************************
// ***************************** 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 © 2020 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 <hgourvest@gmail.com>
* 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.
*
*)
program ConsoleBrowser2;
{$MODE Delphi}
{$APPTYPE CONSOLE}
{.$R *.res}
uses
SysUtils, Interfaces,
uCEFApplication,
uEncapsulatedBrowser in 'uEncapsulatedBrowser.pas',
uCEFBrowserThread in 'uCEFBrowserThread.pas';
{$IFDEF WIN32}
// CEF3 needs to set the LARGEADDRESSAWARE ($20) flag which allows 32-bit processes to use up to 3GB of RAM.
{$SetPEFlags $20}
{$ENDIF}
// This demo navigates to a webpage, captures the browser screen and saves it as a bitmap file called "snapshot.bmp"
// ConsoleBrowser2 is a console application without a user interface. For this reason the browser is in
// "off-screen mode" (OSR mode), it's encamsulated in a custom thread and it uses a different EXE for the
// CEF subprocesses (ConsoleBrowser2_sp.exe).
// In order to test this demo you need to build the "ConsoleBrowser2_sp.lpr" project too !!!
// While the custom browser thread is loading the webpage and capturing the screen, the console application is
// waiting for an Event.
// ConsoleBrowser2 reads the "/url" parameter and uses that URL to navigate and capture the screen.
// For example : ConsoleBrowser2.exe /url=https://www.briskbard.com
// If you need to debug this demo in Lazarus using http://www.example.com click on the "Run->Run Parameters" menu option,
// and type "/url=http://www.example.com" (without quotes) in the "Command line parameters" box.
// By default the browser uses a virtual screen size of 1024x728 with 96 DPI (screen scale = 1)
// If you need a different resolution or scale just edit those values in TEncapsulatedBrowser.Create
// or add new command line switches with the new information.
// The browser captures the screen when the main frame is loaded but some web pages need some extra time to finish.
// This demo uses a 500 ms delay to avoid this problem and you can modify this value in TEncapsulatedBrowser.Create
// CEF is configured in this demo to use "in memory" cache. As a result of this, the browser will always download
// all the web page resources. Remember that if you switch to a local directory for the cache you will have problems
// when you run several instances of this demo at the same time because Chromium doesn't allow sharing the same cache
// by different processes.
// This demo is configured to load the CEF binaries in the same directory were ConsoleBrowser2.exe is located but you
// can set a different directory for the binaries by setting the GlobalCEFApp.FrameworkDirPath,
// GlobalCEFApp.ResourcesDirPath and GlobalCEFApp.LocalesDirPath properties inside CreateGlobalCEFApp.
// See the SimpleBrowser2 demo for more details.
// CEF is configured to use ConsoleBrowser2_sp.exe for the subprocesses and it tries to find it in the same directory as
// ConsoleBrowser2.exe but it's possible to use a different location for that EXE if you set a custom path in
// GlobalCEFApp.BrowserSubprocessPath.
// Most of the GlobalCEFApp properties must be the same in the main EXE and the EXE for the subprocesses. If you modify
// them in CreateGlobalCEFApp then you'll also have to copy those property values in ConsoleBrowser2_sp.dpr
// See the "SubProcess" demo for more details.
begin
try
try
CreateGlobalCEFApp;
if WaitForMainAppEvent then
WriteResult;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
finally
DestroyGlobalCEFApp;
end;
end.

View File

@ -0,0 +1,60 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="11"/>
<BuildModes Active="Default"/>
<Units Count="5">
<Unit0>
<Filename Value="ConsoleBrowser2.lpr"/>
<IsPartOfProject Value="True"/>
<IsVisibleTab Value="True"/>
<TopLine Value="37"/>
<CursorPos X="101" Y="71"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit0>
<Unit1>
<Filename Value="uEncapsulatedBrowser.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="203"/>
<CursorPos X="31" Y="225"/>
<UsageCount Value="20"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit1>
<Unit2>
<Filename Value="uCEFBrowserThread.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="86"/>
<CursorPos Y="98"/>
<UsageCount Value="20"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit2>
<Unit3>
<Filename Value="..\WebpageSnapshot\uCEFBrowserThread.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="421"/>
<CursorPos X="31" Y="445"/>
<UsageCount Value="10"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit3>
<Unit4>
<Filename Value="C:\lazarus\fpc\3.2.0\source\packages\fcl-base\src\syncobjs.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="64"/>
<CursorPos X="16" Y="80"/>
<UsageCount Value="10"/>
</Unit4>
</Units>
<JumpHistory HistoryIndex="-1"/>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="1" ActiveMode="default">
<Mode0 Name="default"/>
</Modes>
</RunParams>
</ProjectSession>
</CONFIG>

View File

@ -0,0 +1,84 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="ConsoleBrowser2_sp"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="CEF4Delphi_Lazarus"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="1">
<Unit0>
<Filename Value="ConsoleBrowser2_sp.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="..\..\..\bin\ConsoleBrowser2_sp"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<SyntaxMode Value="Delphi"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,61 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 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 © 2018 Salvador Díaz 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 <hgourvest@gmail.com>
* 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.
*
*)
program ConsoleBrowser2_sp;
{$MODE Delphi}
{$I cef.inc}
uses
uCEFApplicationCore;
{$IFDEF WIN32}
// CEF3 needs to set the LARGEADDRESSAWARE ($20) flag which allows 32-bit processes to use up to 3GB of RAM.
{$SetPEFlags $20}
{$ENDIF}
begin
GlobalCEFApp := TCefApplicationCore.Create;
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
GlobalCEFApp.ShowMessageDlg := False;
GlobalCEFApp.BlinkSettings := 'hideScrollbars';
GlobalCEFApp.StartSubProcess;
DestroyGlobalCEFApp;
end.

View File

@ -0,0 +1,23 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="11"/>
<BuildModes Active="Default"/>
<Units Count="1">
<Unit0>
<Filename Value="ConsoleBrowser2_sp.lpr"/>
<IsPartOfProject Value="True"/>
<IsVisibleTab Value="True"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit0>
</Units>
<JumpHistory HistoryIndex="-1"/>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0" ActiveMode=""/>
</RunParams>
</ProjectSession>
</CONFIG>

View File

@ -0,0 +1,695 @@
// ************************************************************************
// ***************************** 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 © 2020 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 <hgourvest@gmail.com>
* 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 uCEFBrowserThread;
{$MODE Delphi}
{$I cef.inc}
interface
uses
{$IFDEF DELPHI16_UP}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, System.SyncObjs, System.Math,
{$ELSE}
Windows, Messages, SysUtils, Classes, Graphics, SyncObjs, Math,
{$ENDIF}
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;
FPanelSize : TSize;
FScreenScale : single;
FPopUpBitmap : TBitmap;
FPopUpRect : TRect;
FResizeCS : TCriticalSection;
FBrowserInfoCS : TCriticalSection;
FShowPopUp : boolean;
FClosing : boolean;
FResizing : boolean;
FPendingResize : boolean;
FInitialized : boolean;
FDefaultURL : ustring;
FSnapshot : TBitmap;
FDelayMs : integer;
FOnSnapshotAvailable : TNotifyEvent;
FOnError : TNotifyEvent;
FErrorCode : integer;
FErrorText : ustring;
FFailedUrl : ustring;
FPendingUrl : ustring;
function GetErrorCode : integer;
function GetErrorText : ustring;
function GetFailedUrl : ustring;
function GetInitialized : boolean;
procedure Panel_OnResize(Sender: TObject);
procedure Browser_OnAfterCreated(Sender: TObject; const browser: ICefBrowser);
procedure Browser_OnPaint(Sender: TObject; const browser: ICefBrowser; kind: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; aWidth, aHeight: Integer);
procedure Browser_OnGetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect);
procedure Browser_OnGetScreenPoint(Sender: TObject; const browser: ICefBrowser; viewX, viewY: Integer; var screenX, screenY: Integer; out Result: Boolean);
procedure Browser_OnGetScreenInfo(Sender: TObject; const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out Result: Boolean);
procedure Browser_OnPopupShow(Sender: TObject; const browser: ICefBrowser; show: Boolean);
procedure Browser_OnPopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect);
procedure 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 Browser_OnBeforeClose(Sender: TObject; const browser: ICefBrowser);
procedure Browser_OnLoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring);
procedure Browser_OnLoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
procedure Resize;
function CreateBrowser : boolean;
procedure TakeSnapshot;
procedure CloseBrowser;
procedure DoOnError;
procedure InitError;
procedure WebpagePostProcessing;
procedure LoadPendingURL;
procedure Execute; override;
public
constructor Create(const aDefaultURL : ustring; aWidth, aHeight : integer; aDelayMs : integer = 500; const aScreenScale : single = 1);
destructor Destroy; override;
procedure AfterConstruction; override;
function TerminateBrowserThread : boolean;
function CopySnapshot(var aSnapshot : TBitmap) : boolean;
function SaveSnapshotToFile(const aPath : ustring) : boolean;
procedure LoadUrl(const aURL : ustring);
property ErrorCode : integer read GetErrorCode;
property ErrorText : ustring read GetErrorText;
property FailedUrl : ustring read GetFailedUrl;
property Initialized : boolean read GetInitialized;
property OnSnapshotAvailable : TNotifyEvent read FOnSnapshotAvailable write FOnSnapshotAvailable;
property OnError : TNotifyEvent read FOnError write FOnError;
end;
implementation
const
CEF_WEBPAGE_LOADED_MSG = WM_APP + 1;
CEF_WEBPAGE_ERROR_MSG = WM_APP + 2;
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);
FreeOnTerminate := False;
FInitialized := False;
FBrowser := nil;
FPanel := nil;
FPanelSize.cx := aWidth;
FPanelSize.cy := aHeight;
FScreenScale := aScreenScale;
FDefaultURL := aDefaultURL;
FPopUpBitmap := nil;
FPopUpRect := rect(0, 0, 0, 0);
FShowPopUp := False;
FResizing := False;
FPendingResize := False;
FResizeCS := nil;
FBrowserInfoCS := nil;
FSnapshot := nil;
FDelayMs := aDelayMs;
FOnSnapshotAvailable := nil;
FOnError := nil;
FClosing := False;
end;
destructor TCEFBrowserThread.Destroy;
begin
if (FBrowser <> nil) then
FreeAndNil(FBrowser);
if (FPanel <> nil) then
FreeAndNil(FPanel);
if (FPopUpBitmap <> nil) then
FreeAndNil(FPopUpBitmap);
if (FSnapshot <> nil) then
FreeAndNil(FSnapshot);
if (FResizeCS <> nil) then
FreeAndNil(FResizeCS);
if (FBrowserInfoCS <> nil) then
FreeAndNil(FBrowserInfoCS);
inherited Destroy;
end;
procedure TCEFBrowserThread.AfterConstruction;
begin
inherited AfterConstruction;
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;
FBrowser := TChromium.Create(nil);
FBrowser.DefaultURL := FDefaultURL;
FBrowser.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF);
FBrowser.OnAfterCreated := Browser_OnAfterCreated;
FBrowser.OnPaint := Browser_OnPaint;
FBrowser.OnGetViewRect := Browser_OnGetViewRect;
FBrowser.OnGetScreenPoint := Browser_OnGetScreenPoint;
FBrowser.OnGetScreenInfo := Browser_OnGetScreenInfo;
FBrowser.OnPopupShow := Browser_OnPopupShow;
FBrowser.OnPopupSize := Browser_OnPopupSize;
FBrowser.OnBeforePopup := Browser_OnBeforePopup;
FBrowser.OnBeforeClose := Browser_OnBeforeClose;
FBrowser.OnLoadError := Browser_OnLoadError;
FBrowser.OnLoadingStateChange := Browser_OnLoadingStateChange;
end;
function TCEFBrowserThread.GetErrorCode : integer;
begin
FBrowserInfoCS.Acquire;
Result := FErrorCode;
FBrowserInfoCS.Release;
end;
function TCEFBrowserThread.GetErrorText : ustring;
begin
FBrowserInfoCS.Acquire;
Result := FErrorText;
FBrowserInfoCS.Release;
end;
function TCEFBrowserThread.GetFailedUrl : ustring;
begin
FBrowserInfoCS.Acquire;
Result := FFailedUrl;
FBrowserInfoCS.Release;
end;
function TCEFBrowserThread.GetInitialized : boolean;
begin
Result := False;
if assigned(FBrowserInfoCS) and assigned(FBrowser) then
try
FBrowserInfoCS.Acquire;
Result := FInitialized and FBrowser.Initialized;
finally
FBrowserInfoCS.Release;
end;
end;
function TCEFBrowserThread.CopySnapshot(var aSnapshot : TBitmap) : boolean;
begin
Result := False;
if FClosing or Terminated or (FBrowserInfoCS = nil) then exit;
try
try
FBrowserInfoCS.Acquire;
if assigned(FSnapshot) and not(FSnapshot.Empty) then
begin
if (aSnapshot = nil) then
begin
aSnapshot := TBitmap.Create;
aSnapshot.PixelFormat := pf32bit;
aSnapshot.HandleType := bmDIB;
aSnapshot.Width := FSnapshot.Width;
aSnapshot.Height := FSnapshot.Height;
end;
aSnapshot.Assign(FSnapshot);
Result := True;
end;
except
on e : exception do
if CustomExceptionHandler('TCEFBrowserThread.CopySnapshot', e) then raise;
end;
finally
FBrowserInfoCS.Release;
end;
end;
function TCEFBrowserThread.SaveSnapshotToFile(const aPath : ustring) : boolean;
begin
Result := False;
if (FBrowserInfoCS = nil) then exit;
try
try
FBrowserInfoCS.Acquire;
if assigned(FSnapshot) and not(FSnapshot.Empty) then
begin
FSnapshot.SaveToFile(aPath);
Result := True;
end;
except
on e : exception do
if CustomExceptionHandler('TCEFBrowserThread.SaveSnapshotToFile', e) then raise;
end;
finally
FBrowserInfoCS.Release;
end;
end;
procedure TCEFBrowserThread.LoadUrl(const aURL : ustring);
begin
if FClosing or Terminated or (FBrowserInfoCS = nil) then
exit;
if Initialized then
try
FBrowserInfoCS.Acquire;
FPendingUrl := aURL;
PostThreadMessage(ThreadID, CEF_LOAD_PENDING_URL_MSG, 0, 0);
finally
FBrowserInfoCS.Release;
end;
end;
function TCEFBrowserThread.TerminateBrowserThread : boolean;
begin
Result := Initialized and
PostThreadMessage(ThreadID, CEF_CLOSE_BROWSER_MSG, 0, 0);
end;
procedure TCEFBrowserThread.Panel_OnResize(Sender: TObject);
begin
Resize;
end;
procedure TCEFBrowserThread.Browser_OnAfterCreated(Sender: TObject; const browser: ICefBrowser);
begin
FBrowserInfoCS.Acquire;
FInitialized := True;
FBrowserInfoCS.Release;
end;
procedure TCEFBrowserThread.Browser_OnPaint(Sender: TObject; const browser: ICefBrowser; kind: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; aWidth, aHeight: Integer);
var
src, dst: PByte;
i, j, TempLineSize, TempSrcOffset, TempDstOffset, SrcStride : Integer;
n : NativeUInt;
TempWidth, TempHeight : integer;
TempBufferBits : Pointer;
TempForcedResize : boolean;
TempBitmap : TBitmap;
TempSrcRect : TRect;
begin
try
FResizeCS.Acquire;
TempForcedResize := False;
if FPanel.BeginBufferDraw then
begin
if (kind = PET_POPUP) then
begin
if (FPopUpBitmap = nil) or
(aWidth <> FPopUpBitmap.Width) or
(aHeight <> FPopUpBitmap.Height) then
begin
if (FPopUpBitmap <> nil) then FPopUpBitmap.Free;
FPopUpBitmap := TBitmap.Create;
FPopUpBitmap.PixelFormat := pf32bit;
FPopUpBitmap.HandleType := bmDIB;
FPopUpBitmap.Width := aWidth;
FPopUpBitmap.Height := aHeight;
end;
TempBitmap := FPopUpBitmap;
TempBitmap.BeginUpdate;
TempWidth := FPopUpBitmap.Width;
TempHeight := FPopUpBitmap.Height;
end
else
begin
TempForcedResize := FPanel.UpdateBufferDimensions(aWidth, aHeight) or not(FPanel.BufferIsResized(False));
TempBitmap := FPanel.Buffer;
TempBitmap.BeginUpdate;
TempWidth := FPanel.BufferWidth;
TempHeight := FPanel.BufferHeight;
end;
SrcStride := aWidth * SizeOf(TRGBQuad);
n := 0;
while (n < dirtyRectsCount) do
begin
if (dirtyRects^[n].x >= 0) and (dirtyRects^[n].y >= 0) then
begin
TempLineSize := min(dirtyRects^[n].width, TempWidth - dirtyRects^[n].x) * SizeOf(TRGBQuad);
if (TempLineSize > 0) then
begin
TempSrcOffset := ((dirtyRects^[n].y * aWidth) + dirtyRects^[n].x) * SizeOf(TRGBQuad);
TempDstOffset := (dirtyRects^[n].x * SizeOf(TRGBQuad));
src := @PByte(buffer)[TempSrcOffset];
i := 0;
j := min(dirtyRects^[n].height, TempHeight - dirtyRects^[n].y);
while (i < j) do
begin
TempBufferBits := TempBitmap.Scanline[dirtyRects^[n].y + i];
dst := @PByte(TempBufferBits)[TempDstOffset];
Move(src^, dst^, TempLineSize);
Inc(src, SrcStride);
inc(i);
end;
end;
end;
inc(n);
end;
TempBitmap.EndUpdate;
if FShowPopup and (FPopUpBitmap <> nil) then
begin
TempSrcRect := Rect(0, 0,
min(FPopUpRect.Right - FPopUpRect.Left, FPopUpBitmap.Width),
min(FPopUpRect.Bottom - FPopUpRect.Top, FPopUpBitmap.Height));
FPanel.BufferDraw(FPopUpBitmap, TempSrcRect, FPopUpRect);
end;
FPanel.EndBufferDraw;
if (kind = PET_VIEW) then
begin
if TempForcedResize or FPendingResize then
PostThreadMessage(ThreadID, CEF_PENDINGRESIZE, 0, 0);
FResizing := False;
FPendingResize := False;
end;
end;
finally
FResizeCS.Release;
end;
end;
procedure TCEFBrowserThread.Browser_OnGetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect);
begin
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(FPanel.Width, FScreenScale);
rect.height := DeviceToLogical(FPanel.Height, FScreenScale);
end;
procedure TCEFBrowserThread.Browser_OnGetScreenPoint(Sender: TObject; const browser: ICefBrowser; viewX, viewY: Integer; var screenX, screenY: Integer; out Result: Boolean);
begin
screenX := LogicalToDevice(viewX, FScreenScale);
screenY := LogicalToDevice(viewY, FScreenScale);
Result := True;
end;
procedure TCEFBrowserThread.Browser_OnGetScreenInfo(Sender: TObject; const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out Result: Boolean);
var
TempRect : TCEFRect;
begin
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(FPanel.Width, FScreenScale);
TempRect.height := DeviceToLogical(FPanel.Height, FScreenScale);
screenInfo.device_scale_factor := FScreenScale;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
Result := True;
end;
procedure TCEFBrowserThread.Browser_OnPopupShow(Sender: TObject; const browser: ICefBrowser; show: Boolean);
begin
if show then
FShowPopUp := True
else
begin
FShowPopUp := False;
FPopUpRect := rect(0, 0, 0, 0);
if (FBrowser <> nil) then FBrowser.Invalidate(PET_VIEW);
end;
end;
procedure TCEFBrowserThread.Browser_OnPopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect);
begin
LogicalToDevice(rect^, FScreenScale);
FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1;
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);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TCEFBrowserThread.Browser_OnBeforeClose(Sender: TObject; const browser: ICefBrowser);
begin
PostThreadMessage(ThreadID, WM_QUIT, 0, 0);
end;
procedure TCEFBrowserThread.Browser_OnLoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring);
begin
if not(FClosing) and not(Terminated) and (frame <> nil) and frame.IsValid and frame.IsMain then
try
FBrowserInfoCS.Acquire;
FErrorCode := errorCode;
FErrorText := errorText;
FFailedUrl := failedUrl;
PostThreadMessage(ThreadID, CEF_WEBPAGE_ERROR_MSG, 0, 0);
finally
FBrowserInfoCS.Release;
end;
end;
procedure TCEFBrowserThread.Browser_OnLoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
begin
if not(FClosing) and not(Terminated) and not(isLoading) then
PostThreadMessage(ThreadID, CEF_WEBPAGE_LOADED_MSG, 0, 0);
end;
procedure TCEFBrowserThread.Resize;
begin
if FClosing or Terminated or (FPanel = nil) or (FResizeCS = nil) or (FBrowser = nil) then
exit;
try
FResizeCS.Acquire;
if FResizing then
FPendingResize := True
else
if FPanel.BufferIsResized then
FBrowser.Invalidate(PET_VIEW)
else
begin
FResizing := True;
FBrowser.WasResized;
end;
finally
FResizeCS.Release;
end;
end;
function TCEFBrowserThread.CreateBrowser : boolean;
begin
Result := (FBrowser <> nil) and FBrowser.CreateBrowser;
end;
procedure TCEFBrowserThread.LoadPendingURL;
begin
if FClosing or Terminated or (FBrowser = nil) or (FBrowserInfoCS = nil) then
exit;
try
FBrowserInfoCS.Acquire;
if (length(FPendingURL) > 0) then
begin
FBrowser.LoadURL(FPendingURL);
FPendingURL := '';
end;
finally
FBrowserInfoCS.Release;
end;
end;
procedure TCEFBrowserThread.WebpagePostProcessing;
begin
if FClosing or Terminated then
exit;
if (FDelayMs > 0) then
sleep(FDelayMs);
TakeSnapshot;
if assigned(FOnSnapshotAvailable) then FOnSnapshotAvailable(self);
end;
procedure TCEFBrowserThread.TakeSnapshot;
begin
if (FPanel = nil) or (FPanel.Buffer = nil) or (FBrowserInfoCS = nil) then
exit;
try
FBrowserInfoCS.Acquire;
if (FSnapshot = nil) then
begin
FSnapshot := TBitmap.Create;
FSnapshot.PixelFormat := pf32bit;
FSnapshot.HandleType := bmDIB;
FSnapshot.Width := FPanel.BufferWidth;
FSnapshot.Height := FPanel.BufferHeight;
end;
FSnapshot.Assign(FPanel.Buffer);
finally
FBrowserInfoCS.Release;
end;
end;
procedure TCEFBrowserThread.CloseBrowser;
begin
if not(FClosing) and assigned(FBrowser) then
begin
FClosing := True;
FBrowser.CloseBrowser(True);
end;
end;
procedure TCEFBrowserThread.DoOnError;
begin
if assigned(FOnError) then
FOnError(self);
end;
procedure TCEFBrowserThread.InitError;
begin
FBrowserInfoCS.Acquire;
FErrorText := 'There was an error initializing the CEF browser.';
FBrowserInfoCS.Release;
DoOnError;
end;
procedure TCEFBrowserThread.Execute;
var
TempCont : boolean;
TempMsg : TMsg;
begin
if CreateBrowser then
begin
TempCont := True;
PeekMessage(TempMsg, 0, WM_USER, WM_USER, PM_NOREMOVE);
while TempCont and GetMessage(TempMsg, 0, 0, 0) and not(Terminated) do
begin
case TempMsg.Message of
CEF_PENDINGRESIZE : Resize;
CEF_CLOSE_BROWSER_MSG : CloseBrowser;
CEF_LOAD_PENDING_URL_MSG : LoadPendingURL;
CEF_WEBPAGE_LOADED_MSG : WebpagePostProcessing;
CEF_WEBPAGE_ERROR_MSG : DoOnError;
WM_QUIT : TempCont := False;
end;
DispatchMessage(TempMsg);
end;
end
else
InitError;
end;
end.

View File

@ -0,0 +1,231 @@
// ************************************************************************
// ***************************** 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 © 2020 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 <hgourvest@gmail.com>
* 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 uEncapsulatedBrowser;
{$MODE Delphi}
{$I cef.inc}
interface
uses
{$IFDEF DELPHI16_UP}
System.SyncObjs, System.SysUtils,
{$ELSE}
SyncObjs, SysUtils,
{$ENDIF}
uCEFTypes, uCEFBrowserThread;
type
TEncapsulatedBrowser = class
protected
FThread : TCEFBrowserThread;
FWidth : integer;
FHeight : integer;
FDelayMs : integer;
FScale : single;
FSnapshotPath : ustring;
FErrorText : ustring;
procedure Thread_OnError(Sender: TObject);
procedure Thread_OnSnapshotAvailable(Sender: TObject);
public
constructor Create;
destructor Destroy; override;
procedure LoadURL(const aURL : string);
property Width : integer read FWidth write FWidth;
property Height : integer read FHeight write FHeight;
property DelayMs : integer read FDelayMs write FDelayMs;
property Scale : single read FScale write FScale;
property SnapshotPath : ustring read FSnapshotPath write FSnapshotPath;
property ErrorText : ustring read FErrorText;
end;
procedure CreateGlobalCEFApp;
function WaitForMainAppEvent : boolean;
procedure WriteResult;
implementation
uses
uCEFApplication;
var
MainAppEvent : TSimpleEvent;
EncapsulatedBrowser : TEncapsulatedBrowser = nil;
procedure GlobalCEFApp_OnContextInitialized;
var
TempParam, TempURL : ustring;
begin
TempURL := '';
// This demo reads the "/url" parameter to load it as the default URL in the browser.
// For example : ConsoleBrowser2.exe /url=https://www.briskbard.com
if (ParamCount > 0) then
begin
TempParam := paramstr(1);
if (Copy(TempParam, 1, 5) = '/url=') then
begin
TempURL := trim(Copy(TempParam, 6, length(TempParam)));
if (length(TempURL) > 0) then WriteLn('Loading ' + TempURL);
end;
end;
if (length(TempURL) = 0) then
begin
TempURL := 'https://www.google.com';
WriteLn('No URL has been specified. Using the default...');
end;
EncapsulatedBrowser := TEncapsulatedBrowser.Create;
EncapsulatedBrowser.LoadURL(TempURL);
end;
function WaitForMainAppEvent : boolean;
begin
Result := True;
// Wait for 1 minute max.
if (MainAppEvent.WaitFor(60000) = wrTimeout) then
begin
WriteLn('Timeout expired!');
Result := False;
end;
end;
procedure WriteResult;
begin
if (EncapsulatedBrowser = nil) then
WriteLn('There was a problem in the browser initialization')
else
if (length(EncapsulatedBrowser.ErrorText) > 0) then
WriteLn(EncapsulatedBrowser.ErrorText)
else
WriteLn('Snapshot saved successfully as ' + EncapsulatedBrowser.SnapshotPath);
end;
procedure CreateGlobalCEFApp;
begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
GlobalCEFApp.ShowMessageDlg := False; // This demo shouldn't show any window, just console messages.
GlobalCEFApp.BrowserSubprocessPath := 'ConsoleBrowser2_sp.exe'; // This is the other EXE for the CEF subprocesses. It's on the same directory as this app.
GlobalCEFApp.BlinkSettings := 'hideScrollbars'; // This setting removes all scrollbars to capture a cleaner snapshot
GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized;
GlobalCEFApp.StartMainProcess;
end;
constructor TEncapsulatedBrowser.Create;
begin
inherited Create;
FThread := nil;
FWidth := 1024;
FHeight := 768;
FDelayMs := 500;
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';
FErrorText := '';
end;
destructor TEncapsulatedBrowser.Destroy;
begin
if (FThread <> nil) then
begin
if FThread.TerminateBrowserThread then
FThread.WaitFor;
FreeAndNil(FThread);
end;
inherited Destroy;
end;
procedure TEncapsulatedBrowser.LoadURL(const aURL : string);
begin
if (FThread = nil) then
begin
FThread := TCEFBrowserThread.Create(aURL, FWidth, FHeight, FDelayMs, FScale);
FThread.OnError := Thread_OnError;
FThread.OnSnapshotAvailable := Thread_OnSnapshotAvailable;
FThread.Start;
end
else
FThread.LoadUrl(aURL);
end;
procedure TEncapsulatedBrowser.Thread_OnError(Sender: TObject);
begin
// This code is executed in the TCEFBrowserThread thread context while the main application thread is waiting for MainAppEvent.
FErrorText := 'Error';
if (FThread.ErrorCode <> 0) then
FErrorText := FErrorText + ' ' + inttostr(FThread.ErrorCode);
FErrorText := FErrorText + ' : ' + FThread.ErrorText;
if (length(FThread.FailedUrl) > 0) then
FErrorText := FErrorText + ' - ' + FThread.FailedUrl;
MainAppEvent.SetEvent;
end;
procedure TEncapsulatedBrowser.Thread_OnSnapshotAvailable(Sender: TObject);
begin
// This code is executed in the TCEFBrowserThread thread context while the main application thread is waiting for MainAppEvent.
if not(FThread.SaveSnapshotToFile(FSnapshotPath)) then
FErrorText := 'There was an error copying the snapshot';
MainAppEvent.SetEvent;
end;
initialization
MainAppEvent := TSimpleEvent.Create;
finalization
MainAppEvent.Free;
if (EncapsulatedBrowser <> nil) then FreeAndNil(EncapsulatedBrowser);
end.

Some files were not shown because too many files have changed in this diff Show More