1
0
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:
salvadordf 2022-04-30 19:01:45 +02:00
parent 7de8912d31
commit 455a75c849
13 changed files with 5062 additions and 10 deletions

View File

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

View File

@ -0,0 +1,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.

File diff suppressed because it is too large Load Diff

View 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}

View 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

View 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.

View 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.

View 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

View 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.

View 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

View 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.

View File

@ -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

View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 391,
"InternalVersion" : 392,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "100.0.24.0"
}