mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2025-02-02 10:25:26 +02:00
Fixed issue #415 : TChromiumCore.Initialized remains False in some popup windows
Added the TabbedOSRBrowser demo
This commit is contained in:
parent
7de8912d31
commit
455a75c849
18
demos/Delphi_VCL/TabbedOSRBrowser/00-DeleteDCUs.bat
Normal file
18
demos/Delphi_VCL/TabbedOSRBrowser/00-DeleteDCUs.bat
Normal file
@ -0,0 +1,18 @@
|
||||
del /s /q *.dcu
|
||||
del /s /q *.exe
|
||||
del /s /q *.res
|
||||
del /s /q *.rsm
|
||||
del /s /q *.log
|
||||
del /s /q *.dsk
|
||||
del /s /q *.identcache
|
||||
del /s /q *.stat
|
||||
del /s /q *.local
|
||||
del /s /q *.~*
|
||||
rmdir Win32\Debug
|
||||
rmdir Win32\Release
|
||||
rmdir Win32
|
||||
rmdir Win64\Debug
|
||||
rmdir Win64\Release
|
||||
rmdir Win64
|
||||
rmdir __history
|
||||
rmdir __recovery
|
85
demos/Delphi_VCL/TabbedOSRBrowser/TabbedOSRBrowser.dpr
Normal file
85
demos/Delphi_VCL/TabbedOSRBrowser/TabbedOSRBrowser.dpr
Normal file
@ -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 <hgourvest@gmail.com>
|
||||
* Web site : http://www.progdigy.com
|
||||
* Repository : http://code.google.com/p/delphichromiumembedded/
|
||||
* Group : http://groups.google.com/group/delphichromiumembedded
|
||||
*
|
||||
* Embarcadero Technologies, Inc is not permitted to use or redistribute
|
||||
* this source code without explicit permission.
|
||||
*
|
||||
*)
|
||||
|
||||
program 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.
|
1278
demos/Delphi_VCL/TabbedOSRBrowser/TabbedOSRBrowser.dproj
Normal file
1278
demos/Delphi_VCL/TabbedOSRBrowser/TabbedOSRBrowser.dproj
Normal file
File diff suppressed because it is too large
Load Diff
507
demos/Delphi_VCL/TabbedOSRBrowser/cef.inc
Normal file
507
demos/Delphi_VCL/TabbedOSRBrowser/cef.inc
Normal file
@ -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 <hgourvest@gmail.com>
|
||||
* Web site : http://www.progdigy.com
|
||||
* Repository : http://code.google.com/p/delphichromiumembedded/
|
||||
* Group : http://groups.google.com/group/delphichromiumembedded
|
||||
*
|
||||
* Embarcadero Technologies, Inc is not permitted to use or redistribute
|
||||
* this source code without explicit permission.
|
||||
*
|
||||
*)
|
||||
|
||||
// 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}
|
248
demos/Delphi_VCL/TabbedOSRBrowser/uBrowserFrame.dfm
Normal file
248
demos/Delphi_VCL/TabbedOSRBrowser/uBrowserFrame.dfm
Normal file
@ -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
|
999
demos/Delphi_VCL/TabbedOSRBrowser/uBrowserFrame.pas
Normal file
999
demos/Delphi_VCL/TabbedOSRBrowser/uBrowserFrame.pas
Normal file
@ -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 <hgourvest@gmail.com>
|
||||
* Web site : http://www.progdigy.com
|
||||
* Repository : http://code.google.com/p/delphichromiumembedded/
|
||||
* Group : http://groups.google.com/group/delphichromiumembedded
|
||||
*
|
||||
* Embarcadero Technologies, Inc is not permitted to use or redistribute
|
||||
* this source code without explicit permission.
|
||||
*
|
||||
*)
|
||||
|
||||
unit 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 := '<html><body bgcolor="white">' +
|
||||
'<h2>Failed to load URL ' + failedUrl +
|
||||
' with error ' + errorText +
|
||||
' (' + inttostr(errorCode) + ').</h2></body></html>';
|
||||
|
||||
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.
|
||||
|
||||
|
244
demos/Delphi_VCL/TabbedOSRBrowser/uBrowserTab.pas
Normal file
244
demos/Delphi_VCL/TabbedOSRBrowser/uBrowserTab.pas
Normal file
@ -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 <hgourvest@gmail.com>
|
||||
* Web site : http://www.progdigy.com
|
||||
* Repository : http://code.google.com/p/delphichromiumembedded/
|
||||
* Group : http://groups.google.com/group/delphichromiumembedded
|
||||
*
|
||||
* Embarcadero Technologies, Inc is not permitted to use or redistribute
|
||||
* this source code without explicit permission.
|
||||
*
|
||||
*)
|
||||
|
||||
unit 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.
|
59
demos/Delphi_VCL/TabbedOSRBrowser/uChildForm.dfm
Normal file
59
demos/Delphi_VCL/TabbedOSRBrowser/uChildForm.dfm
Normal file
@ -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
|
865
demos/Delphi_VCL/TabbedOSRBrowser/uChildForm.pas
Normal file
865
demos/Delphi_VCL/TabbedOSRBrowser/uChildForm.pas
Normal file
@ -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 <hgourvest@gmail.com>
|
||||
* Web site : http://www.progdigy.com
|
||||
* Repository : http://code.google.com/p/delphichromiumembedded/
|
||||
* Group : http://groups.google.com/group/delphichromiumembedded
|
||||
*
|
||||
* Embarcadero Technologies, Inc is not permitted to use or redistribute
|
||||
* this source code without explicit permission.
|
||||
*
|
||||
*)
|
||||
|
||||
unit 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.
|
76
demos/Delphi_VCL/TabbedOSRBrowser/uMainForm.dfm
Normal file
76
demos/Delphi_VCL/TabbedOSRBrowser/uMainForm.dfm
Normal file
@ -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
|
673
demos/Delphi_VCL/TabbedOSRBrowser/uMainForm.pas
Normal file
673
demos/Delphi_VCL/TabbedOSRBrowser/uMainForm.pas
Normal file
@ -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 <hgourvest@gmail.com>
|
||||
* Web site : http://www.progdigy.com
|
||||
* Repository : http://code.google.com/p/delphichromiumembedded/
|
||||
* Group : http://groups.google.com/group/delphichromiumembedded
|
||||
*
|
||||
* Embarcadero Technologies, Inc is not permitted to use or redistribute
|
||||
* this source code without explicit permission.
|
||||
*
|
||||
*)
|
||||
|
||||
unit 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.
|
@ -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
|
||||
|
@ -2,7 +2,7 @@
|
||||
"UpdateLazPackages" : [
|
||||
{
|
||||
"ForceNotify" : true,
|
||||
"InternalVersion" : 391,
|
||||
"InternalVersion" : 392,
|
||||
"Name" : "cef4delphi_lazarus.lpk",
|
||||
"Version" : "100.0.24.0"
|
||||
}
|
||||
|
Loading…
x
Reference in New Issue
Block a user