From 6ec75477ef31647988188e520134c8c34d97a972 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Salvador=20D=C3=ADaz=20Fau?= Date: Sun, 18 Feb 2018 21:22:10 +0100 Subject: [PATCH] New PopupBrowser demo --- bin/PopupBrowser.html | 20 + demos/PopupBrowser/00-DeleteDCUs.bat | 14 + demos/PopupBrowser/PopupBrowser.dpr | 79 +++ demos/PopupBrowser/PopupBrowser.dproj | 601 +++++++++++++++++++ demos/PopupBrowser/cef.inc | 384 ++++++++++++ demos/PopupBrowser/uChildForm.dfm | 62 ++ demos/PopupBrowser/uChildForm.pas | 821 ++++++++++++++++++++++++++ demos/PopupBrowser/uMainForm.dfm | 84 +++ demos/PopupBrowser/uMainForm.pas | 345 +++++++++++ 9 files changed, 2410 insertions(+) create mode 100644 bin/PopupBrowser.html create mode 100644 demos/PopupBrowser/00-DeleteDCUs.bat create mode 100644 demos/PopupBrowser/PopupBrowser.dpr create mode 100644 demos/PopupBrowser/PopupBrowser.dproj create mode 100644 demos/PopupBrowser/cef.inc create mode 100644 demos/PopupBrowser/uChildForm.dfm create mode 100644 demos/PopupBrowser/uChildForm.pas create mode 100644 demos/PopupBrowser/uMainForm.dfm create mode 100644 demos/PopupBrowser/uMainForm.pas diff --git a/bin/PopupBrowser.html b/bin/PopupBrowser.html new file mode 100644 index 00000000..833447cd --- /dev/null +++ b/bin/PopupBrowser.html @@ -0,0 +1,20 @@ + + + + +

The following button opens google.com in a popup window.

+ + + + + + \ No newline at end of file diff --git a/demos/PopupBrowser/00-DeleteDCUs.bat b/demos/PopupBrowser/00-DeleteDCUs.bat new file mode 100644 index 00000000..dbd008bc --- /dev/null +++ b/demos/PopupBrowser/00-DeleteDCUs.bat @@ -0,0 +1,14 @@ +del /s /q *.dcu +del /s /q *.exe +del /s /q *.res +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 __history +rmdir __recovery diff --git a/demos/PopupBrowser/PopupBrowser.dpr b/demos/PopupBrowser/PopupBrowser.dpr new file mode 100644 index 00000000..bd013623 --- /dev/null +++ b/demos/PopupBrowser/PopupBrowser.dpr @@ -0,0 +1,79 @@ +// ************************************************************************ +// ***************************** 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 + * 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 PopupBrowser; + +{$I cef.inc} + +uses + {$IFDEF DELPHI16_UP} + Vcl.Forms, + WinApi.Windows, + {$ELSE} + Forms, + Windows, + {$ENDIF } + uCEFApplication, + uMainForm in 'uMainForm.pas' {MainForm}, + uChildForm in 'uChildForm.pas' {ChildForm}; + +{$R *.res} + +// CEF3 needs to set the LARGEADDRESSAWARE flag which allows 32-bit processes to use up to 3GB of RAM. +// If you don't add this flag the rederer process will crash when you try to load large images. +{$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE} + +begin + GlobalCEFApp := TCefApplication.Create; + GlobalCEFApp.FlashEnabled := False; + GlobalCEFApp.WindowlessRenderingEnabled := True; + GlobalCEFApp.EnableHighDPISupport := True; + GlobalCEFApp.FastUnload := True; + GlobalCEFApp.SitePerProcess := False; + + if GlobalCEFApp.StartMainProcess then + begin + Application.Initialize; + {$IFDEF DELPHI11_UP} + Application.MainFormOnTaskbar := True; + {$ENDIF} + Application.CreateForm(TMainForm, MainForm); + Application.Run; + end; + + GlobalCEFApp.Free; +end. diff --git a/demos/PopupBrowser/PopupBrowser.dproj b/demos/PopupBrowser/PopupBrowser.dproj new file mode 100644 index 00000000..820c9a89 --- /dev/null +++ b/demos/PopupBrowser/PopupBrowser.dproj @@ -0,0 +1,601 @@ + + + {55E00327-9D98-4DA3-A4E1-844942A01C6B} + 18.2 + VCL + PopupBrowser.dpr + True + Debug + Win32 + 1 + Application + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 3082 + PopupBrowser + $(BDS)\bin\delphi_PROJECTICON.ico + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + .\$(Platform)\$(Config) + false + false + false + false + false + + + DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;frxe23;vclFireDAC;emsclientfiredac;DataSnapFireDAC;svnui;tethering;Componentes;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;Intraweb;DBXOracleDriver;inetdb;Componentes_Int;CEF4Delphi;FmxTeeUI;FireDACIBDriver;fmx;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyProtocols230;vclx;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;frxTee23;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;vcl;DBXSybaseASEDriver;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;Componentes_UI;TeeDB;FireDAC;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;Componentes_Misc;ibxpress;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;Componentes_RTF;DBXInformixDriver;bindcompvcl;frxDB23;Componentes_vCard;TeeUI;IndyCore230;vclribbon;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;IndySystem230;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;frx23;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + true + $(BDS)\bin\default_app.manifest + 1033 + CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + ..\..\bin + + + DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;emsclientfiredac;DataSnapFireDAC;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;Intraweb;DBXOracleDriver;inetdb;FmxTeeUI;FireDACIBDriver;fmx;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyProtocols230;vclx;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;vcl;DBXSybaseASEDriver;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;FireDAC;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;bindcompvcl;TeeUI;IndyCore230;vclribbon;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;IndySystem230;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;fmxase;$(DCC_UsePackage) + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + true + 1033 + true + true + false + Debug + CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) + + + true + true + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + true + + + true + true + + + + MainSource + + +
MainForm
+ + +
ChildForm
+ dfm + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Application + + + + PopupBrowser.dpr + + + IP Abstraction Indy Implementation Design Time + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + + PopupBrowser.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 0 + + + + + classes + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + + + res\values + 1 + + + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\ + 1 + + + + + Contents + 1 + + + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + True + False + + + 12 + + + + + diff --git a/demos/PopupBrowser/cef.inc b/demos/PopupBrowser/cef.inc new file mode 100644 index 00000000..984ae795 --- /dev/null +++ b/demos/PopupBrowser/cef.inc @@ -0,0 +1,384 @@ +// ************************************************************************ +// ***************************** 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 © 2017 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 + * 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. + * + *) + + // The complete list of compiler versions is here : + // http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Compiler_Versions + +{$DEFINE DELPHI_VERSION_UNKNOW} + +{$IFDEF FPC} + {$DEFINE CEF_MULTI_THREADED_MESSAGE_LOOP} + {$DEFINE SUPPORTS_INLINE} +{$ENDIF} + +// Delphi 5 +{$IFDEF VER130} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} +{$ENDIF} + +// Delphi 6 +{$IFDEF VER140} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} +{$ENDIF} + +// Delphi 7 +{$IFDEF VER150} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} +{$ENDIF} + +// Delphi 8 +{$IFDEF VER160} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} +{$ENDIF} + +// Delphi 2005 +{$IFDEF VER170} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} +{$ENDIF} + +{$IFDEF VER180} + {$UNDEF DELPHI_VERSION_UNKNOW} + // Delphi 2007 + {$IFDEF VER185} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + // Delphi 2006 + {$ELSE} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$ENDIF} +{$ENDIF} + +// Delphi 2009 +{$IFDEF VER200} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} +{$ENDIF} + +//Delphi 2010 +{$IFDEF VER210} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} + {$DEFINE DELPHI14_UP} +{$ENDIF} + +// Delphi XE +{$IFDEF VER220} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} + {$DEFINE DELPHI14_UP} + {$DEFINE DELPHI15_UP} +{$ENDIF} + +// Delphi XE2 +{$IFDEF VER230} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} + {$DEFINE DELPHI14_UP} + {$DEFINE DELPHI15_UP} + {$DEFINE DELPHI16_UP} +{$ENDIF} + +// Delphi XE3 +{$IFDEF VER240} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} + {$DEFINE DELPHI14_UP} + {$DEFINE DELPHI15_UP} + {$DEFINE DELPHI16_UP} + {$DEFINE DELPHI17_UP} +{$ENDIF} + +// Delphi XE4 +{$IFDEF VER250} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} + {$DEFINE DELPHI14_UP} + {$DEFINE DELPHI15_UP} + {$DEFINE DELPHI16_UP} + {$DEFINE DELPHI17_UP} + {$DEFINE DELPHI18_UP} +{$ENDIF} + +// Delphi XE5 +{$IFDEF VER260} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} + {$DEFINE DELPHI14_UP} + {$DEFINE DELPHI15_UP} + {$DEFINE DELPHI16_UP} + {$DEFINE DELPHI17_UP} + {$DEFINE DELPHI18_UP} + {$DEFINE DELPHI19_UP} +{$ENDIF} + +// Delphi XE6 +{$IFDEF VER270} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} + {$DEFINE DELPHI14_UP} + {$DEFINE DELPHI15_UP} + {$DEFINE DELPHI16_UP} + {$DEFINE DELPHI17_UP} + {$DEFINE DELPHI18_UP} + {$DEFINE DELPHI19_UP} + {$DEFINE DELPHI20_UP} +{$ENDIF} + +// Delphi XE7 +{$IFDEF VER280} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} + {$DEFINE DELPHI14_UP} + {$DEFINE DELPHI15_UP} + {$DEFINE DELPHI16_UP} + {$DEFINE DELPHI17_UP} + {$DEFINE DELPHI18_UP} + {$DEFINE DELPHI19_UP} + {$DEFINE DELPHI20_UP} + {$DEFINE DELPHI21_UP} +{$ENDIF} + +// Delphi XE8 +{$IFDEF VER290} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} + {$DEFINE DELPHI14_UP} + {$DEFINE DELPHI15_UP} + {$DEFINE DELPHI16_UP} + {$DEFINE DELPHI17_UP} + {$DEFINE DELPHI18_UP} + {$DEFINE DELPHI19_UP} + {$DEFINE DELPHI20_UP} + {$DEFINE DELPHI21_UP} + {$DEFINE DELPHI22_UP} +{$ENDIF VER290} + +// Rad Studio 10 - Delphi Seattle +{$IFDEF VER300} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} + {$DEFINE DELPHI14_UP} + {$DEFINE DELPHI15_UP} + {$DEFINE DELPHI16_UP} + {$DEFINE DELPHI17_UP} + {$DEFINE DELPHI18_UP} + {$DEFINE DELPHI19_UP} + {$DEFINE DELPHI20_UP} + {$DEFINE DELPHI21_UP} + {$DEFINE DELPHI22_UP} + {$DEFINE DELPHI23_UP} +{$ENDIF} + +// Rad Studio 10.1 - Delphi Berlin +{$IFDEF VER310} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} + {$DEFINE DELPHI14_UP} + {$DEFINE DELPHI15_UP} + {$DEFINE DELPHI16_UP} + {$DEFINE DELPHI17_UP} + {$DEFINE DELPHI18_UP} + {$DEFINE DELPHI19_UP} + {$DEFINE DELPHI20_UP} + {$DEFINE DELPHI21_UP} + {$DEFINE DELPHI22_UP} + {$DEFINE DELPHI23_UP} + {$DEFINE DELPHI24_UP} +{$ENDIF} + +// Rad Studio 10.2 - Delphi Tokyo +{$IFDEF VER320} + {$UNDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} + {$DEFINE DELPHI14_UP} + {$DEFINE DELPHI15_UP} + {$DEFINE DELPHI16_UP} + {$DEFINE DELPHI17_UP} + {$DEFINE DELPHI18_UP} + {$DEFINE DELPHI19_UP} + {$DEFINE DELPHI20_UP} + {$DEFINE DELPHI21_UP} + {$DEFINE DELPHI22_UP} + {$DEFINE DELPHI23_UP} + {$DEFINE DELPHI24_UP} + {$DEFINE DELPHI25_UP} +{$ENDIF} + + +{$IFDEF DELPHI_VERSION_UNKNOW} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI11_UP} + {$DEFINE DELPHI12_UP} + {$DEFINE DELPHI14_UP} + {$DEFINE DELPHI15_UP} + {$DEFINE DELPHI16_UP} + {$DEFINE DELPHI17_UP} + {$DEFINE DELPHI18_UP} + {$DEFINE DELPHI19_UP} + {$DEFINE DELPHI20_UP} + {$DEFINE DELPHI21_UP} + {$DEFINE DELPHI22_UP} + {$DEFINE DELPHI23_UP} + {$DEFINE DELPHI24_UP} + {$DEFINE DELPHI25_UP} +{$ENDIF} + +{$IFDEF DELPHI9_UP} + {$DEFINE SUPPORTS_INLINE} +{$ENDIF} + diff --git a/demos/PopupBrowser/uChildForm.dfm b/demos/PopupBrowser/uChildForm.dfm new file mode 100644 index 00000000..4f99bb5e --- /dev/null +++ b/demos/PopupBrowser/uChildForm.dfm @@ -0,0 +1,62 @@ +object ChildForm: TChildForm + Left = 0 + Top = 0 + Caption = 'Popup' + ClientHeight = 256 + ClientWidth = 352 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + OnAfterMonitorDpiChanged = FormAfterMonitorDpiChanged + OnClose = FormClose + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnDestroy = FormDestroy + OnHide = FormHide + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object Panel1: TBufferPanel + Left = 0 + Top = 0 + Width = 352 + Height = 256 + Align = alClient + Caption = 'Panel1' + Color = clWhite + ParentBackground = False + TabOrder = 0 + TabStop = True + OnClick = Panel1Click + OnEnter = Panel1Enter + OnExit = Panel1Exit + OnMouseDown = Panel1MouseDown + OnMouseMove = Panel1MouseMove + OnMouseUp = Panel1MouseUp + OnResize = Panel1Resize + OnMouseLeave = Panel1MouseLeave + ExplicitWidth = 800 + ExplicitHeight = 530 + end + object Chromium1: TChromium + OnTitleChange = Chromium1TitleChange + OnTooltip = Chromium1Tooltip + OnBeforePopup = Chromium1BeforePopup + OnBeforeClose = Chromium1BeforeClose + OnClose = Chromium1Close + OnGetViewRect = Chromium1GetViewRect + OnGetScreenPoint = Chromium1GetScreenPoint + OnGetScreenInfo = Chromium1GetScreenInfo + OnPopupShow = Chromium1PopupShow + OnPopupSize = Chromium1PopupSize + OnPaint = Chromium1Paint + OnCursorChange = Chromium1CursorChange + Left = 24 + Top = 56 + end +end diff --git a/demos/PopupBrowser/uChildForm.pas b/demos/PopupBrowser/uChildForm.pas new file mode 100644 index 00000000..7e529b6c --- /dev/null +++ b/demos/PopupBrowser/uChildForm.pas @@ -0,0 +1,821 @@ +// ************************************************************************ +// ***************************** 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 + * 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 uChildForm; + +{$I cef.inc} + +interface + +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, + {$ELSE} + Windows, Messages, SysUtils, Variants, Classes, SyncObjs, + Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, AppEvnts, + {$ENDIF} + uCEFChromium, uCEFTypes, uCEFInterfaces, uCEFConstants, uBufferPanel; + +const + CEF_SHOWCHILD = WM_APP + $A52; + +type + TChildForm = class(TForm) + Chromium1: TChromium; + Panel1: TBufferPanel; + + 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 Panel1MouseLeave(Sender: TObject); + + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure FormHide(Sender: TObject); + procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, NewDPI: Integer); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + + procedure Chromium1Paint(Sender: TObject; const browser: ICefBrowser; kind: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; width, height: Integer); + procedure Chromium1CursorChange(Sender: TObject; const browser: ICefBrowser; cursor: HICON; cursorType: TCefCursorType; const customCursorInfo: PCefCursorInfo); + procedure Chromium1GetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect; out Result: Boolean); + procedure Chromium1GetScreenPoint(Sender: TObject; const browser: ICefBrowser; viewX, viewY: Integer; var screenX, screenY: Integer; out Result: Boolean); + procedure Chromium1GetScreenInfo(Sender: TObject; const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out Result: Boolean); + procedure Chromium1PopupShow(Sender: TObject; const browser: ICefBrowser; show: Boolean); + procedure Chromium1PopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect); + procedure Chromium1Tooltip(Sender: TObject; const browser: ICefBrowser; var text: ustring; out Result: Boolean); + procedure Chromium1BeforePopup(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl, targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; var popupFeatures: TCefPopupFeatures; var windowInfo: TCefWindowInfo; var client: ICefClient; var settings: TCefBrowserSettings; var noJavascriptAccess: Boolean; out Result: Boolean); + procedure Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring); + procedure Chromium1Close(Sender: TObject; const browser: ICefBrowser; out Result: Boolean); + procedure Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser); + + protected + FPopUpBitmap : TBitmap; + FPopUpRect : TRect; + FShowPopUp : boolean; + FResizing : boolean; + FPendingResize : boolean; + FCanClose : boolean; + FClosing : boolean; + FClientInitialized : boolean; + FResizeCS : TCriticalSection; + FPopupFeatures : TCefPopupFeatures; + + function getModifiers(Shift: TShiftState): TCefEventFlags; + function GetButton(Button: TMouseButton): TCefMouseButtonType; + procedure ApplyPopupFeatures; + procedure DoResize; + + procedure WMMove(var aMessage : TWMMove); message WM_MOVE; + procedure WMMoving(var aMessage : TMessage); message WM_MOVING; + procedure WMCaptureChanged(var aMessage : TMessage); message WM_CAPTURECHANGED; + procedure WMCancelMode(var aMessage : TMessage); message WM_CANCELMODE; + procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP; + procedure WMExitMenuLoop(var aMessage: TMessage); message WM_EXITMENULOOP; + procedure PendingResizeMsg(var aMessage : TMessage); message CEF_PENDINGRESIZE; + procedure ShowChildMsg(var aMessage : TMessage); message CEF_SHOWCHILD; + + public + function CreateClientHandler(var windowInfo : TCefWindowInfo; var client : ICefClient; const targetFrameName : string; const popupFeatures : TCefPopupFeatures) : boolean; + + procedure HandleSysCharMsg(var Msg: tagMSG; var Handled: Boolean); + procedure HandleSysKeyDownMsg(var Msg: tagMSG; var Handled: Boolean); + procedure HandleSysKeyUpMsg(var Msg: tagMSG; var Handled: Boolean); + procedure HandleKeyDownMsg(var Msg: tagMSG; var Handled: Boolean); + procedure HandleKeyUpMsg(var Msg: tagMSG; var Handled: Boolean); + procedure HandleCharMsg(var Msg: tagMSG; var Handled: Boolean); + procedure HandleMouseWheelMsg(var Msg: tagMSG; var Handled: Boolean); + + property ClientInitialized : boolean read FClientInitialized; + property Closing : boolean read FClosing; + end; + +implementation + +{$R *.dfm} + +uses + {$IFDEF DELPHI16_UP} + System.Math, + {$ELSE} + Math, + {$ENDIF} + uCEFMiscFunctions, uCEFApplication, uMainForm; + +// 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 CEF3 will destroy the internal browser immediately. +// 3- chrmosr.OnBeforeClose is triggered because the internal browser was destroyed. +// Now we set FCanClose to True and send WM_CLOSE to the form. + +procedure TChildForm.HandleSysCharMsg(var Msg: tagMSG; var Handled: Boolean); +var + TempKeyEvent : TCefKeyEvent; +begin + if Panel1.Focused and (Msg.wParam in [VK_BACK..VK_HELP]) then + begin + TempKeyEvent.kind := KEYEVENT_CHAR; + TempKeyEvent.modifiers := GetCefKeyboardModifiers(Msg.wParam, Msg.lParam); + TempKeyEvent.windows_key_code := Msg.wParam; + TempKeyEvent.native_key_code := Msg.lParam; + TempKeyEvent.is_system_key := ord(True); + TempKeyEvent.character := #0; + TempKeyEvent.unmodified_character := #0; + TempKeyEvent.focus_on_editable_field := ord(False); + + Chromium1.SendKeyEvent(@TempKeyEvent); + Handled := True; + end + else + Handled := False; +end; + +procedure TChildForm.HandleSysKeyDownMsg(var Msg: tagMSG; var Handled: Boolean); +var + TempKeyEvent : TCefKeyEvent; +begin + if Panel1.Focused and (Msg.wParam in [VK_BACK..VK_HELP]) then + begin + TempKeyEvent.kind := KEYEVENT_RAWKEYDOWN; + TempKeyEvent.modifiers := GetCefKeyboardModifiers(Msg.wParam, Msg.lParam); + TempKeyEvent.windows_key_code := Msg.wParam; + TempKeyEvent.native_key_code := Msg.lParam; + TempKeyEvent.is_system_key := ord(True); + TempKeyEvent.character := #0; + TempKeyEvent.unmodified_character := #0; + TempKeyEvent.focus_on_editable_field := ord(False); + + Chromium1.SendKeyEvent(@TempKeyEvent); + Handled := True; + end + else + Handled := False; +end; + +procedure TChildForm.HandleSysKeyUpMsg(var Msg: tagMSG; var Handled: Boolean); +var + TempKeyEvent : TCefKeyEvent; +begin + if Panel1.Focused and (Msg.wParam in [VK_BACK..VK_HELP]) then + begin + TempKeyEvent.kind := KEYEVENT_KEYUP; + TempKeyEvent.modifiers := GetCefKeyboardModifiers(Msg.wParam, Msg.lParam); + TempKeyEvent.windows_key_code := Msg.wParam; + TempKeyEvent.native_key_code := Msg.lParam; + TempKeyEvent.is_system_key := ord(True); + TempKeyEvent.character := #0; + TempKeyEvent.unmodified_character := #0; + TempKeyEvent.focus_on_editable_field := ord(False); + + Chromium1.SendKeyEvent(@TempKeyEvent); + Handled := True; + end + else + Handled := False; +end; + +procedure TChildForm.HandleKeyDownMsg(var Msg: tagMSG; var Handled: Boolean); +var + TempKeyEvent : TCefKeyEvent; +begin + if Panel1.Focused and (Msg.wParam in [VK_BACK..VK_HELP]) then + begin + TempKeyEvent.kind := KEYEVENT_RAWKEYDOWN; + TempKeyEvent.modifiers := GetCefKeyboardModifiers(Msg.wParam, Msg.lParam); + TempKeyEvent.windows_key_code := Msg.wParam; + TempKeyEvent.native_key_code := Msg.lParam; + TempKeyEvent.is_system_key := ord(False); + TempKeyEvent.character := #0; + TempKeyEvent.unmodified_character := #0; + TempKeyEvent.focus_on_editable_field := ord(False); + + Chromium1.SendKeyEvent(@TempKeyEvent); + Handled := True; + end + else + Handled := False; +end; + +procedure TChildForm.HandleKeyUpMsg(var Msg: tagMSG; var Handled: Boolean); +var + TempKeyEvent : TCefKeyEvent; +begin + if Panel1.Focused and (Msg.wParam in [VK_BACK..VK_HELP]) then + begin + TempKeyEvent.kind := KEYEVENT_KEYUP; + TempKeyEvent.modifiers := GetCefKeyboardModifiers(Msg.wParam, Msg.lParam); + TempKeyEvent.windows_key_code := Msg.wParam; + TempKeyEvent.native_key_code := Msg.lParam; + TempKeyEvent.is_system_key := ord(False); + TempKeyEvent.character := #0; + TempKeyEvent.unmodified_character := #0; + TempKeyEvent.focus_on_editable_field := ord(False); + + Chromium1.SendKeyEvent(@TempKeyEvent); + Handled := True; + end + else + Handled := False; +end; + +procedure TChildForm.HandleCharMsg(var Msg: tagMSG; var Handled: Boolean); +var + TempKeyEvent : TCefKeyEvent; +begin + if Panel1.Focused then + begin + TempKeyEvent.kind := KEYEVENT_CHAR; + TempKeyEvent.modifiers := GetCefKeyboardModifiers(Msg.wParam, Msg.lParam); + TempKeyEvent.windows_key_code := Msg.wParam; + TempKeyEvent.native_key_code := Msg.lParam; + TempKeyEvent.is_system_key := ord(False); + TempKeyEvent.character := #0; + TempKeyEvent.unmodified_character := #0; + TempKeyEvent.focus_on_editable_field := ord(False); + + Chromium1.SendKeyEvent(@TempKeyEvent); + Handled := True; + end + else + Handled := False; +end; + +procedure TChildForm.HandleMouseWheelMsg(var Msg: tagMSG; var Handled: Boolean); +var + TempMouseEvent : TCefMouseEvent; +begin + if Panel1.Focused and (GlobalCEFApp <> nil) then + begin + TempMouseEvent.x := Msg.lParam and $FFFF; + TempMouseEvent.y := Msg.lParam shr 16; + TempMouseEvent.modifiers := GetCefMouseModifiers(Msg.wParam); + DeviceToLogical(TempMouseEvent, GlobalCEFApp.DeviceScaleFactor); + Chromium1.SendMouseWheelEvent(@TempMouseEvent, 0, int16(Msg.wParam shr 16)); + Handled := False; + end; +end; + +function TChildForm.CreateClientHandler(var windowInfo : TCefWindowInfo; + var client : ICefClient; + const targetFrameName : string; + const popupFeatures : TCefPopupFeatures) : boolean; +begin + Chromium1.InitializeDragAndDrop(Panel1); + + WindowInfoAsWindowless(windowInfo, 0, targetFrameName); + FPopupFeatures := popupFeatures; + FClientInitialized := Chromium1.CreateClientHandler(client); + Result := FClientInitialized; +end; + +procedure TChildForm.ApplyPopupFeatures; +begin + if (FPopupFeatures.xset <> 0) then Chromium1.SetFormLeftTo(FPopupFeatures.x); + if (FPopupFeatures.yset <> 0) then Chromium1.SetFormTopTo(FPopupFeatures.y); + if (FPopupFeatures.widthset <> 0) then Chromium1.ResizeFormWidthTo(FPopupFeatures.width); + if (FPopupFeatures.heightset <> 0) then Chromium1.ResizeFormHeightTo(FPopupFeatures.height); +end; + +procedure TChildForm.Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser); +begin + FCanClose := True; + PostMessage(Handle, WM_CLOSE, 0, 0); +end; + +procedure TChildForm.Chromium1BeforePopup(Sender : TObject; + const browser : ICefBrowser; + const frame : ICefFrame; + const targetUrl : ustring; + const targetFrameName : ustring; + targetDisposition : TCefWindowOpenDisposition; + userGesture : Boolean; + var popupFeatures : TCefPopupFeatures; + var windowInfo : TCefWindowInfo; + var client : ICefClient; + var settings : TCefBrowserSettings; + var noJavascriptAccess : Boolean; + out Result : Boolean); +begin + case targetDisposition of + WOD_NEW_FOREGROUND_TAB, + WOD_NEW_BACKGROUND_TAB, + WOD_NEW_WINDOW : Result := True; // For simplicity, this demo blocks new tabs and new windows. + + WOD_NEW_POPUP : Result := not(TMainForm(Owner).CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures)); + + else Result := False; + end; +end; + +procedure TChildForm.Chromium1Close(Sender: TObject; const browser: ICefBrowser; out Result: Boolean); +begin + Result := False; +end; + +procedure TChildForm.Chromium1CursorChange(Sender : TObject; + const browser : ICefBrowser; + cursor : HICON; + cursorType : TCefCursorType; + const customCursorInfo : PCefCursorInfo); +begin + Panel1.Cursor := GefCursorToWindowsCursor(cursorType); +end; + +procedure TChildForm.Chromium1GetScreenInfo(Sender : TObject; + const browser : ICefBrowser; + var screenInfo : TCefScreenInfo; + out Result : Boolean); +var + TempRect : TCEFRect; +begin + if (GlobalCEFApp <> nil) then + begin + TempRect.x := 0; + TempRect.y := 0; + TempRect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor); + TempRect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor); + + screenInfo.device_scale_factor := GlobalCEFApp.DeviceScaleFactor; + screenInfo.depth := 0; + screenInfo.depth_per_component := 0; + screenInfo.is_monochrome := Ord(False); + screenInfo.rect := TempRect; + screenInfo.available_rect := TempRect; + + Result := True; + end + else + Result := False; +end; + +procedure TChildForm.Chromium1GetScreenPoint(Sender : TObject; + const browser : ICefBrowser; + viewX : Integer; + viewY : Integer; + var screenX : Integer; + var screenY : Integer; + out Result : Boolean); +var + TempScreenPt, TempViewPt : TPoint; +begin + if (GlobalCEFApp <> nil) then + begin + TempViewPt.x := LogicalToDevice(viewX, GlobalCEFApp.DeviceScaleFactor); + TempViewPt.y := LogicalToDevice(viewY, GlobalCEFApp.DeviceScaleFactor); + TempScreenPt := Panel1.ClientToScreen(TempViewPt); + screenX := TempScreenPt.x; + screenY := TempScreenPt.y; + Result := True; + end + else + Result := False; +end; + +procedure TChildForm.Chromium1GetViewRect(Sender : TObject; + const browser : ICefBrowser; + var rect : TCefRect; + out Result : Boolean); +begin + if (GlobalCEFApp <> nil) then + begin + rect.x := 0; + rect.y := 0; + rect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor); + rect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor); + Result := True; + end + else + Result := False; +end; + +procedure TChildForm.Chromium1Paint(Sender : TObject; + const browser : ICefBrowser; + kind : TCefPaintElementType; + dirtyRectsCount : NativeUInt; + const dirtyRects : PCefRectArray; + const buffer : Pointer; + width : Integer; + height : Integer); +var + src, dst: PByte; + i, j, TempLineSize, TempSrcOffset, TempDstOffset, SrcStride, DstStride : Integer; + n : NativeUInt; + TempWidth, TempHeight, TempScanlineSize : integer; + TempBufferBits : Pointer; + TempForcedResize : boolean; +begin + try + FResizeCS.Acquire; + TempForcedResize := False; + + if Panel1.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 := Panel1.UpdateBufferDimensions(Width, Height) or not(Panel1.BufferIsResized(False)); + TempWidth := Panel1.BufferWidth; + TempHeight := Panel1.BufferHeight; + TempScanlineSize := Panel1.ScanlineSize; + TempBufferBits := Panel1.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 + Panel1.BufferDraw(FPopUpRect.Left, FPopUpRect.Top, FPopUpBitmap); + end; + + Panel1.EndBufferDraw; + Panel1.InvalidatePanel; + + if (kind = PET_VIEW) then + begin + if TempForcedResize or FPendingResize then PostMessage(Handle, CEF_PENDINGRESIZE, 0, 0); + + FResizing := False; + FPendingResize := False; + end; + end; + finally + FResizeCS.Release; + end; +end; + +procedure TChildForm.Chromium1PopupShow(Sender : TObject; + const browser : ICefBrowser; + show : Boolean); +begin + if show then + FShowPopUp := True + else + begin + FShowPopUp := False; + FPopUpRect := rect(0, 0, 0, 0); + + if (Chromium1 <> nil) then Chromium1.Invalidate(PET_VIEW); + end; +end; + +procedure TChildForm.Chromium1PopupSize(Sender : TObject; + const browser : ICefBrowser; + const rect : PCefRect); +begin + if (GlobalCEFApp <> nil) then + begin + LogicalToDevice(rect^, GlobalCEFApp.DeviceScaleFactor); + + FPopUpRect.Left := rect.x; + FPopUpRect.Top := rect.y; + FPopUpRect.Right := rect.x + rect.width - 1; + FPopUpRect.Bottom := rect.y + rect.height - 1; + end; +end; + +procedure TChildForm.Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring); +begin + Caption := title; +end; + +procedure TChildForm.Chromium1Tooltip(Sender: TObject; const browser: ICefBrowser; var text: ustring; out Result: Boolean); +begin + Panel1.hint := text; + Panel1.ShowHint := (length(text) > 0); + Result := True; +end; + +function TChildForm.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 TChildForm.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 TChildForm.WMMove(var aMessage : TWMMove); +begin + inherited; + + if (Chromium1 <> nil) then Chromium1.NotifyMoveOrResizeStarted; +end; + +procedure TChildForm.WMMoving(var aMessage : TMessage); +begin + inherited; + + if (Chromium1 <> nil) then Chromium1.NotifyMoveOrResizeStarted; +end; + +procedure TChildForm.WMCaptureChanged(var aMessage : TMessage); +begin + inherited; + + if (Chromium1 <> nil) then Chromium1.SendCaptureLostEvent; +end; + +procedure TChildForm.WMCancelMode(var aMessage : TMessage); +begin + inherited; + + if (Chromium1 <> nil) then Chromium1.SendCaptureLostEvent; +end; + +procedure TChildForm.WMEnterMenuLoop(var aMessage: TMessage); +begin + inherited; + + if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := True; +end; + +procedure TChildForm.WMExitMenuLoop(var aMessage: TMessage); +begin + inherited; + + if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := False; +end; + +procedure TChildForm.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, NewDPI: Integer); +begin + if (Chromium1 <> nil) then + begin + Chromium1.NotifyScreenInfoChanged; + Chromium1.WasResized; + end; +end; + +procedure TChildForm.FormClose(Sender: TObject; var Action: TCloseAction); +begin + Action := caFree; +end; + +procedure TChildForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + CanClose := FCanClose; + + if not(FClosing) then + begin + FClosing := True; + Visible := False; + Chromium1.CloseBrowser(True); + end; +end; + +procedure TChildForm.FormCreate(Sender: TObject); +begin + FPopUpBitmap := nil; + FPopUpRect := rect(0, 0, 0, 0); + FShowPopUp := False; + FResizing := False; + FPendingResize := False; + FCanClose := False; + FClosing := False; + FClientInitialized := False; + FResizeCS := TCriticalSection.Create; +end; + +procedure TChildForm.FormDestroy(Sender: TObject); +begin + Chromium1.ShutdownDragAndDrop; + + if (FPopUpBitmap <> nil) then FreeAndNil(FPopUpBitmap); + + if FClientInitialized and TMainForm(Owner).HandleAllocated then + PostMessage(TMainForm(Owner).Handle, CEF_CHILDDESTROYED, 0, 0); +end; + +procedure TChildForm.FormHide(Sender: TObject); +begin + Chromium1.SendFocusEvent(False); + Chromium1.WasHidden(True); +end; + +procedure TChildForm.FormShow(Sender: TObject); +begin + Chromium1.WasHidden(False); + Chromium1.SendFocusEvent(True); +end; + +procedure TChildForm.Panel1Click(Sender: TObject); +begin + Panel1.SetFocus; +end; + +procedure TChildForm.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + TempEvent : TCefMouseEvent; +begin + if (GlobalCEFApp <> nil) and (Chromium1 <> nil) then + begin + Panel1.SetFocus; + + TempEvent.x := X; + TempEvent.y := Y; + TempEvent.modifiers := getModifiers(Shift); + DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor); + Chromium1.SendMouseClickEvent(@TempEvent, GetButton(Button), False, 1); + end; +end; + +procedure TChildForm.Panel1MouseLeave(Sender: TObject); +var + TempEvent : TCefMouseEvent; + TempPoint : TPoint; +begin + if (GlobalCEFApp <> nil) and (Chromium1 <> nil) then + begin + GetCursorPos(TempPoint); + TempPoint := Panel1.ScreenToclient(TempPoint); + TempEvent.x := TempPoint.x; + TempEvent.y := TempPoint.y; + TempEvent.modifiers := GetCefMouseModifiers; + DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor); + Chromium1.SendMouseMoveEvent(@TempEvent, True); + end; +end; + +procedure TChildForm.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); +var + TempEvent : TCefMouseEvent; +begin + if (GlobalCEFApp <> nil) and (Chromium1 <> nil) then + begin + TempEvent.x := X; + TempEvent.y := Y; + TempEvent.modifiers := getModifiers(Shift); + DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor); + Chromium1.SendMouseMoveEvent(@TempEvent, False); + end; +end; + +procedure TChildForm.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + TempEvent : TCefMouseEvent; +begin + if (GlobalCEFApp <> nil) and (Chromium1 <> nil) then + begin + TempEvent.x := X; + TempEvent.y := Y; + TempEvent.modifiers := getModifiers(Shift); + DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor); + Chromium1.SendMouseClickEvent(@TempEvent, GetButton(Button), True, 1); + end; +end; + +procedure TChildForm.Panel1Resize(Sender: TObject); +begin + DoResize; +end; + +procedure TChildForm.PendingResizeMsg(var aMessage : TMessage); +begin + DoResize; +end; + +procedure TChildForm.ShowChildMsg(var aMessage : TMessage); +begin + ApplyPopupFeatures; + Show; +end; + +procedure TChildForm.DoResize; +begin + try + FResizeCS.Acquire; + + if FResizing then + FPendingResize := True + else + if Panel1.BufferIsResized then + Chromium1.Invalidate(PET_VIEW) + else + begin + FResizing := True; + Chromium1.WasResized; + end; + finally + FResizeCS.Release; + end; +end; + +procedure TChildForm.Panel1Enter(Sender: TObject); +begin + Chromium1.SendFocusEvent(True); +end; + +procedure TChildForm.Panel1Exit(Sender: TObject); +begin + Chromium1.SendFocusEvent(False); +end; + +end. diff --git a/demos/PopupBrowser/uMainForm.dfm b/demos/PopupBrowser/uMainForm.dfm new file mode 100644 index 00000000..a1347b01 --- /dev/null +++ b/demos/PopupBrowser/uMainForm.dfm @@ -0,0 +1,84 @@ +object MainForm: TMainForm + Left = 0 + Top = 0 + Caption = 'Initializing browser. Please wait...' + ClientHeight = 624 + ClientWidth = 1038 + 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 + OnDestroy = FormDestroy + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object AddressPnl: TPanel + Left = 0 + Top = 0 + Width = 1038 + Height = 30 + Align = alTop + BevelOuter = bvNone + Enabled = False + Padding.Left = 5 + Padding.Top = 5 + Padding.Right = 5 + Padding.Bottom = 5 + ShowCaption = False + TabOrder = 0 + object AddressEdt: TEdit + Left = 5 + Top = 5 + Width = 997 + Height = 20 + Margins.Right = 5 + Align = alClient + TabOrder = 0 + Text = 'file:///PopupBrowser.html' + ExplicitHeight = 21 + end + object GoBtn: TButton + Left = 1002 + Top = 5 + Width = 31 + Height = 20 + Margins.Left = 5 + Align = alRight + Caption = 'Go' + TabOrder = 1 + OnClick = GoBtnClick + end + end + object CEFWindowParent1: TCEFWindowParent + Left = 0 + Top = 30 + Width = 1038 + Height = 594 + Align = alClient + TabOrder = 1 + end + object Timer1: TTimer + Enabled = False + Interval = 300 + OnTimer = Timer1Timer + Left = 56 + Top = 88 + end + object Chromium1: TChromium + OnBeforePopup = Chromium1BeforePopup + OnAfterCreated = Chromium1AfterCreated + Left = 56 + Top = 152 + end + object AppEvents: TApplicationEvents + OnMessage = AppEventsMessage + Left = 56 + Top = 216 + end +end diff --git a/demos/PopupBrowser/uMainForm.pas b/demos/PopupBrowser/uMainForm.pas new file mode 100644 index 00000000..972d6fb4 --- /dev/null +++ b/demos/PopupBrowser/uMainForm.pas @@ -0,0 +1,345 @@ +// ************************************************************************ +// ***************************** 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 + * 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 uMainForm; + +{$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.ExtCtrls, System.SyncObjs, + {$ELSE} + Windows, Messages, SysUtils, Variants, Classes, Graphics, + Controls, Forms, Dialogs, StdCtrls, ExtCtrls, SyncObjs, + {$ENDIF} + uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFConstants, uCEFTypes, uChildForm, + Vcl.AppEvnts; + +const + CEF_CREATENEXTCHILD = WM_APP + $A50; + CEF_CHILDDESTROYED = WM_APP + $A51; + +type + TMainForm = class(TForm) + AddressPnl: TPanel; + AddressEdt: TEdit; + GoBtn: TButton; + Timer1: TTimer; + Chromium1: TChromium; + CEFWindowParent1: TCEFWindowParent; + AppEvents: TApplicationEvents; + + procedure GoBtnClick(Sender: TObject); + procedure Timer1Timer(Sender: TObject); + procedure AppEventsMessage(var Msg: tagMSG; var Handled: Boolean); + + procedure FormShow(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + + procedure Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser); + procedure Chromium1BeforePopup(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl, targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; var popupFeatures: TCefPopupFeatures; var windowInfo: TCefWindowInfo; var client: ICefClient; var settings: TCefBrowserSettings; var noJavascriptAccess: Boolean; out Result: Boolean); + + protected + FChildForm : TChildForm; + FCriticalSection : TCriticalSection; + FClosing : boolean; + + function GetPopupChildCount : integer; + + procedure ClosePopupChildren; + + procedure WMMove(var aMessage : TWMMove); message WM_MOVE; + procedure WMMoving(var aMessage : TMessage); message WM_MOVING; + procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP; + procedure WMExitMenuLoop(var aMessage: TMessage); message WM_EXITMENULOOP; + + procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED; + procedure CreateNextChildMsg(var aMessage : TMessage); message CEF_CREATENEXTCHILD; + procedure ChildDestroyedMsg(var aMessage : TMessage); message CEF_CHILDDESTROYED; + + public + function CreateClientHandler(var windowInfo : TCefWindowInfo; var client : ICefClient; const targetFrameName : string; var popupFeatures : TCefPopupFeatures) : boolean; + + property PopupChildCount : integer read GetPopupChildCount; + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +uses + uCEFApplication, uCEFMiscFunctions; + +// This is demo shows how to create popup windows in CEF. + +// You need to understand The SimpleBrowser2 and SimpleOSRBrowser demos completely before trying to understand this demo. + +// When TChromium needs to show a new popup window it executes TChromium.OnBeforePopup. + +// VCL components *MUST* be created and destroyed in the main thread but CEF executes the +// TChromium.OnBeforePopup in a different thread. + +// For this reason this demo creates a hidden popup form (TChildForm) in case CEF needs to show a popup window. +// TChromium.OnBeforePopup calls TChildForm.CreateClientHandler to initialize some parameters and create the new ICefClient. +// After that, it sends a CEF_CREATENEXTCHILD message to show the popup form and create a new one. + +// All the child forms must be correctly destroyed before closing the main form. Read the code comments in uChildForm.pas +// to know how the popup windows are destroyed. + +// The main form sends a WM_CLOSE to all active popup forms and waits until all of them have sent a CEF_CHILDDESTROYED message. + +procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + FClosing := True; + Visible := False; + + if (PopupChildCount > 0) then + begin + ClosePopupChildren; + CanClose := False; + end + else + CanClose := True; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + FClosing := False; + FCriticalSection := TCriticalSection.Create; + + Chromium1.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF); +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FreeAndNil(FCriticalSection); +end; + +procedure TMainForm.FormShow(Sender: TObject); +begin + // You *MUST* call CreateBrowser to create and initialize the browser. + // This will trigger the AfterCreated event when the browser is fully + // initialized and ready to receive commands. + + // 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; +end; + +procedure TMainForm.Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser); +begin + // Now the browser is fully initialized we can send a message to the main form to load the initial web page. + PostMessage(Handle, CEF_AFTERCREATED, 0, 0); +end; + +procedure TMainForm.Chromium1BeforePopup(Sender : TObject; + const browser : ICefBrowser; + const frame : ICefFrame; + const targetUrl : ustring; + const targetFrameName : ustring; + targetDisposition : TCefWindowOpenDisposition; + userGesture : Boolean; + var popupFeatures : TCefPopupFeatures; + var windowInfo : TCefWindowInfo; + var client : ICefClient; + var settings : TCefBrowserSettings; + var noJavascriptAccess : Boolean; + out Result : Boolean); +begin + case targetDisposition of + WOD_NEW_FOREGROUND_TAB, + WOD_NEW_BACKGROUND_TAB, + WOD_NEW_WINDOW : Result := True; // For simplicity, this demo blocks new tabs and new windows. + + WOD_NEW_POPUP : Result := not(CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures)); + + else Result := False; + end; +end; + +function TMainForm.CreateClientHandler(var windowInfo : TCefWindowInfo; + var client : ICefClient; + const targetFrameName : string; + var popupFeatures : TCefPopupFeatures) : boolean; +begin + try + FCriticalSection.Acquire; + + Result := (FChildForm <> nil) and + FChildForm.CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures) and + PostMessage(Handle, CEF_CREATENEXTCHILD, 0, 0); + finally + FCriticalSection.Release; + end; +end; + +function TMainForm.GetPopupChildCount : integer; +var + i : integer; + TempForm : TCustomForm; +begin + Result := 0; + i := pred(screen.CustomFormCount); + + while (i >= 0) do + begin + TempForm := screen.CustomForms[i]; + + // Only count the fully initialized child forms and not the one waiting to be used. + + if (TempForm is TChildForm) and + TChildForm(TempForm).ClientInitialized then + inc(Result); + + dec(i); + end; +end; + +procedure TMainForm.ClosePopupChildren; +var + i : integer; + TempForm : TCustomForm; +begin + i := pred(screen.CustomFormCount); + + while (i >= 0) do + begin + TempForm := screen.CustomForms[i]; + + // Only send WM_CLOSE to fully initialized child forms. + + if (TempForm is TChildForm) and + TChildForm(TempForm).ClientInitialized and + not(TChildForm(TempForm).Closing) then + PostMessage(TChildForm(screen.CustomForms[i]).Handle, WM_CLOSE, 0, 0); + + dec(i); + end; +end; + +procedure TMainForm.AppEventsMessage(var Msg: tagMSG; var Handled: Boolean); +begin + case Msg.message of + WM_SYSCHAR : if (screen.FocusedForm is TChildForm) then TChildForm(screen.FocusedForm).HandleSysCharMsg(Msg, Handled); + WM_SYSKEYDOWN : if (screen.FocusedForm is TChildForm) then TChildForm(screen.FocusedForm).HandleSysKeyDownMsg(Msg, Handled); + WM_SYSKEYUP : if (screen.FocusedForm is TChildForm) then TChildForm(screen.FocusedForm).HandleSysKeyUpMsg(Msg, Handled); + WM_KEYDOWN : if (screen.FocusedForm is TChildForm) then TChildForm(screen.FocusedForm).HandleKeyDownMsg(Msg, Handled); + WM_KEYUP : if (screen.FocusedForm is TChildForm) then TChildForm(screen.FocusedForm).HandleKeyUpMsg(Msg, Handled); + WM_CHAR : if (screen.FocusedForm is TChildForm) then TChildForm(screen.FocusedForm).HandleCharMsg(Msg, Handled); + WM_MOUSEWHEEL : if (screen.FocusedForm is TChildForm) then TChildForm(screen.FocusedForm).HandleMouseWheelMsg(Msg, Handled); + + else Handled := False; + end; +end; + +procedure TMainForm.BrowserCreatedMsg(var aMessage : TMessage); +begin + FChildForm := TChildForm.Create(self); + Caption := 'Popup Browser'; + AddressPnl.Enabled := True; + GoBtn.Click; +end; + +procedure TMainForm.CreateNextChildMsg(var aMessage : TMessage); +begin + try + FCriticalSection.Acquire; + + if (FChildForm <> nil) then + PostMessage(FChildForm.Handle, CEF_SHOWCHILD, 0, 0); + + FChildForm := TChildForm.Create(self); + finally + FCriticalSection.Release; + end; +end; + +procedure TMainForm.ChildDestroyedMsg(var aMessage : TMessage); +begin + if FClosing and (PopupChildCount = 0) then Close; +end; + +procedure TMainForm.GoBtnClick(Sender: TObject); +begin + // This will load the URL in the edit box + Chromium1.LoadURL(AddressEdt.Text); +end; + +procedure TMainForm.Timer1Timer(Sender: TObject); +begin + Timer1.Enabled := False; + if not(Chromium1.CreateBrowser(CEFWindowParent1)) and not(Chromium1.Initialized) then + Timer1.Enabled := True; +end; + +procedure TMainForm.WMMove(var aMessage : TWMMove); +begin + inherited; + + if (Chromium1 <> nil) then Chromium1.NotifyMoveOrResizeStarted; +end; + +procedure TMainForm.WMMoving(var aMessage : TMessage); +begin + inherited; + + if (Chromium1 <> nil) then Chromium1.NotifyMoveOrResizeStarted; +end; + +procedure TMainForm.WMEnterMenuLoop(var aMessage: TMessage); +begin + inherited; + + if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := True; +end; + +procedure TMainForm.WMExitMenuLoop(var aMessage: TMessage); +begin + inherited; + + if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := False; +end; + +end.