diff --git a/demos/Delphi_VCL/TabbedOSRBrowser/00-DeleteDCUs.bat b/demos/Delphi_VCL/TabbedOSRBrowser/00-DeleteDCUs.bat new file mode 100644 index 00000000..a9a84095 --- /dev/null +++ b/demos/Delphi_VCL/TabbedOSRBrowser/00-DeleteDCUs.bat @@ -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 diff --git a/demos/Delphi_VCL/TabbedOSRBrowser/TabbedOSRBrowser.dpr b/demos/Delphi_VCL/TabbedOSRBrowser/TabbedOSRBrowser.dpr new file mode 100644 index 00000000..6bd91f9a --- /dev/null +++ b/demos/Delphi_VCL/TabbedOSRBrowser/TabbedOSRBrowser.dpr @@ -0,0 +1,85 @@ +// ************************************************************************ +// ***************************** 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 © 2022 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 TabbedOSRBrowser; + +{$I cef.inc} + +uses + {$IFDEF DELPHI16_UP} + Vcl.Forms, + WinApi.Windows, + {$ELSE} + Forms, + Windows, + {$ENDIF } + uCEFApplication, + uCEFWorkScheduler, + uMainForm in 'uMainForm.pas' {MainForm}, + uBrowserFrame in 'uBrowserFrame.pas' {BrowserFrame: TFrame}, + uBrowserTab in 'uBrowserTab.pas', + uChildForm in 'uChildForm.pas' {ChildForm}; + +{$R *.res} + +{$IFDEF WIN32} + // CEF 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} +{$ENDIF} + +begin + CreateGlobalCEFApp; + + if GlobalCEFApp.StartMainProcess then + begin + Application.Initialize; + {$IFDEF DELPHI11_UP} + Application.MainFormOnTaskbar := True; + {$ENDIF} + Application.CreateForm(TMainForm, MainForm); + Application.Run; + + // The form needs to be destroyed *BEFORE* stopping the scheduler. + MainForm.Free; + + GlobalCEFWorkScheduler.StopScheduler; + end; + + DestroyGlobalCEFApp; + DestroyGlobalCEFWorkScheduler; +end. diff --git a/demos/Delphi_VCL/TabbedOSRBrowser/TabbedOSRBrowser.dproj b/demos/Delphi_VCL/TabbedOSRBrowser/TabbedOSRBrowser.dproj new file mode 100644 index 00000000..8943c44f --- /dev/null +++ b/demos/Delphi_VCL/TabbedOSRBrowser/TabbedOSRBrowser.dproj @@ -0,0 +1,1278 @@ + + + {2A491C1D-D0F3-4D4B-9606-F7FC09C7713E} + 19.4 + VCL + TabbedOSRBrowser.dpr + True + Debug + Win32 + 3 + 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 + + + .\$(Platform)\$(Config) + ..\..\..\bin + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + TabbedOSRBrowser + 3082 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + ..\..\..\source;$(DCC_UnitSearchPath) + + + DBXSqliteDriver;bindcompdbx;fmxase;DBXDb2Driver;DBXInterBaseDriver;vcl;DBXSybaseASEDriver;vclactnband;RESTComponents;vclFireDAC;IndyProtocols250;FireDACDb2Driver;IndyCore250;DataSnapFireDAC;svnui;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;DBXMSSQLDriver;vclimg;FireDACInfxDriver;DatasnapConnectorsFreePascal;FireDAC;FireDACMSSQLDriver;vcltouch;Componentes_UI;vcldb;bindcompfmx;svn;Detours;FireDACSqliteDriver;FireDACPgDriver;DBXOracleDriver;inetdb;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;SVGPackage;soaprtl;DbxCommonDriver;FireDACIBDriver;fmx;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;fmxdae;vclwinx;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;dbexpress;FireDACDBXDriver;vclx;bindcomp;appanalytics;dsnap;DataSnapCommon;DBXInformixDriver;FireDACCommon;bindcompvcl;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;vclie;CEF4Delphi_FMX;bindengine;DBXMySQLDriver;FireDACOracleDriver;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;DBXFirebirdDriver;DataSnapProviderClient;FireDACMongoDBDriver;FireDACCommonODBC;FireDACCommonDriver;CloudService;DataSnapClient;VisualStyles;IndySystem250;inet;DataSnapServerMidas;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(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 + + + DBXSqliteDriver;bindcompdbx;fmxase;DBXDb2Driver;DBXInterBaseDriver;vcl;DBXSybaseASEDriver;vclactnband;RESTComponents;vclFireDAC;IndyProtocols250;FireDACDb2Driver;IndyCore250;DataSnapFireDAC;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;DBXMSSQLDriver;vclimg;FireDACInfxDriver;DatasnapConnectorsFreePascal;FireDAC;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;DBXOracleDriver;inetdb;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;soaprtl;DbxCommonDriver;FireDACIBDriver;fmx;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;fmxdae;vclwinx;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;dbexpress;FireDACDBXDriver;vclx;bindcomp;appanalytics;dsnap;DataSnapCommon;DBXInformixDriver;FireDACCommon;bindcompvcl;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;vclie;CEF4Delphi_FMX;bindengine;DBXMySQLDriver;FireDACOracleDriver;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;DBXFirebirdDriver;DataSnapProviderClient;FireDACMongoDBDriver;FireDACCommonODBC;FireDACCommonDriver;CloudService;DataSnapClient;IndySystem250;inet;DataSnapServerMidas;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + 1033 + $(BDS)\bin\default_app.manifest + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + true + PerMonitorV2 + true + 1033 + + + true + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + PerMonitorV2 + + + + MainSource + + +
MainForm
+ + +
BrowserFrame
+ TFrame + + + +
ChildForm
+ dfm + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Application + + + + TabbedOSRBrowser.dpr + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + TabbedOSRBrowser.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 64 + + + classes + 64 + + + + + classes + 1 + + + classes + 1 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + + True + True + + + 12 + + + + + diff --git a/demos/Delphi_VCL/TabbedOSRBrowser/cef.inc b/demos/Delphi_VCL/TabbedOSRBrowser/cef.inc new file mode 100644 index 00000000..76ec7fb3 --- /dev/null +++ b/demos/Delphi_VCL/TabbedOSRBrowser/cef.inc @@ -0,0 +1,507 @@ +// ************************************************************************ +// ***************************** 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 Diaz Fau. All rights reserved. +// +// ************************************************************************ +// ************ vvvv Original license and comments below vvvv ************* +// ************************************************************************ +(* + * Delphi Chromium Embedded 3 + * + * Usage allowed under the restrictions of the Lesser GNU General Public License + * or alternatively the restrictions of the Mozilla Public License 1.1 + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for + * the specific language governing rights and limitations under the License. + * + * Unit owner : Henri Gourvest + * Web site : http://www.progdigy.com + * Repository : http://code.google.com/p/delphichromiumembedded/ + * Group : http://groups.google.com/group/delphichromiumembedded + * + * Embarcadero Technologies, Inc is not permitted to use or redistribute + * this source code without explicit permission. + * + *) + + // The complete list of compiler versions is here : + // http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Compiler_Versions + +{$DEFINE DELPHI_VERSION_UNKNOW} + +// 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 (First FireMonkey and 64bit compiler) +{$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} + +// Rad Studio 10.3 - Delphi Rio +{$IFDEF VER330} + {$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} + {$DEFINE DELPHI26_UP} +{$ENDIF} + +// Rad Studio 10.4 - Delphi Sydney +{$IFDEF VER340} + {$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} + {$DEFINE DELPHI26_UP} + {$DEFINE DELPHI27_UP} +{$ENDIF} + +// Rad Studio 11.0 - Delphi Alexandria +{$IFDEF VER350} + {$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} + {$DEFINE DELPHI26_UP} + {$DEFINE DELPHI27_UP} + {$DEFINE DELPHI28_UP} +{$ENDIF} + +{$IFDEF FPC} + {$DEFINE SUPPORTS_INLINE} + {$IF DEFINED(FPC_FULLVERSION) AND (FPC_FULLVERSION >= 30200)} + {$DEFINE FPC_VER_320} + {$IFEND} +{$ELSE} + {$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} + {$DEFINE DELPHI26_UP} + {$DEFINE DELPHI27_UP} + {$DEFINE DELPHI28_UP} + {$ENDIF} +{$ENDIF} + +{$IFDEF DELPHI9_UP} + {$DEFINE SUPPORTS_INLINE} +{$ENDIF} + +{$IF DEFINED(CPUX32) OR + DEFINED(CPU32) OR + DEFINED(CPU32BITS) OR + DEFINED(CPUARM32) OR + DEFINED(WIN32) OR + DEFINED(IOS32) OR + DEFINED(MACOS32) OR + DEFINED(LINUX32) OR + DEFINED(POSIX32) OR + DEFINED(ANDROID32)} + {$DEFINE TARGET_32BITS} +{$ELSE} + {$IF DEFINED(CPUX64) OR + DEFINED(CPU64) OR + DEFINED(CPU64BITS) OR + DEFINED(CPUARM64) OR + DEFINED(WIN64) OR + DEFINED(IOS64) OR + DEFINED(MACOS64) OR + DEFINED(LINUX64) OR + DEFINED(POSIX64) OR + DEFINED(ANDROID64)} + {$DEFINE TARGET_64BITS} + {$IFEND} +{$IFEND} + +// Delphi uses MACOS for the new MacOSX and DARWIN is not defined +// FPC uses DARWIN for the new MacOSX and MACOS is defined for the classic Macintosh OS (System 7) +// We define MACOSX to avoid conflicts in both situations +{$IFDEF FPC} + {$IFDEF DARWIN} + {$DEFINE MACOSX} + {$ENDIF} +{$ELSE} + {$IFDEF MACOS} + {$DEFINE MACOSX} + {$ENDIF} +{$ENDIF} diff --git a/demos/Delphi_VCL/TabbedOSRBrowser/uBrowserFrame.dfm b/demos/Delphi_VCL/TabbedOSRBrowser/uBrowserFrame.dfm new file mode 100644 index 00000000..48d8eb7a --- /dev/null +++ b/demos/Delphi_VCL/TabbedOSRBrowser/uBrowserFrame.dfm @@ -0,0 +1,248 @@ +object BrowserFrame: TBrowserFrame + Left = 0 + Top = 0 + Width = 932 + Height = 670 + TabOrder = 0 + object NavControlPnl: TPanel + Left = 0 + Top = 0 + Width = 932 + Height = 35 + Align = alTop + BevelOuter = bvNone + Enabled = False + TabOrder = 1 + object NavButtonPnl: TPanel + Left = 0 + Top = 0 + Width = 123 + Height = 35 + Align = alLeft + BevelOuter = bvNone + Padding.Left = 5 + Padding.Top = 5 + Padding.Right = 5 + Padding.Bottom = 5 + TabOrder = 0 + object BackBtn: TButton + Left = 5 + Top = 5 + Width = 25 + Height = 25 + Caption = '3' + Font.Charset = SYMBOL_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = 'Webdings' + Font.Style = [] + ParentFont = False + TabOrder = 0 + OnClick = BackBtnClick + end + object ForwardBtn: TButton + Left = 35 + Top = 5 + Width = 25 + Height = 25 + Caption = '4' + Font.Charset = SYMBOL_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = 'Webdings' + Font.Style = [] + ParentFont = False + TabOrder = 1 + OnClick = ForwardBtnClick + end + object ReloadBtn: TButton + Left = 64 + Top = 5 + Width = 25 + Height = 25 + Caption = 'q' + Font.Charset = SYMBOL_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = 'Webdings' + Font.Style = [] + ParentFont = False + TabOrder = 2 + OnClick = ReloadBtnClick + end + object StopBtn: TButton + Left = 93 + Top = 5 + Width = 25 + Height = 25 + Caption = '=' + Font.Charset = SYMBOL_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = 'Webdings' + Font.Style = [] + ParentFont = False + TabOrder = 3 + OnClick = StopBtnClick + end + end + object URLEditPnl: TPanel + Left = 123 + Top = 0 + Width = 774 + Height = 35 + Align = alClient + BevelOuter = bvNone + TabOrder = 1 + DesignSize = ( + 774 + 35) + object URLCbx: TComboBox + Left = 2 + Top = 7 + Width = 770 + Height = 23 + Anchors = [akLeft, akTop, akRight] + ItemIndex = 0 + TabOrder = 0 + Text = 'https://www.google.com' + Items.Strings = ( + 'https://www.google.com' + + 'https://www.whatismybrowser.com/detect/what-http-headers-is-my-b' + + 'rowser-sending' + 'https://www.w3schools.com/js/tryit.asp?filename=tryjs_win_close' + 'https://www.w3schools.com/js/tryit.asp?filename=tryjs_alert' + 'https://www.w3schools.com/js/tryit.asp?filename=tryjs_loc_assign' + + 'https://www.w3schools.com/jsref/tryit.asp?filename=tryjsref_styl' + + 'e_backgroundcolor' + 'https://www.w3schools.com/html/html5_video.asp' + 'http://www.adobe.com/software/flash/about/' + 'http://isflashinstalled.com/' + 'https://helpx.adobe.com/flash-player.html' + 'https://www.ultrasounds.com/' + 'https://www.whatismybrowser.com/detect/is-flash-installed' + 'http://html5test.com/' + + 'https://webrtc.github.io/samples/src/content/devices/input-outpu' + + 't/' + 'https://test.webrtc.org/' + 'https://www.w3schools.com/' + 'http://webglsamples.org/' + 'https://get.webgl.org/' + 'https://www.briskbard.com' + 'https://www.youtube.com' + 'https://html5demos.com/drag/' + + 'https://developers.google.com/maps/documentation/javascript/exam' + + 'ples/streetview-embed?hl=fr' + + 'https://www.w3schools.com/Tags/tryit.asp?filename=tryhtml_iframe' + + '_name' + + 'http://www-db.deis.unibo.it/courses/TW/DOCS/w3schools/html/tryit' + + '.asp-filename=tryhtml5_html_manifest.html' + 'https://www.browserleaks.com/webrtc' + 'https://frames-per-second.appspot.com/' + 'chrome://version/' + 'chrome://net-internals/' + 'chrome://tracing/' + 'chrome://appcache-internals/' + 'chrome://blob-internals/' + 'chrome://view-http-cache/' + 'chrome://credits/' + 'chrome://histograms/' + 'chrome://media-internals/' + 'chrome://kill' + 'chrome://crash' + 'chrome://hang' + 'chrome://shorthang' + 'chrome://gpuclean' + 'chrome://gpucrash' + 'chrome://gpuhang' + 'chrome://extensions-support' + 'chrome://process-internals') + end + end + object ConfigPnl: TPanel + Left = 897 + Top = 0 + Width = 35 + Height = 35 + Align = alRight + BevelOuter = bvNone + TabOrder = 2 + object GoBtn: TButton + Left = 5 + Top = 5 + Width = 25 + Height = 25 + Caption = #9658 + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -17 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + TabOrder = 0 + OnClick = GoBtnClick + end + end + end + object StatusBar1: TStatusBar + Left = 0 + Top = 651 + Width = 932 + Height = 19 + Panels = < + item + Width = 500 + end> + end + object Panel1: TBufferPanel + Left = 0 + Top = 35 + Width = 932 + Height = 616 + OnIMECancelComposition = Panel1IMECancelComposition + OnIMECommitText = Panel1IMECommitText + OnIMESetComposition = Panel1IMESetComposition + Align = alClient + Caption = 'Panel1' + TabOrder = 0 + TabStop = True + OnClick = Panel1Click + OnEnter = Panel1Enter + OnExit = Panel1Exit + OnMouseDown = Panel1MouseDown + OnMouseMove = Panel1MouseMove + OnMouseUp = Panel1MouseUp + OnResize = Panel1Resize + OnMouseLeave = Panel1MouseLeave + ExplicitTop = 29 + end + object chrmosr: TChromium + OnLoadError = chrmosrLoadError + OnLoadingStateChange = chrmosrLoadingStateChange + OnAddressChange = chrmosrAddressChange + OnTitleChange = chrmosrTitleChange + OnTooltip = chrmosrTooltip + OnStatusMessage = chrmosrStatusMessage + OnCursorChange = chrmosrCursorChange + OnBeforePopup = chrmosrBeforePopup + OnAfterCreated = chrmosrAfterCreated + OnBeforeClose = chrmosrBeforeClose + OnOpenUrlFromTab = chrmosrOpenUrlFromTab + OnRenderProcessTerminated = chrmosrRenderProcessTerminated + OnGetViewRect = chrmosrGetViewRect + OnGetScreenPoint = chrmosrGetScreenPoint + OnGetScreenInfo = chrmosrGetScreenInfo + OnPopupShow = chrmosrPopupShow + OnPopupSize = chrmosrPopupSize + OnPaint = chrmosrPaint + OnIMECompositionRangeChanged = chrmosrIMECompositionRangeChanged + Left = 40 + Top = 72 + end +end diff --git a/demos/Delphi_VCL/TabbedOSRBrowser/uBrowserFrame.pas b/demos/Delphi_VCL/TabbedOSRBrowser/uBrowserFrame.pas new file mode 100644 index 00000000..e67b23ee --- /dev/null +++ b/demos/Delphi_VCL/TabbedOSRBrowser/uBrowserFrame.pas @@ -0,0 +1,999 @@ +// ************************************************************************ +// ***************************** 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 © 2022 Salvador Diaz Fau. All rights reserved. +// +// ************************************************************************ +// ************ vvvv Original license and comments below vvvv ************* +// ************************************************************************ +(* + * Delphi Chromium Embedded 3 + * + * Usage allowed under the restrictions of the Lesser GNU General Public License + * or alternatively the restrictions of the Mozilla Public License 1.1 + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for + * the specific language governing rights and limitations under the License. + * + * Unit owner : Henri Gourvest + * Web site : http://www.progdigy.com + * Repository : http://code.google.com/p/delphichromiumembedded/ + * Group : http://groups.google.com/group/delphichromiumembedded + * + * Embarcadero Technologies, Inc is not permitted to use or redistribute + * this source code without explicit permission. + * + *) + +unit uBrowserFrame; + +{$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.ExtCtrls, Vcl.ComCtrls, Vcl.StdCtrls, System.SyncObjs, + {$ELSE} + Windows, Messages, SysUtils, Variants, + Classes, Graphics, Controls, Forms, Dialogs, + ExtCtrls, ComCtrls, StdCtrls, SyncObjs, + {$ENDIF} + uCEFWinControl, uCEFWindowParent, uCEFChromiumCore, uCEFChromium, + uCEFInterfaces, uCEFTypes, uCEFConstants, uCEFBufferPanel; + +const + CEF_UPDATECAPTION = WM_APP + $A55; + CEF_UPDATEADDRESS = WM_APP + $A56; + CEF_UPDATESTATE = WM_APP + $A57; + CEF_UPDATESTATUSTEXT = WM_APP + $A58; + + +type + TBrowserTitleEvent = procedure(Sender: TObject; const aTitle : string) of object; + + TBrowserFrame = class(TFrame) + NavControlPnl: TPanel; + NavButtonPnl: TPanel; + BackBtn: TButton; + ForwardBtn: TButton; + ReloadBtn: TButton; + StopBtn: TButton; + URLEditPnl: TPanel; + URLCbx: TComboBox; + ConfigPnl: TPanel; + GoBtn: TButton; + StatusBar1: TStatusBar; + chrmosr: 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 Panel1IMECancelComposition(Sender: TObject); + procedure Panel1IMECommitText(Sender: TObject; const aText: ustring; const replacement_range: PCefRange; relative_cursor_pos: Integer); + procedure Panel1IMESetComposition(Sender: TObject; const aText: ustring; const underlines: TCefCompositionUnderlineDynArray; const replacement_range, selection_range: TCefRange); + + procedure chrmosrPaint(Sender: TObject; const browser: ICefBrowser; type_: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; width, height: Integer); + procedure chrmosrCursorChange(Sender: TObject; const browser: ICefBrowser; cursor_: TCefCursorHandle; 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; show: Boolean); + procedure chrmosrPopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect); + procedure chrmosrAfterCreated(Sender: TObject; const browser: ICefBrowser); + procedure chrmosrAddressChange(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const url: ustring); + procedure chrmosrBeforeClose(Sender: TObject; const browser: ICefBrowser); + procedure chrmosrLoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring); + procedure chrmosrLoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean); + procedure chrmosrStatusMessage(Sender: TObject; const browser: ICefBrowser; const value: ustring); + procedure chrmosrTitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring); + 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, Result: Boolean); + procedure chrmosrOpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; out Result: Boolean); + procedure chrmosrTooltip(Sender: TObject; const browser: ICefBrowser; var text: ustring; out Result: Boolean); + procedure chrmosrIMECompositionRangeChanged(Sender: TObject; const browser: ICefBrowser; const selected_range: PCefRange; character_boundsCount: NativeUInt; const character_bounds: PCefRect); + procedure chrmosrRenderProcessTerminated(Sender: TObject; const browser: ICefBrowser; status: TCefTerminationStatus); + + procedure BackBtnClick(Sender: TObject); + procedure ForwardBtnClick(Sender: TObject); + procedure ReloadBtnClick(Sender: TObject); + procedure StopBtnClick(Sender: TObject); + procedure GoBtnClick(Sender: TObject); + + protected + FHomepage : string; + FPopUpBitmap : TBitmap; + FPopUpRect : TRect; + FShowPopUp : boolean; + FResizing : boolean; + FPendingResize : boolean; + FClosing : boolean; + FResizeCS : TCriticalSection; + FTabVisible : boolean; + FClientInitialized : boolean; + + FLastClickCount : integer; + FLastClickTime : integer; + FLastClickPoint : TPoint; + FLastClickButton : TMouseButton; + + FOnBrowserCreated : TNotifyEvent; + FOnBrowserDestroyed : TNotifyEvent; + FOnBrowserTitleChange : TBrowserTitleEvent; + + function GetInitialized : boolean; + + function getModifiers(Shift: TShiftState): TCefEventFlags; + function GetButton(Button: TMouseButton): TCefMouseButtonType; + procedure DoResize; + procedure InitializeLastClick; + function CancelPreviousClick(x, y : integer; var aCurrentTime : integer) : boolean; + + procedure PendingResizeMsg(var aMessage : TMessage); message CEF_PENDINGRESIZE; + + public + constructor Create(AOwner : TComponent); override; + destructor Destroy; override; + procedure NotifyMoveOrResizeStarted; + procedure CreateBrowser; + procedure CloseBrowser; + procedure ShowBrowser; + procedure HideBrowser; + function CreateClientHandler(var windowInfo : TCefWindowInfo; var client : ICefClient; const targetFrameName : string; const popupFeatures : TCefPopupFeatures) : boolean; + procedure HandleBrowserMessage(var Msg: tagMSG; var Handled: Boolean); + + property Initialized : boolean read GetInitialized; + property ClientInitialized : boolean read FClientInitialized; + property Closing : boolean read FClosing; + property Homepage : string read FHomepage write FHomepage; + property OnBrowserCreated : TNotifyEvent read FOnBrowserCreated write FOnBrowserCreated; + property OnBrowserDestroyed : TNotifyEvent read FOnBrowserDestroyed write FOnBrowserDestroyed; + property OnBrowserTitleChange : TBrowserTitleEvent read FOnBrowserTitleChange write FOnBrowserTitleChange; + end; + +implementation + +{$R *.dfm} + +uses + {$IFDEF DELPHI16_UP} + System.Math, + {$ELSE} + Math, + {$ENDIF} + uCEFMiscFunctions, uCEFApplication, uBrowserTab; + +// The TChromium events are executed in a CEF thread and we should only update the +// GUI controls in the main application thread. + +// This demo saves all the information in those events using a synchronization +// object and sends a custom message to update the GUI in the main application thread. + +// Destruction steps +// ================= +// 1. TBrowserFrame.CloseBrowser calls TChromium.CloseBrowser which triggers the +// TChromium.OnClose event and the internal browser is destroyed immediately. +// 2. TChromium.OnBeforeClose is triggered because the internal browser was destroyed +// and we send a CEF_DESTROYTAB message with the TabID to the main form. + +constructor TBrowserFrame.Create(AOwner : TComponent); +begin + inherited Create(AOwner); + + FPopUpBitmap := nil; + FPopUpRect := rect(0, 0, 0, 0); + FShowPopUp := False; + FResizing := False; + FPendingResize := False; + FClosing := False; + FTabVisible := True; + FClientInitialized := False; + FResizeCS := TCriticalSection.Create; + + InitializeLastClick; + + FHomepage := ''; + FOnBrowserDestroyed := nil; + FOnBrowserTitleChange := nil; + FOnBrowserCreated := nil; +end; + +destructor TBrowserFrame.Destroy; +begin + chrmosr.ShutdownDragAndDrop; + + if (FPopUpBitmap <> nil) then FreeAndNil(FPopUpBitmap); + if (FResizeCS <> nil) then FreeAndNil(FResizeCS); + + inherited Destroy; +end; + +procedure TBrowserFrame.HandleBrowserMessage(var Msg: tagMSG; var Handled: Boolean); +var + TempKeyEvent : TCefKeyEvent; + TempMouseEvent : TCefMouseEvent; + TempPoint : TPoint; +begin + case Msg.message of + WM_SYSCHAR : + 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(True); + TempKeyEvent.character := #0; + TempKeyEvent.unmodified_character := #0; + TempKeyEvent.focus_on_editable_field := ord(False); + + CefCheckAltGrPressed(Msg.wParam, TempKeyEvent); + chrmosr.SendKeyEvent(@TempKeyEvent); + end; + + WM_SYSKEYDOWN : + if Panel1.Focused 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); + + chrmosr.SendKeyEvent(@TempKeyEvent); + end; + + WM_SYSKEYUP : + if Panel1.Focused 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); + + chrmosr.SendKeyEvent(@TempKeyEvent); + end; + + WM_KEYDOWN : + if Panel1.Focused 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); + + chrmosr.SendKeyEvent(@TempKeyEvent); + Handled := (Msg.wParam in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_TAB]); + end; + + WM_KEYUP : + if Panel1.Focused 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); + + chrmosr.SendKeyEvent(@TempKeyEvent); + Handled := (Msg.wParam <> VK_MENU); + end; + + WM_CHAR : + 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); + + CefCheckAltGrPressed(Msg.wParam, TempKeyEvent); + chrmosr.SendKeyEvent(@TempKeyEvent); + Handled := True; + end; + + WM_MOUSEWHEEL : + if Panel1.Focused then + begin + GetCursorPos(TempPoint); + TempPoint := Panel1.ScreenToclient(TempPoint); + TempMouseEvent.x := TempPoint.x; + TempMouseEvent.y := TempPoint.y; + TempMouseEvent.modifiers := GetCefMouseModifiers(Msg.wParam); + + DeviceToLogical(TempMouseEvent, Panel1.ScreenScale); + + if CefIsKeyDown(VK_SHIFT) then + chrmosr.SendMouseWheelEvent(@TempMouseEvent, smallint(Msg.wParam shr 16), 0) + else + chrmosr.SendMouseWheelEvent(@TempMouseEvent, 0, smallint(Msg.wParam shr 16)); + end; + end; +end; + +function TBrowserFrame.GetInitialized : boolean; +begin + Result := chrmosr.Initialized; +end; + +procedure TBrowserFrame.NotifyMoveOrResizeStarted; +begin + chrmosr.NotifyMoveOrResizeStarted; +end; + +procedure TBrowserFrame.Panel1Click(Sender: TObject); +begin + Panel1.SetFocus; +end; + +procedure TBrowserFrame.Panel1Enter(Sender: TObject); +begin + chrmosr.SetFocus(True); +end; + +procedure TBrowserFrame.Panel1Exit(Sender: TObject); +begin + chrmosr.SetFocus(False); +end; + +procedure TBrowserFrame.Panel1IMECancelComposition(Sender: TObject); +begin + chrmosr.IMECancelComposition; +end; + +procedure TBrowserFrame.Panel1IMECommitText(Sender: TObject; + const aText: ustring; const replacement_range: PCefRange; + relative_cursor_pos: Integer); +begin + chrmosr.IMECommitText(aText, replacement_range, relative_cursor_pos); +end; + +procedure TBrowserFrame.Panel1IMESetComposition(Sender: TObject; + const aText: ustring; const underlines: TCefCompositionUnderlineDynArray; + const replacement_range, selection_range: TCefRange); +begin + chrmosr.IMESetComposition(aText, underlines, @replacement_range, @selection_range); +end; + +procedure TBrowserFrame.Panel1MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + TempEvent : TCefMouseEvent; + TempTime : integer; +begin + {$IFDEF DELPHI14_UP} + if (ssTouch in Shift) then exit; + {$ENDIF} + + Panel1.SetFocus; + + if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then + inc(FLastClickCount) + else + begin + FLastClickPoint.x := x; + FLastClickPoint.y := y; + FLastClickCount := 1; + end; + + FLastClickTime := TempTime; + FLastClickButton := Button; + + TempEvent.x := X; + TempEvent.y := Y; + TempEvent.modifiers := getModifiers(Shift); + DeviceToLogical(TempEvent, Panel1.ScreenScale); + chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount); +end; + +procedure TBrowserFrame.Panel1MouseLeave(Sender: TObject); +var + TempEvent : TCefMouseEvent; + TempPoint : TPoint; + TempTime : integer; +begin + GetCursorPos(TempPoint); + TempPoint := Panel1.ScreenToclient(TempPoint); + + if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick; + + TempEvent.x := TempPoint.x; + TempEvent.y := TempPoint.y; + TempEvent.modifiers := GetCefMouseModifiers; + DeviceToLogical(TempEvent, Panel1.ScreenScale); + chrmosr.SendMouseMoveEvent(@TempEvent, True); +end; + +procedure TBrowserFrame.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); +var + TempEvent : TCefMouseEvent; + TempTime : integer; +begin + {$IFDEF DELPHI14_UP} + if (ssTouch in Shift) then exit; + {$ENDIF} + + if CancelPreviousClick(x, y, TempTime) then InitializeLastClick; + + TempEvent.x := X; + TempEvent.y := Y; + TempEvent.modifiers := getModifiers(Shift); + DeviceToLogical(TempEvent, Panel1.ScreenScale); + chrmosr.SendMouseMoveEvent(@TempEvent, False); +end; + +procedure TBrowserFrame.Panel1MouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + TempEvent : TCefMouseEvent; +begin + {$IFDEF DELPHI14_UP} + if (ssTouch in Shift) then exit; + {$ENDIF} + + TempEvent.x := X; + TempEvent.y := Y; + TempEvent.modifiers := getModifiers(Shift); + DeviceToLogical(TempEvent, Panel1.ScreenScale); + chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount); +end; + +procedure TBrowserFrame.Panel1Resize(Sender: TObject); +begin + DoResize; +end; + +procedure TBrowserFrame.ReloadBtnClick(Sender: TObject); +begin + chrmosr.Reload; +end; + +procedure TBrowserFrame.StopBtnClick(Sender: TObject); +begin + chrmosr.StopLoad; +end; + +procedure TBrowserFrame.CreateBrowser; +begin + chrmosr.DefaultURL := FHomepage; + + // opaque white background color + chrmosr.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF); + + Panel1.CreateIMEHandler; + + if chrmosr.CreateBrowser(nil, '') then + chrmosr.InitializeDragAndDrop(Panel1); +end; + +procedure TBrowserFrame.CloseBrowser; +begin + if not(FClosing) then + begin + FClosing := True; + NavControlPnl.Enabled := False; + chrmosr.CloseBrowser(True); + end; +end; + +procedure TBrowserFrame.ShowBrowser; +begin + if chrmosr.Initialized and not(FTabVisible) then + begin + chrmosr.WasHidden(False); + chrmosr.WasResized; + chrmosr.SetFocus(True); + FTabVisible := True; + end; +end; + +procedure TBrowserFrame.HideBrowser; +begin + if chrmosr.Initialized and FTabVisible then + begin + chrmosr.SetFocus(False); + chrmosr.WasHidden(True); + FTabVisible := False; + end; +end; + +procedure TBrowserFrame.ForwardBtnClick(Sender: TObject); +begin + chrmosr.GoForward; +end; + +procedure TBrowserFrame.GoBtnClick(Sender: TObject); +begin + chrmosr.LoadURL(URLCbx.Text); +end; + +procedure TBrowserFrame.chrmosrAfterCreated(Sender: TObject; const browser: ICefBrowser); +begin + NavControlPnl.Enabled := True; + if assigned(FOnBrowserCreated) then + FOnBrowserCreated(self); +end; + +procedure TBrowserFrame.BackBtnClick(Sender: TObject); +begin + chrmosr.GoBack; +end; + +procedure TBrowserFrame.chrmosrAddressChange( Sender : TObject; + const browser : ICefBrowser; + const frame : ICefFrame; + const url : ustring); +begin + if (URLCbx.Items.IndexOf(url) < 0) then + URLCbx.Items.Add(url); + + URLCbx.Text := url; +end; + +procedure TBrowserFrame.chrmosrBeforeClose(Sender: TObject; const browser: ICefBrowser); +begin + if assigned(FOnBrowserDestroyed) then + FOnBrowserDestroyed(self); +end; + +procedure TBrowserFrame.chrmosrBeforePopup( Sender : TObject; + const browser : ICefBrowser; + const frame : ICefFrame; + const targetUrl : ustring; + const 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 + Result := not(assigned(Parent) and + (Parent is TBrowserTab) and + TBrowserTab(Parent).DoOnBeforePopup(windowInfo, client, targetFrameName, popupFeatures, targetDisposition)); +end; + +procedure TBrowserFrame.chrmosrOpenUrlFromTab( Sender : TObject; + const browser : ICefBrowser; + const frame : ICefFrame; + const targetUrl : ustring; + targetDisposition : TCefWindowOpenDisposition; + userGesture : Boolean; + out Result : Boolean); +begin + Result := assigned(Parent) and + (Parent is TBrowserTab) and + TBrowserTab(Parent).DoOpenUrlFromTab(targetUrl, targetDisposition); +end; + +procedure TBrowserFrame.chrmosrPaint(Sender: TObject; + const browser: ICefBrowser; type_: 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 Panel1.BeginBufferDraw then + begin + if (type_ = 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 + 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; + end; + + Panel1.EndBufferDraw; + Panel1.InvalidatePanel; + + if (type_ = 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 TBrowserFrame.chrmosrPopupShow(Sender: TObject; + const browser: ICefBrowser; show: Boolean); +begin + if show then + FShowPopUp := True + else + begin + FShowPopUp := False; + FPopUpRect := rect(0, 0, 0, 0); + + if (chrmosr <> nil) then chrmosr.Invalidate(PET_VIEW); + end; +end; + +procedure TBrowserFrame.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 TBrowserFrame.chrmosrRenderProcessTerminated(Sender: TObject; + const browser: ICefBrowser; status: TCefTerminationStatus); +begin + StatusBar1.Panels[0].Text := 'The render process crashed!'; +end; + +procedure TBrowserFrame.chrmosrCursorChange(Sender: TObject; + const browser: ICefBrowser; cursor_: TCefCursorHandle; + cursorType: TCefCursorType; const customCursorInfo: PCefCursorInfo; + var aResult: Boolean); +begin + Panel1.Cursor := CefCursorToWindowsCursor(cursorType); + aResult := True; +end; + +procedure TBrowserFrame.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 TBrowserFrame.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 TBrowserFrame.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 TBrowserFrame.chrmosrIMECompositionRangeChanged(Sender: TObject; + const browser: ICefBrowser; const selected_range: PCefRange; + character_boundsCount: NativeUInt; const character_bounds: PCefRect); +var + TempDeviceBounds : TCefRectDynArray; + TempPRect : PCefRect; + i : NativeUInt; + TempScale : single; +begin + TempDeviceBounds := nil; + + try + if (character_boundsCount > 0) then + begin + SetLength(TempDeviceBounds, character_boundsCount); + + i := 0; + TempPRect := character_bounds; + TempScale := Panel1.ScreenScale; + + while (i < character_boundsCount) do + begin + TempDeviceBounds[i] := TempPRect^; + LogicalToDevice(TempDeviceBounds[i], TempScale); + + inc(TempPRect); + inc(i); + end; + end; + + Panel1.ChangeCompositionRange(selected_range^, TempDeviceBounds); + finally + if (TempDeviceBounds <> nil) then + begin + Finalize(TempDeviceBounds); + TempDeviceBounds := nil; + end; + end; +end; + +procedure TBrowserFrame.chrmosrLoadError( Sender : TObject; + const browser : ICefBrowser; + const frame : ICefFrame; + errorCode : Integer; + const errorText : ustring; + const failedUrl : ustring); +var + TempString : string; +begin + if (errorCode = ERR_ABORTED) then exit; + + TempString := '' + + '

Failed to load URL ' + failedUrl + + ' with error ' + errorText + + ' (' + inttostr(errorCode) + ').

'; + + chrmosr.LoadString(TempString, frame); +end; + +procedure TBrowserFrame.chrmosrLoadingStateChange( Sender : TObject; + const browser : ICefBrowser; + isLoading : Boolean; + canGoBack : Boolean; + canGoForward : Boolean); +begin + BackBtn.Enabled := canGoBack; + ForwardBtn.Enabled := canGoForward; + + if isLoading then + begin + ReloadBtn.Enabled := False; + StopBtn.Enabled := True; + end + else + begin + ReloadBtn.Enabled := True; + StopBtn.Enabled := False; + end; +end; + +procedure TBrowserFrame.chrmosrStatusMessage( Sender : TObject; + const browser : ICefBrowser; + const value : ustring); +begin + StatusBar1.Panels[0].Text := value; +end; + +procedure TBrowserFrame.chrmosrTitleChange( Sender : TObject; + const browser : ICefBrowser; + const title : ustring); +var + TempTitle : string; +begin + if (length(title) > 0) then + TempTitle := title + else + TempTitle := chrmosr.DocumentURL; + + if assigned(FOnBrowserTitleChange) then + FOnBrowserTitleChange(Sender, TempTitle); +end; + +procedure TBrowserFrame.chrmosrTooltip(Sender: TObject; + const browser: ICefBrowser; var text: ustring; out Result: Boolean); +begin + Panel1.hint := text; + Panel1.ShowHint := (length(text) > 0); + Result := True; +end; + +function TBrowserFrame.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 TBrowserFrame.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 TBrowserFrame.PendingResizeMsg(var aMessage : TMessage); +begin + DoResize; +end; + +procedure TBrowserFrame.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 TBrowserFrame.InitializeLastClick; +begin + FLastClickCount := 1; + FLastClickTime := 0; + FLastClickPoint.x := 0; + FLastClickPoint.y := 0; + FLastClickButton := mbLeft; +end; + +function TBrowserFrame.CancelPreviousClick(x, y : integer; var aCurrentTime : integer) : boolean; +begin + aCurrentTime := GetMessageTime; + + Result := (abs(FLastClickPoint.x - x) > (GetSystemMetrics(SM_CXDOUBLECLK) div 2)) or + (abs(FLastClickPoint.y - y) > (GetSystemMetrics(SM_CYDOUBLECLK) div 2)) or + (cardinal(aCurrentTime - FLastClickTime) > GetDoubleClickTime); +end; + +function TBrowserFrame.CreateClientHandler(var windowInfo : TCefWindowInfo; + var client : ICefClient; + const targetFrameName : string; + const popupFeatures : TCefPopupFeatures) : boolean; +begin + WindowInfoAsWindowless(windowInfo, 0, targetFrameName); + FClientInitialized := chrmosr.CreateClientHandler(client); + Result := FClientInitialized; +end; + +end. + + diff --git a/demos/Delphi_VCL/TabbedOSRBrowser/uBrowserTab.pas b/demos/Delphi_VCL/TabbedOSRBrowser/uBrowserTab.pas new file mode 100644 index 00000000..50909bec --- /dev/null +++ b/demos/Delphi_VCL/TabbedOSRBrowser/uBrowserTab.pas @@ -0,0 +1,244 @@ +// ************************************************************************ +// ***************************** 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 © 2022 Salvador Diaz Fau. All rights reserved. +// +// ************************************************************************ +// ************ vvvv Original license and comments below vvvv ************* +// ************************************************************************ +(* + * Delphi Chromium Embedded 3 + * + * Usage allowed under the restrictions of the Lesser GNU General Public License + * or alternatively the restrictions of the Mozilla Public License 1.1 + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for + * the specific language governing rights and limitations under the License. + * + * Unit owner : Henri Gourvest + * Web site : http://www.progdigy.com + * Repository : http://code.google.com/p/delphichromiumembedded/ + * Group : http://groups.google.com/group/delphichromiumembedded + * + * Embarcadero Technologies, Inc is not permitted to use or redistribute + * this source code without explicit permission. + * + *) + +unit uBrowserTab; + +{$I cef.inc} + +interface + +uses + {$IFDEF DELPHI16_UP} + Winapi.Windows, System.Classes, Winapi.Messages, Vcl.ComCtrls, Vcl.Controls, + Vcl.Forms, System.SysUtils, + {$ELSE} + Windows, Classes, Messages, ComCtrls, Controls, + Forms, SysUtils, + {$ENDIF} + uCEFInterfaces, uCEFTypes, uBrowserFrame; + +type + TBrowserTab = class(TTabSheet) + protected + FBrowserFrame : TBrowserFrame; + FTabID : cardinal; + + function GetParentForm : TCustomForm; + function GetInitialized : boolean; + function GetClosing : boolean; + + function PostFormMessage(aMsg : cardinal; aWParam : WPARAM = 0; aLParam : LPARAM = 0) : boolean; + + procedure BrowserFrame_OnBrowserCreated(Sender: TObject); + procedure BrowserFrame_OnBrowserDestroyed(Sender: TObject); + procedure BrowserFrame_OnBrowserTitleChange(Sender: TObject; const aTitle : string); + + property ParentForm : TCustomForm read GetParentForm; + + public + constructor Create(AOwner: TComponent; aTabID : cardinal; const aCaption : string); reintroduce; + procedure NotifyMoveOrResizeStarted; + procedure CreateFrame(const aHomepage : string = ''); + procedure CreateBrowser(const aHomepage : string); + procedure CloseBrowser; + procedure ShowBrowser; + procedure HideBrowser; + procedure HandleBrowserMessage(var Msg: tagMSG; var Handled: Boolean); + function CreateClientHandler(var windowInfo : TCefWindowInfo; var client : ICefClient; const targetFrameName : string; const popupFeatures : TCefPopupFeatures) : boolean; + function DoOnBeforePopup(var windowInfo : TCefWindowInfo; var client : ICefClient; const targetFrameName : string; const popupFeatures : TCefPopupFeatures; targetDisposition : TCefWindowOpenDisposition) : boolean; + function DoOpenUrlFromTab(const targetUrl : string; targetDisposition : TCefWindowOpenDisposition) : boolean; + + property TabID : cardinal read FTabID; + property Closing : boolean read GetClosing; + property Initialized : boolean read GetInitialized; + end; + +implementation + +uses + uMainForm; + +constructor TBrowserTab.Create(AOwner: TComponent; aTabID : cardinal; const aCaption : string); +begin + inherited Create(AOwner); + + FTabID := aTabID; + Caption := aCaption; + FBrowserFrame := nil; +end; + +function TBrowserTab.GetParentForm : TCustomForm; +var + TempParent : TWinControl; +begin + TempParent := Parent; + + while (TempParent <> nil) and not(TempParent is TCustomForm) do + TempParent := TempParent.Parent; + + if (TempParent <> nil) and (TempParent is TCustomForm) then + Result := TCustomForm(TempParent) + else + Result := nil; +end; + +function TBrowserTab.GetInitialized : boolean; +begin + Result := (FBrowserFrame <> nil) and + FBrowserFrame.Initialized; +end; + +function TBrowserTab.GetClosing : boolean; +begin + Result := (FBrowserFrame <> nil) and + FBrowserFrame.Closing; +end; + +function TBrowserTab.PostFormMessage(aMsg : cardinal; aWParam : WPARAM; aLParam : LPARAM) : boolean; +var + TempForm : TCustomForm; +begin + TempForm := ParentForm; + Result := (TempForm <> nil) and + TempForm.HandleAllocated and + PostMessage(TempForm.Handle, aMsg, aWParam, aLParam); +end; + +procedure TBrowserTab.NotifyMoveOrResizeStarted; +begin + FBrowserFrame.NotifyMoveOrResizeStarted; +end; + +procedure TBrowserTab.CreateFrame(const aHomepage : string); +begin + if (FBrowserFrame = nil) then + begin + FBrowserFrame := TBrowserFrame.Create(self); + FBrowserFrame.Name := 'BrowserFrame' + IntToStr(TabID); + FBrowserFrame.Parent := self; + FBrowserFrame.Align := alClient; + FBrowserFrame.Visible := True; + FBrowserFrame.OnBrowserCreated := BrowserFrame_OnBrowserCreated; + FBrowserFrame.OnBrowserDestroyed := BrowserFrame_OnBrowserDestroyed; + FBrowserFrame.OnBrowserTitleChange := BrowserFrame_OnBrowserTitleChange; + end; + + FBrowserFrame.Homepage := aHomepage; +end; + +procedure TBrowserTab.CreateBrowser(const aHomepage : string); +begin + CreateFrame(aHomepage); + + if (FBrowserFrame <> nil) then + FBrowserFrame.CreateBrowser; +end; + +procedure TBrowserTab.CloseBrowser; +begin + if (FBrowserFrame <> nil) then + FBrowserFrame.CloseBrowser; +end; + +procedure TBrowserTab.ShowBrowser; +begin + if (FBrowserFrame <> nil) then + FBrowserFrame.ShowBrowser; +end; + +procedure TBrowserTab.HideBrowser; +begin + if (FBrowserFrame <> nil) then + FBrowserFrame.HideBrowser; +end; + +procedure TBrowserTab.HandleBrowserMessage(var Msg: tagMSG; var Handled: Boolean); +begin + if (FBrowserFrame <> nil) then + FBrowserFrame.HandleBrowserMessage(Msg, Handled); +end; + +procedure TBrowserTab.BrowserFrame_OnBrowserDestroyed(Sender: TObject); +begin + PostFormMessage(CEF_DESTROYTAB, TabID); +end; + +procedure TBrowserTab.BrowserFrame_OnBrowserCreated(Sender: TObject); +begin + PostFormMessage(CEF_SHOWTABID, TabID); +end; + +procedure TBrowserTab.BrowserFrame_OnBrowserTitleChange(Sender: TObject; const aTitle : string); +begin + Caption := aTitle; +end; + +function TBrowserTab.CreateClientHandler(var windowInfo : TCefWindowInfo; + var client : ICefClient; + const targetFrameName : string; + const popupFeatures : TCefPopupFeatures) : boolean; +begin + Result := (FBrowserFrame <> nil) and + FBrowserFrame.CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures); +end; + +function TBrowserTab.DoOnBeforePopup(var windowInfo : TCefWindowInfo; + var client : ICefClient; + const targetFrameName : string; + const popupFeatures : TCefPopupFeatures; + targetDisposition : TCefWindowOpenDisposition) : boolean; +var + TempForm : TCustomForm; +begin + TempForm := ParentForm; + Result := (TempForm <> nil) and + (TempForm is TMainForm) and + TMainForm(TempForm).DoOnBeforePopup(windowInfo, client, targetFrameName, popupFeatures, targetDisposition); +end; + +function TBrowserTab.DoOpenUrlFromTab(const targetUrl : string; + targetDisposition : TCefWindowOpenDisposition) : boolean; +var + TempForm : TCustomForm; +begin + TempForm := ParentForm; + Result := (TempForm <> nil) and + (TempForm is TMainForm) and + TMainForm(TempForm).DoOpenUrlFromTab(targetUrl, targetDisposition); +end; + +end. diff --git a/demos/Delphi_VCL/TabbedOSRBrowser/uChildForm.dfm b/demos/Delphi_VCL/TabbedOSRBrowser/uChildForm.dfm new file mode 100644 index 00000000..2773430f --- /dev/null +++ b/demos/Delphi_VCL/TabbedOSRBrowser/uChildForm.dfm @@ -0,0 +1,59 @@ +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 = [] + Position = poScreenCenter + OnAfterMonitorDpiChanged = FormAfterMonitorDpiChanged + OnClose = FormClose + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnDestroy = FormDestroy + OnHide = FormHide + OnShow = FormShow + TextHeight = 13 + object Panel1: TBufferPanel + Left = 0 + Top = 0 + Width = 352 + Height = 256 + Align = alClient + ParentBackground = False + Caption = 'Panel1' + Color = clWhite + TabOrder = 0 + TabStop = True + OnClick = Panel1Click + OnEnter = Panel1Enter + OnExit = Panel1Exit + OnMouseDown = Panel1MouseDown + OnMouseMove = Panel1MouseMove + OnMouseUp = Panel1MouseUp + OnResize = Panel1Resize + OnMouseLeave = Panel1MouseLeave + end + object Chromium1: TChromium + OnTitleChange = Chromium1TitleChange + OnTooltip = Chromium1Tooltip + OnCursorChange = Chromium1CursorChange + OnBeforePopup = Chromium1BeforePopup + OnAfterCreated = Chromium1AfterCreated + OnBeforeClose = Chromium1BeforeClose + OnOpenUrlFromTab = Chromium1OpenUrlFromTab + OnGetViewRect = Chromium1GetViewRect + OnGetScreenPoint = Chromium1GetScreenPoint + OnGetScreenInfo = Chromium1GetScreenInfo + OnPopupShow = Chromium1PopupShow + OnPopupSize = Chromium1PopupSize + OnPaint = Chromium1Paint + Left = 24 + Top = 56 + end +end diff --git a/demos/Delphi_VCL/TabbedOSRBrowser/uChildForm.pas b/demos/Delphi_VCL/TabbedOSRBrowser/uChildForm.pas new file mode 100644 index 00000000..5f10d9bc --- /dev/null +++ b/demos/Delphi_VCL/TabbedOSRBrowser/uChildForm.pas @@ -0,0 +1,865 @@ +// ************************************************************************ +// ***************************** 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 © 2022 Salvador Diaz Fau. All rights reserved. +// +// ************************************************************************ +// ************ vvvv Original license and comments below vvvv ************* +// ************************************************************************ +(* + * Delphi Chromium Embedded 3 + * + * Usage allowed under the restrictions of the Lesser GNU General Public License + * or alternatively the restrictions of the Mozilla Public License 1.1 + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for + * the specific language governing rights and limitations under the License. + * + * Unit owner : Henri Gourvest + * Web site : http://www.progdigy.com + * Repository : http://code.google.com/p/delphichromiumembedded/ + * Group : http://groups.google.com/group/delphichromiumembedded + * + * Embarcadero Technologies, Inc is not permitted to use or redistribute + * this source code without explicit permission. + * + *) + +unit 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, uCEFBufferPanel, + uCEFChromiumCore; + +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; type_: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; width, height: Integer); + procedure Chromium1CursorChange(Sender: TObject; const browser: ICefBrowser; cursor_: TCefCursorHandle; cursorType: TCefCursorType; const customCursorInfo: PCefCursorInfo; var aResult : boolean); + procedure Chromium1GetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect); + 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; const popupFeatures: TCefPopupFeatures; var windowInfo: TCefWindowInfo; var client: ICefClient; var settings: TCefBrowserSettings; var extra_info: ICefDictionaryValue; var noJavascriptAccess, Result: Boolean); + procedure Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring); + procedure Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser); + procedure Chromium1OpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; out Result: Boolean); + procedure Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser); + + protected + FPopUpBitmap : TBitmap; + FPopUpRect : TRect; + FShowPopUp : boolean; + FResizing : boolean; + FPendingResize : boolean; + FCanClose : boolean; + FClosing : boolean; + FBrowserWasCreated : boolean; + FResizeCS : TCriticalSection; + FPopupFeatures : TCefPopupFeatures; + + FLastClickCount : integer; + FLastClickTime : integer; + FLastClickPoint : TPoint; + FLastClickButton : TMouseButton; + + function GetInitialized : boolean; + + function getModifiers(Shift: TShiftState): TCefEventFlags; + function GetButton(Button: TMouseButton): TCefMouseButtonType; + procedure DoResize; + procedure InitializeLastClick; + function CancelPreviousClick(x, y : integer; var aCurrentTime : integer) : boolean; + + 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 ApplyPopupFeatures; + function CreateBrowser(const aHomepage : string) : boolean; + procedure HandleBrowserMessage(var Msg: tagMSG; var Handled: Boolean); + property Initialized : boolean read GetInitialized; + 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 TChromium.CloseBrowser which triggers the TChromium.OnClose event +// and the internal browser is destroyed immediately. +// 2. TChromium.OnBeforeClose is triggered because the internal browser was destroyed. +// Now we set FCanClose to True and send WM_CLOSE to the form. + +function TChildForm.CreateClientHandler(var windowInfo : TCefWindowInfo; + var client : ICefClient; + const targetFrameName : string; + const popupFeatures : TCefPopupFeatures) : boolean; +begin + WindowInfoAsWindowless(windowInfo, 0, targetFrameName); + FPopupFeatures := popupFeatures; + Result := Chromium1.CreateClientHandler(client); +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; + +function TChildForm.CreateBrowser(const aHomepage : string) : boolean; +begin + Chromium1.DefaultURL := aHomepage; + Result := Chromium1.CreateBrowser(); +end; + +procedure TChildForm.HandleBrowserMessage(var Msg: tagMSG; var Handled: Boolean); +var + TempKeyEvent : TCefKeyEvent; + TempMouseEvent : TCefMouseEvent; + TempPoint : TPoint; +begin + case Msg.message of + WM_SYSCHAR : + 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(True); + TempKeyEvent.character := #0; + TempKeyEvent.unmodified_character := #0; + TempKeyEvent.focus_on_editable_field := ord(False); + + CefCheckAltGrPressed(Msg.wParam, TempKeyEvent); + Chromium1.SendKeyEvent(@TempKeyEvent); + end; + + WM_SYSKEYDOWN : + if Panel1.Focused 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); + end; + + WM_SYSKEYUP : + if Panel1.Focused 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); + end; + + WM_KEYDOWN : + if Panel1.Focused 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 := (Msg.wParam in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_TAB]); + end; + + WM_KEYUP : + if Panel1.Focused 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 := (Msg.wParam <> VK_MENU); + end; + + WM_CHAR : + 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); + + CefCheckAltGrPressed(Msg.wParam, TempKeyEvent); + Chromium1.SendKeyEvent(@TempKeyEvent); + Handled := True; + end; + + WM_MOUSEWHEEL : + if Panel1.Focused then + begin + GetCursorPos(TempPoint); + TempPoint := Panel1.ScreenToclient(TempPoint); + TempMouseEvent.x := TempPoint.x; + TempMouseEvent.y := TempPoint.y; + TempMouseEvent.modifiers := GetCefMouseModifiers(Msg.wParam); + + DeviceToLogical(TempMouseEvent, Panel1.ScreenScale); + + if CefIsKeyDown(VK_SHIFT) then + Chromium1.SendMouseWheelEvent(@TempMouseEvent, smallint(Msg.wParam shr 16), 0) + else + Chromium1.SendMouseWheelEvent(@TempMouseEvent, 0, smallint(Msg.wParam shr 16)); + end; + end; +end; + +procedure TChildForm.Chromium1AfterCreated(Sender: TObject; + const browser: ICefBrowser); +begin + FBrowserWasCreated := True; +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; + const popupFeatures : TCefPopupFeatures; + var windowInfo : TCefWindowInfo; + var client : ICefClient; + var settings : TCefBrowserSettings; + var extra_info : ICefDictionaryValue; + var noJavascriptAccess : Boolean; + var Result : Boolean); +begin + Result := not(TMainForm(Owner).DoOnBeforePopup(windowInfo, client, targetFrameName, popupFeatures, targetDisposition)); +end; + +procedure TChildForm.Chromium1CursorChange( Sender : TObject; + const browser : ICefBrowser; + cursor_ : TCefCursorHandle; + cursorType : TCefCursorType; + const customCursorInfo : PCefCursorInfo; + var aResult : boolean); +begin + Panel1.Cursor := CefCursorToWindowsCursor(cursorType); + aResult := True; +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); +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); + end; +end; + +procedure TChildForm.Chromium1OpenUrlFromTab(Sender: TObject; + const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; + targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; + out Result: Boolean); +begin + Result := not(TMainForm(Owner).DoOpenUrlFromTab(targetUrl, targetDisposition)); +end; + +procedure TChildForm.Chromium1Paint( Sender : TObject; + const browser : ICefBrowser; + type_ : 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 (type_ = 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 (type_ = 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); + + 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 (GlobalCEFApp <> nil) then + GlobalCEFApp.UpdateDeviceScaleFactor; + + 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 + if FBrowserWasCreated then + begin + CanClose := FCanClose; + + if not(FClosing) then + begin + FClosing := True; + Visible := False; + Chromium1.CloseBrowser(True); + end; + end + else + CanClose := True; +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; + FBrowserWasCreated := False; + FResizeCS := TCriticalSection.Create; + + InitializeLastClick; +end; + +procedure TChildForm.FormDestroy(Sender: TObject); +begin + Chromium1.ShutdownDragAndDrop; + + if (FPopUpBitmap <> nil) then FreeAndNil(FPopUpBitmap); + + if FBrowserWasCreated and TMainForm(Owner).HandleAllocated then + PostMessage(TMainForm(Owner).Handle, CEF_CHILDDESTROYED, 0, 0); +end; + +procedure TChildForm.FormHide(Sender: TObject); +begin + Chromium1.SetFocus(False); + Chromium1.WasHidden(True); +end; + +procedure TChildForm.FormShow(Sender: TObject); +begin + Chromium1.InitializeDragAndDrop(Panel1); + Chromium1.WasHidden(False); + Chromium1.SetFocus(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; + TempTime : integer; +begin + if (GlobalCEFApp <> nil) then + begin + Panel1.SetFocus; + + if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then + inc(FLastClickCount) + else + begin + FLastClickPoint.x := x; + FLastClickPoint.y := y; + FLastClickCount := 1; + end; + + FLastClickTime := TempTime; + FLastClickButton := Button; + + TempEvent.x := X; + TempEvent.y := Y; + TempEvent.modifiers := getModifiers(Shift); + DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor); + Chromium1.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount); + end; +end; + +procedure TChildForm.Panel1MouseLeave(Sender: TObject); +var + TempEvent : TCefMouseEvent; + TempPoint : TPoint; + TempTime : integer; +begin + if (GlobalCEFApp <> nil) then + begin + GetCursorPos(TempPoint); + TempPoint := Panel1.ScreenToclient(TempPoint); + + if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick; + + 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; + TempTime : integer; +begin + if (GlobalCEFApp <> nil) then + begin + if CancelPreviousClick(x, y, TempTime) then InitializeLastClick; + + 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) then + begin + TempEvent.x := X; + TempEvent.y := Y; + TempEvent.modifiers := getModifiers(Shift); + DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor); + Chromium1.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount); + 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.InitializeLastClick; +begin + FLastClickCount := 1; + FLastClickTime := 0; + FLastClickPoint.x := 0; + FLastClickPoint.y := 0; + FLastClickButton := mbLeft; +end; + +function TChildForm.GetInitialized : boolean; +begin + Result := Chromium1.Initialized; +end; + +function TChildForm.CancelPreviousClick(x, y : integer; var aCurrentTime : integer) : boolean; +begin + aCurrentTime := GetMessageTime; + + Result := (abs(FLastClickPoint.x - x) > (GetSystemMetrics(SM_CXDOUBLECLK) div 2)) or + (abs(FLastClickPoint.y - y) > (GetSystemMetrics(SM_CYDOUBLECLK) div 2)) or + (cardinal(aCurrentTime - FLastClickTime) > GetDoubleClickTime); +end; + +procedure TChildForm.Panel1Enter(Sender: TObject); +begin + Chromium1.SetFocus(True); +end; + +procedure TChildForm.Panel1Exit(Sender: TObject); +begin + Chromium1.SetFocus(False); +end; + +end. diff --git a/demos/Delphi_VCL/TabbedOSRBrowser/uMainForm.dfm b/demos/Delphi_VCL/TabbedOSRBrowser/uMainForm.dfm new file mode 100644 index 00000000..580d5d8e --- /dev/null +++ b/demos/Delphi_VCL/TabbedOSRBrowser/uMainForm.dfm @@ -0,0 +1,76 @@ +object MainForm: TMainForm + Left = 0 + Top = 0 + Caption = 'Initializing. Please, wait...' + ClientHeight = 703 + ClientWidth = 991 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + TextHeight = 13 + object BrowserPageCtrl: TPageControl + Left = 32 + Top = 0 + Width = 959 + Height = 703 + Align = alClient + TabOrder = 0 + TabWidth = 150 + OnChange = BrowserPageCtrlChange + end + object ButtonPnl: TPanel + Left = 0 + Top = 0 + Width = 32 + Height = 703 + Align = alLeft + BevelOuter = bvNone + Enabled = False + Padding.Left = 3 + Padding.Top = 3 + Padding.Right = 3 + Padding.Bottom = 3 + TabOrder = 1 + object AddTabBtn: TSpeedButton + Left = 3 + Top = 3 + Width = 26 + Height = 26 + Caption = '+' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -24 + Font.Name = 'Arial Black' + Font.Style = [] + ParentFont = False + OnClick = AddTabBtnClick + end + object RemoveTabBtn: TSpeedButton + Left = 3 + Top = 32 + Width = 26 + Height = 26 + Caption = #8722 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -24 + Font.Name = 'Arial Black' + Font.Style = [] + ParentFont = False + OnClick = RemoveTabBtnClick + end + end + object AppEvents: TApplicationEvents + OnMessage = AppEventsMessage + Left = 24 + Top = 128 + end +end diff --git a/demos/Delphi_VCL/TabbedOSRBrowser/uMainForm.pas b/demos/Delphi_VCL/TabbedOSRBrowser/uMainForm.pas new file mode 100644 index 00000000..2783724b --- /dev/null +++ b/demos/Delphi_VCL/TabbedOSRBrowser/uMainForm.pas @@ -0,0 +1,673 @@ +// ************************************************************************ +// ***************************** 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 © 2022 Salvador Diaz Fau. All rights reserved. +// +// ************************************************************************ +// ************ vvvv Original license and comments below vvvv ************* +// ************************************************************************ +(* + * Delphi Chromium Embedded 3 + * + * Usage allowed under the restrictions of the Lesser GNU General Public License + * or alternatively the restrictions of the Mozilla Public License 1.1 + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for + * the specific language governing rights and limitations under the License. + * + * Unit owner : Henri Gourvest + * Web site : http://www.progdigy.com + * Repository : http://code.google.com/p/delphichromiumembedded/ + * Group : http://groups.google.com/group/delphichromiumembedded + * + * Embarcadero Technologies, Inc is not permitted to use or redistribute + * this source code without explicit permission. + * + *) + +unit uMainForm; + +{$I cef.inc} + +interface + +uses + {$IFDEF DELPHI16_UP} + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, System.SyncObjs, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ToolWin, Vcl.Buttons, Vcl.ExtCtrls, + {$ELSE} + Windows, Messages, SysUtils, Variants, Classes, Graphics, SyncObjs, + Controls, Forms, Dialogs, ComCtrls, ToolWin, Buttons, ExtCtrls, + {$ENDIF} + uCEFApplication, uCEFInterfaces, uCEFTypes, uCEFConstants, uChildForm, uBrowserTab, + Vcl.AppEvnts; + +const + CEF_INITIALIZED = WM_APP + $A50; + CEF_DESTROYTAB = WM_APP + $A51; + CEF_CREATENEXTCHILD = WM_APP + $A52; + CEF_CREATENEXTTAB = WM_APP + $A53; + CEF_CHILDDESTROYED = WM_APP + $A54; + CEF_SHOWTABID = WM_APP + $A55; + + HOMEPAGE_URL = 'https://www.google.com'; + DEFAULT_TAB_CAPTION = 'New tab'; + +type + TMainForm = class(TForm) + BrowserPageCtrl: TPageControl; + ButtonPnl: TPanel; + AddTabBtn: TSpeedButton; + RemoveTabBtn: TSpeedButton; + AppEvents: TApplicationEvents; + + procedure AddTabBtnClick(Sender: TObject); + procedure RemoveTabBtnClick(Sender: TObject); + + procedure FormShow(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + procedure FormDestroy(Sender: TObject); + + procedure AppEventsMessage(var Msg: tagMSG; var Handled: Boolean); + procedure BrowserPageCtrlChange(Sender: TObject); + + protected + FHiddenTab : TBrowserTab; + FChildForm : TChildForm; + FCriticalSection : TCriticalSection; + FCanClose : boolean; + FClosing : boolean; // Set to True in the CloseQuery event. + FLastTabID : cardinal; // Used by NextTabID to generate unique tab IDs + FPendingURL : string; + + function GetNextTabID : cardinal; + function GetPopupChildCount : integer; + function GetBrowserTabCount : integer; + + procedure EnableButtonPnl; + function CloseAllBrowsers : boolean; + procedure CloseTab(aIndex : integer); + procedure CreateHiddenBrowsers; + procedure UpdateBrowsersVisibility; + + procedure CEFInitializedMsg(var aMessage : TMessage); message CEF_INITIALIZED; + procedure DestroyTabMsg(var aMessage : TMessage); message CEF_DESTROYTAB; + procedure CreateNextChildMsg(var aMessage : TMessage); message CEF_CREATENEXTCHILD; + procedure CreateNextTabMsg(var aMessage : TMessage); message CEF_CREATENEXTTAB; + procedure ChildDestroyedMsg(var aMessage : TMessage); message CEF_CHILDDESTROYED; + procedure ShowTabIdMsg(var aMessage : TMessage); message CEF_SHOWTABID; + 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 WMQueryEndSession(var aMessage: TWMQueryEndSession); message WM_QUERYENDSESSION; + + property NextTabID : cardinal read GetNextTabID; + property PopupChildCount : integer read GetPopupChildCount; + property BrowserTabCount : integer read GetBrowserTabCount; + + public + function DoOnBeforePopup(var windowInfo : TCefWindowInfo; var client : ICefClient; const targetFrameName : string; const popupFeatures : TCefPopupFeatures; targetDisposition : TCefWindowOpenDisposition) : boolean; + function DoOpenUrlFromTab(const targetUrl : string; targetDisposition : TCefWindowOpenDisposition) : boolean; + end; + +var + MainForm: TMainForm; + +procedure CreateGlobalCEFApp; + +implementation + +{$R *.dfm} + +uses + uCEFWorkScheduler; + +// This demo shows how to use a TPageControl with TFrames that include +// CEF4Delphi browsers. + +// Instead of a regular TTabSheet we use a custom TBrowserTab class that +// inherits from TTabSheet and instead of a regular TFrame we use a custom +// TBrowserFrame class that inherits from TFrame. + +// To create a new tab you need to call TBrowserTab.CreateBrowser in the last +// step to create all the browser components and initialize the browser. + +// To close a tab you have to call TBrowserTab.CloseBrowser and wait for a +// CEF_DESTROYTAB message that includes TBrowserTab.TabID in TMessage.wParam. +// Then you find the tab with that unique TabID and free it. + +// TBrowserFrame has all the usual code to close CEF4Delphi browsers following +// a similar destruction sequence than the OSRExternalBrowserPump demo : +// +// 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 the internal +// browser will be destroyed immediately. +// 3- chrmosr.OnBeforeClose is triggered because the internal browser was destroyed. +// FCanClose is set to True and sends WM_CLOSE to the form. + +// This demo also uses custom forms to open popup browsers in the same way as +// the PopupBrowser2 demo. Please, read the code comments in that demo for all +// details about handling the custom child forms. + +// Additionally, this demo also creates new tabs when a browser triggers the +// TChromium.OnBeforePopup event. + +// To close safely this demo you must close all the browser tabs first following +// this steps : +// +// 1. FormCloseQuery sets CanClose to FALSE and calls CloseAllBrowsers and FClosing +// is set to TRUE. +// 2. Each tab will send a CEF_DESTROYTAB message to the main form to free that tab. +// 3. Each child form will send a CEF_CHILDDESTROYED message to the main form. +// 3. When TPageControl has no tabs and all the child forms are also closed then we +// can set FCanClose to TRUE and send a WM_CLOSE message to the main form to +// close the application. + +procedure GlobalCEFApp_OnContextInitialized; +begin + if (MainForm <> nil) and MainForm.HandleAllocated then + PostMessage(MainForm.Handle, CEF_INITIALIZED, 0, 0); +end; + +procedure GlobalCEFApp_OnScheduleMessagePumpWork(const aDelayMS : int64); +begin + if (GlobalCEFWorkScheduler <> nil) then GlobalCEFWorkScheduler.ScheduleMessagePumpWork(aDelayMS); +end; + +procedure CreateGlobalCEFApp; +begin + // 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.cache := 'cache'; + GlobalCEFApp.WindowlessRenderingEnabled := True; + GlobalCEFApp.EnableHighDPISupport := True; + GlobalCEFApp.ExternalMessagePump := True; + GlobalCEFApp.EnablePrintPreview := True; + GlobalCEFApp.MultiThreadedMessageLoop := False; + GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized; + GlobalCEFApp.OnScheduleMessagePumpWork := GlobalCEFApp_OnScheduleMessagePumpWork; + GlobalCEFApp.EnableGPU := True; +end; + +procedure TMainForm.AppEventsMessage(var Msg: tagMSG; var Handled: Boolean); +begin + if not(Handled) then + case Msg.message of + WM_SYSCHAR, + WM_SYSKEYDOWN, + WM_SYSKEYUP, + WM_KEYDOWN, + WM_KEYUP, + WM_CHAR, + WM_MOUSEWHEEL : + if (screen.ActiveForm is TChildForm) then + TChildForm(screen.ActiveForm).HandleBrowserMessage(Msg, Handled) + else + if assigned(BrowserPageCtrl.ActivePage) then + TBrowserTab(BrowserPageCtrl.ActivePage).HandleBrowserMessage(Msg, Handled); + end; +end; + +procedure TMainForm.UpdateBrowsersVisibility; +var + i : integer; + TempID : cardinal; + TempTab : TBrowserTab; +begin + if assigned(BrowserPageCtrl.ActivePage) then + TempID := TBrowserTab(BrowserPageCtrl.ActivePage).TabID + else + exit; + + i := pred(BrowserPageCtrl.PageCount); + + while (i >= 0) do + begin + TempTab := TBrowserTab(BrowserPageCtrl.Pages[i]); + + if TempTab.TabVisible then + begin + if (TempTab.TabID = TempID) then + TempTab.ShowBrowser + else + TempTab.HideBrowser; + end; + + dec(i); + end; +end; + +procedure TMainForm.BrowserPageCtrlChange(Sender: TObject); +begin + UpdateBrowsersVisibility; +end; + +procedure TMainForm.EnableButtonPnl; +begin + if not(ButtonPnl.Enabled) then + begin + ButtonPnl.Enabled := True; + Caption := 'Tabbed OSR Browser'; + cursor := crDefault; + if (BrowserTabCount = 0) then AddTabBtn.Click; + end; +end; + +function TMainForm.GetNextTabID : cardinal; +begin + inc(FLastTabID); + Result := FLastTabID; +end; + +function TMainForm.GetPopupChildCount : integer; +var + i : integer; + TempForm : TCustomForm; +begin + Result := 0; + i := pred(screen.CustomFormCount); + + while (i >= 0) do + begin + // Only count the fully initialized child forms and not the one waiting to be used. + TempForm := screen.CustomForms[i]; + if (TempForm is TChildForm) and + TChildForm(TempForm).Initialized then + inc(Result); + + dec(i); + end; +end; + +function TMainForm.GetBrowserTabCount : integer; +var + i : integer; +begin + Result := 0; + i := pred(BrowserPageCtrl.PageCount); + + while (i >= 0) do + begin + // Only count the fully initialized browser tabs and not the one waiting to be used. + + if TBrowserTab(BrowserPageCtrl.Pages[i]).Initialized then + inc(Result); + + dec(i); + end; +end; + +procedure TMainForm.AddTabBtnClick(Sender: TObject); +var + TempNewTab : TBrowserTab; +begin + TempNewTab := TBrowserTab.Create(self, NextTabID, DEFAULT_TAB_CAPTION); + TempNewTab.PageControl := BrowserPageCtrl; + + BrowserPageCtrl.ActivePageIndex := pred(BrowserPageCtrl.PageCount); + UpdateBrowsersVisibility; + + TempNewTab.CreateBrowser(HOMEPAGE_URL); +end; + +procedure TMainForm.CEFInitializedMsg(var aMessage : TMessage); +begin + EnableButtonPnl; + CreateHiddenBrowsers; +end; + +procedure TMainForm.DestroyTabMsg(var aMessage : TMessage); +var + i : integer; + TempTab : TBrowserTab; +begin + // Every tab sends a CEF_DESTROYTAB message when its browser has been destroyed + // and then we can destroy the TBrowserTab control. + i := 0; + while (i < BrowserPageCtrl.PageCount) do + begin + TempTab := TBrowserTab(BrowserPageCtrl.Pages[i]); + + if (TempTab.TabID = aMessage.wParam) then + begin + TempTab.Free; + break; + end + else + inc(i); + end; + + // Here we check if this was the last initialized browser to close the + // application safely. + if FClosing then + begin + if (PopupChildCount = 0) and (BrowserTabCount = 0) then + begin + FCanClose := True; + PostMessage(Handle, WM_CLOSE, 0, 0); + end; + end + else + UpdateBrowsersVisibility; +end; + +procedure TMainForm.ChildDestroyedMsg(var aMessage : TMessage); +begin + // Every destroyed child form sends a CEF_CHILDDESTROYED message + // Here we check if this was the last initialized browser to close the + // application safely. + if FClosing and (PopupChildCount = 0) and (BrowserTabCount = 0) then + begin + FCanClose := True; + PostMessage(Handle, WM_CLOSE, 0, 0); + end; +end; + +procedure TMainForm.ShowTabIdMsg(var aMessage : TMessage); +var + i : integer; + TempTab : TBrowserTab; +begin + i := 0; + while (i < BrowserPageCtrl.PageCount) do + begin + TempTab := TBrowserTab(BrowserPageCtrl.Pages[i]); + + if (TempTab.TabID = aMessage.wParam) then + begin + BrowserPageCtrl.ActivePageIndex := TempTab.PageIndex; + UpdateBrowsersVisibility; + break; + end + else + inc(i); + end; +end; + +procedure TMainForm.CreateNextChildMsg(var aMessage : TMessage); +begin + try + FCriticalSection.Acquire; + + if (FChildForm <> nil) then + begin + if (aMessage.lParam <> 0) then + FChildForm.CreateBrowser(FPendingURL) + else + FChildForm.ApplyPopupFeatures; + + FChildForm.Show; + end; + + FChildForm := TChildForm.Create(self); + finally + FCriticalSection.Release; + end; +end; + +procedure TMainForm.CreateNextTabMsg(var aMessage : TMessage); +begin + try + FCriticalSection.Acquire; + + if (FHiddenTab <> nil) then + begin + FHiddenTab.TabVisible := True; + FHiddenTab.PageIndex := pred(BrowserPageCtrl.PageCount); + + if (aMessage.lParam <> 0) then + FHiddenTab.CreateBrowser(FPendingURL); + end; + + FHiddenTab := TBrowserTab.Create(self, NextTabID, DEFAULT_TAB_CAPTION); + FHiddenTab.PageControl := BrowserPageCtrl; + FHiddenTab.TabVisible := False; + FHiddenTab.CreateFrame; + finally + FCriticalSection.Release; + end; +end; + +procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + CanClose := FCanClose; + + if not(FClosing) then + begin + FClosing := True; + ButtonPnl.Enabled := False; + + if not(CloseAllBrowsers) then + begin + FCanClose := True; + PostMessage(Handle, WM_CLOSE, 0, 0); + end; + end; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + FCanClose := False; + FClosing := False; + FLastTabID := 0; + FChildForm := nil; + FHiddenTab := nil; + FCriticalSection := TCriticalSection.Create; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FreeAndNil(FCriticalSection); +end; + +procedure TMainForm.FormShow(Sender: TObject); +begin + if (GlobalCEFApp <> nil) and GlobalCEFApp.GlobalContextInitialized then + begin + EnableButtonPnl; + CreateHiddenBrowsers; + end; +end; + +procedure TMainForm.RemoveTabBtnClick(Sender: TObject); +begin + // Call TBrowserTab.CloseBrowser in the active tab + CloseTab(BrowserPageCtrl.ActivePageIndex); +end; + +function TMainForm.CloseAllBrowsers : boolean; +var + i : integer; + TempForm : TCustomForm; + TempTab : TBrowserTab; +begin + Result := False; + i := pred(screen.CustomFormCount); + while (i >= 0) do + begin + TempForm := screen.CustomForms[i]; + + if (TempForm is TChildForm) and + TChildForm(TempForm).Initialized and + not(TChildForm(TempForm).Closing) then + begin + PostMessage(TempForm.Handle, WM_CLOSE, 0, 0); + Result := True; + end; + + dec(i); + end; + + i := pred(BrowserPageCtrl.PageCount); + while (i >= 0) do + begin + TempTab := TBrowserTab(BrowserPageCtrl.Pages[i]); + + if TempTab.Initialized and not(TempTab.Closing) then + begin + TempTab.CloseBrowser; + Result := True; + end; + + dec(i); + end; +end; + +procedure TMainForm.CloseTab(aIndex : integer); +begin + if (aIndex >= 0) and (aIndex < BrowserPageCtrl.PageCount) then + TBrowserTab(BrowserPageCtrl.Pages[aIndex]).CloseBrowser; +end; + +procedure TMainForm.CreateHiddenBrowsers; +begin + try + FCriticalSection.Acquire; + + if (FChildForm = nil) then + FChildForm := TChildForm.Create(self); + + if (FHiddenTab = nil) then + begin + FHiddenTab := TBrowserTab.Create(self, NextTabID, DEFAULT_TAB_CAPTION); + FHiddenTab.PageControl := BrowserPageCtrl; + FHiddenTab.TabVisible := False; + FHiddenTab.CreateFrame; + end; + finally + FCriticalSection.Release; + end; +end; + +procedure TMainForm.WMMove(var aMessage : TWMMove); +var + i : integer; +begin + inherited; + + i := 0; + while (i < BrowserPageCtrl.PageCount) do + begin + TBrowserTab(BrowserPageCtrl.Pages[i]).NotifyMoveOrResizeStarted; + inc(i); + end; +end; + +procedure TMainForm.WMMoving(var aMessage : TMessage); +var + i : integer; +begin + inherited; + + i := 0; + while (i < BrowserPageCtrl.PageCount) do + begin + TBrowserTab(BrowserPageCtrl.Pages[i]).NotifyMoveOrResizeStarted; + inc(i); + end; +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; + +procedure TMainForm.WMQueryEndSession(var aMessage: TWMQueryEndSession); +begin + // We return False (0) to close the browser correctly while we can. + // This is not what Microsoft recommends doing when an application receives + // WM_QUERYENDSESSION but at least we avoid TApplication calling HALT when + // it receives WM_ENDSESSION. + // The CEF subprocesses may receive WM_QUERYENDSESSION and WM_ENDSESSION + // before the main process and they may crash before closing the main form. + aMessage.Result := 0; + PostMessage(Handle, WM_CLOSE, 0, 0); +end; + +function TMainForm.DoOnBeforePopup(var windowInfo : TCefWindowInfo; + var client : ICefClient; + const targetFrameName : string; + const popupFeatures : TCefPopupFeatures; + targetDisposition : TCefWindowOpenDisposition) : boolean; +begin + try + FCriticalSection.Acquire; + + case targetDisposition of + WOD_NEW_FOREGROUND_TAB, + WOD_NEW_BACKGROUND_TAB : + Result := (FHiddenTab <> nil) and + FHiddenTab.CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures) and + PostMessage(Handle, CEF_CREATENEXTTAB, 0, ord(False)); + + WOD_NEW_WINDOW, + WOD_NEW_POPUP : + Result := (FChildForm <> nil) and + FChildForm.CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures) and + PostMessage(Handle, CEF_CREATENEXTCHILD, 0, ord(False)); + + else Result := False; + end; + finally + FCriticalSection.Release; + end; +end; + +function TMainForm.DoOpenUrlFromTab(const targetUrl : string; + targetDisposition : TCefWindowOpenDisposition) : boolean; +begin + try + FCriticalSection.Acquire; + + case targetDisposition of + WOD_NEW_FOREGROUND_TAB, + WOD_NEW_BACKGROUND_TAB : + begin + FPendingURL := targetUrl; + Result := PostMessage(Handle, CEF_CREATENEXTTAB, 0, ord(True)); + end; + + WOD_NEW_WINDOW, + WOD_NEW_POPUP : + begin + FPendingURL := targetUrl; + Result := PostMessage(Handle, CEF_CREATENEXTCHILD, 0, ord(True)); + end + + else Result := False; + end; + finally + FCriticalSection.Release; + end; +end; + +end. diff --git a/source/uCEFChromiumCore.pas b/source/uCEFChromiumCore.pas index 0425515d..c0fd87fa 100644 --- a/source/uCEFChromiumCore.pas +++ b/source/uCEFChromiumCore.pas @@ -2203,9 +2203,13 @@ var TempURL : TCefString; TempBrowser : ICefBrowser; begin - TempURL := CefString(aURL); - TempBrowser := TCefBrowserRef.UnWrap(cef_browser_host_create_browser_sync(aWindowInfo, FHandler.Wrap, @TempURL, aSettings, CefGetData(aExtraInfo), CefGetData(aContext))); - Result := AddBrowser(TempBrowser); + try + TempURL := CefString(aURL); + TempBrowser := TCefBrowserRef.UnWrap(cef_browser_host_create_browser_sync(aWindowInfo, FHandler.Wrap, @TempURL, aSettings, CefGetData(aExtraInfo), CefGetData(aContext))); + Result := assigned(TempBrowser); + finally + TempBrowser := nil; + end; end; procedure TChromiumCore.Find(const aSearchText : ustring; aForward, aMatchCase, aFindNext : Boolean); @@ -5122,9 +5126,7 @@ begin try FBrowsersCS.Acquire; - if (FBrowsers <> nil) and - (FMultiBrowserMode or (FBrowsers.Count = 0)) and - FBrowsers.AddBrowser(aBrowser) then + if (FBrowsers <> nil) and FBrowsers.AddBrowser(aBrowser) then begin Result := True; @@ -5234,9 +5236,7 @@ end; procedure TChromiumCore.doOnAfterCreated(const browser: ICefBrowser); begin - if MultithreadApp or MultiBrowserMode or GlobalCEFApp.ChromeRuntime then - AddBrowser(browser); - + AddBrowser(browser); doUpdatePreferences(browser); if (FMediaObserver <> nil) and (FMediaObserverReg = nil) then diff --git a/update_CEF4Delphi.json b/update_CEF4Delphi.json index fab99c11..57621c81 100644 --- a/update_CEF4Delphi.json +++ b/update_CEF4Delphi.json @@ -2,7 +2,7 @@ "UpdateLazPackages" : [ { "ForceNotify" : true, - "InternalVersion" : 391, + "InternalVersion" : 392, "Name" : "cef4delphi_lazarus.lpk", "Version" : "100.0.24.0" }