1
0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-06-02 21:57:37 +02:00

Added FMXTabbedBrowser demo

This commit is contained in:
Salvador Díaz Fau 2020-02-10 16:36:15 +01:00
parent fa64d506b4
commit a975f8ff89
10 changed files with 2773 additions and 1 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,31 @@
program FMXTabbedBrowser;
uses
System.StartUpCopy,
FMX.Forms,
uCEFApplication,
uMainForm in 'uMainForm.pas' {MainForm},
uBrowserTab in 'uBrowserTab.pas',
uBrowserFrame in 'uBrowserFrame.pas' {BrowserFrame: TFrame};
{$R *.res}
{$IFDEF MSWINDOWS}
// CEF3 needs to set the LARGEADDRESSAWARE flag which allows 32-bit processes to use up to 3GB of RAM.
{$SetPEFlags $20}
{$ENDIF}
begin
CreateGlobalCEFApp;
if GlobalCEFApp.StartMainProcess then
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
MainForm.Free;
end;
DestroyGlobalCEFApp;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,409 @@
// ************************************************************************
// ***************************** 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}
{$IFDEF FPC}
{$DEFINE SUPPORTS_INLINE}
{$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}
{$ENDIF}
{$ENDIF}
{$IFDEF DELPHI9_UP}
{$DEFINE SUPPORTS_INLINE}
{$ENDIF}

View File

@ -0,0 +1,134 @@
object BrowserFrame: TBrowserFrame
Padding.Left = 1.000000000000000000
Padding.Top = 1.000000000000000000
Padding.Right = 1.000000000000000000
Padding.Bottom = 1.000000000000000000
Size.Width = 1000.000000000000000000
Size.Height = 733.000000000000000000
Size.PlatformDefault = False
object StatusBar: TStatusBar
Padding.Left = 5.000000000000000000
Padding.Right = 5.000000000000000000
Position.X = 1.000000000000000000
Position.Y = 710.000000000000000000
ShowSizeGrip = False
Size.Width = 998.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
object StatusLbl: TLabel
Align = Client
Size.Width = 988.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
end
end
object AddressLay: TLayout
Align = Top
Padding.Left = 5.000000000000000000
Padding.Top = 5.000000000000000000
Padding.Right = 5.000000000000000000
Padding.Bottom = 5.000000000000000000
Position.X = 1.000000000000000000
Position.Y = 1.000000000000000000
Size.Width = 998.000000000000000000
Size.Height = 35.000000000000000000
Size.PlatformDefault = False
TabOrder = 4
object GoBtn: TSpeedButton
Align = Right
Margins.Left = 5.000000000000000000
Position.X = 966.000000000000000000
Position.Y = 5.000000000000000000
Size.Width = 27.000000000000000000
Size.Height = 25.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'arrowrighttoolbutton'
Text = 'GoBtn'
OnClick = GoBtnClick
end
object NavButtonLay: TLayout
Align = Left
Margins.Right = 5.000000000000000000
Position.X = 5.000000000000000000
Position.Y = 5.000000000000000000
Size.Width = 115.000000000000000000
Size.Height = 25.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
object BackBtn: TSpeedButton
Align = Left
Margins.Right = 5.000000000000000000
Size.Width = 25.000000000000000000
Size.Height = 25.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'priortoolbutton'
Text = 'BackBtn'
OnClick = BackBtnClick
end
object ForwardBtn: TSpeedButton
Align = Left
Margins.Right = 5.000000000000000000
Position.X = 30.000000000000000000
Size.Width = 25.000000000000000000
Size.Height = 25.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'nexttoolbutton'
Text = 'SpeedButton1'
OnClick = ForwardBtnClick
end
object ReloadBtn: TSpeedButton
Align = Left
Margins.Right = 5.000000000000000000
Position.X = 60.000000000000000000
Size.Width = 25.000000000000000000
Size.Height = 25.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'refreshtoolbutton'
Text = 'SpeedButton1'
OnClick = ReloadBtnClick
end
object StopBtn: TSpeedButton
Align = Left
Position.X = 90.000000000000000000
Size.Width = 25.000000000000000000
Size.Height = 25.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'stoptoolbutton'
Text = 'SpeedButton1'
OnClick = StopBtnClick
end
end
object URLEdt: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
Align = Client
TabOrder = 3
Size.Width = 836.000000000000000000
Size.Height = 25.000000000000000000
Size.PlatformDefault = False
end
end
object WindowParentLay: TLayout
Align = Client
Size.Width = 998.000000000000000000
Size.Height = 674.000000000000000000
Size.PlatformDefault = False
TabOrder = 5
OnResize = WindowParentLayResize
end
object FMXChromium1: TFMXChromium
OnLoadError = FMXChromium1LoadError
OnLoadingStateChange = FMXChromium1LoadingStateChange
OnAddressChange = FMXChromium1AddressChange
OnTitleChange = FMXChromium1TitleChange
OnStatusMessage = FMXChromium1StatusMessage
OnBeforePopup = FMXChromium1BeforePopup
OnAfterCreated = FMXChromium1AfterCreated
OnBeforeClose = FMXChromium1BeforeClose
OnClose = FMXChromium1Close
OnOpenUrlFromTab = FMXChromium1OpenUrlFromTab
Left = 40
Top = 65
end
end

View File

@ -0,0 +1,386 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2020 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
unit uBrowserFrame;
{$I cef.inc}
interface
uses
{$IFDEF MSWINDOWS}Winapi.Windows,{$ENDIF}
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.Edit, FMX.Layouts, FMX.Controls.Presentation, FMX.TabControl,
uCEFChromiumCore, uCEFFMXChromium, uCEFFMXWindowParent, uCEFInterfaces,
uCEFTypes, uCEFConstants;
type
TBrowserTitleEvent = procedure(Sender: TObject; const aTitle : string) of object;
TBrowserFrame = class(TFrame)
FMXChromium1: TFMXChromium;
StatusBar: TStatusBar;
StatusLbl: TLabel;
AddressLay: TLayout;
GoBtn: TSpeedButton;
NavButtonLay: TLayout;
BackBtn: TSpeedButton;
ForwardBtn: TSpeedButton;
ReloadBtn: TSpeedButton;
StopBtn: TSpeedButton;
URLEdt: TEdit;
WindowParentLay: TLayout;
procedure BackBtnClick(Sender: TObject);
procedure ForwardBtnClick(Sender: TObject);
procedure ReloadBtnClick(Sender: TObject);
procedure StopBtnClick(Sender: TObject);
procedure GoBtnClick(Sender: TObject);
procedure WindowParentLayResize(Sender: TObject);
procedure FMXChromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
procedure FMXChromium1BeforeClose(Sender: TObject; const browser: ICefBrowser);
procedure FMXChromium1BeforePopup(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 FMXChromium1OpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; out Result: Boolean);
procedure FMXChromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction: TCefCloseBrowserAction);
procedure FMXChromium1AddressChange(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const url: ustring);
procedure FMXChromium1LoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring);
procedure FMXChromium1LoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
procedure FMXChromium1StatusMessage(Sender: TObject; const browser: ICefBrowser; const value: ustring);
procedure FMXChromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring);
protected
FClosing : boolean; // Indicates that this frame is destroying the browser
FHomepage : string; // Used to set the TChromium.DefaultURL property
FOnBrowserDestroyed : TNotifyEvent;
FOnBrowserClosing : TNotifyEvent;
FOnBrowserTitleChange : TBrowserTitleEvent;
FMXWindowParent : TFMXWindowParent; // TFMXWindowParent has to be created at runtime. See the SimpleFMXBrowser demo for more details.
function GetParentForm : TCustomForm;
function GetParentTab : TTabItem;
function GetFMXWindowParentRect : System.Types.TRect;
procedure CreateFMXWindowParent;
public
constructor Create(AOwner : TComponent); override;
procedure NotifyMoveOrResizeStarted;
procedure CreateBrowser;
procedure CloseBrowser;
procedure ResizeBrowser;
procedure ShowBrowser;
procedure HideBrowser;
procedure DestroyWindowParent;
property ParentForm : TCustomForm read GetParentForm;
property ParentTab : TTabItem read GetParentTab;
property Closing : boolean read FClosing;
property Homepage : string read FHomepage write FHomepage;
property OnBrowserDestroyed : TNotifyEvent read FOnBrowserDestroyed write FOnBrowserDestroyed;
property OnBrowserTitleChange : TBrowserTitleEvent read FOnBrowserTitleChange write FOnBrowserTitleChange;
property OnBrowserClosing : TNotifyEvent read FOnBrowserClosing write FOnBrowserClosing;
end;
implementation
{$R *.fmx}
uses
FMX.Platform, {$IFDEF MSWINDOWS}FMX.Platform.Win,{$ENDIF}
uCEFMiscFunctions, uCEFApplication, uBrowserTab, uMainForm;
procedure TBrowserFrame.BackBtnClick(Sender: TObject);
begin
FMXChromium1.GoBack;
end;
constructor TBrowserFrame.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FClosing := False;
FHomepage := '';
FOnBrowserDestroyed := nil;
FOnBrowserTitleChange := nil;
FOnBrowserClosing := nil;
FMXWindowParent := nil;
end;
function TBrowserFrame.GetFMXWindowParentRect : System.Types.TRect;
var
TempRect : TRectF;
begin
TempRect := WindowParentLay.AbsoluteRect;
Result.Left := round(TempRect.Left);
Result.Top := round(TempRect.Top);
Result.Right := round(TempRect.Right);
Result.Bottom := round(TempREct.Bottom);
end;
procedure TBrowserFrame.ReloadBtnClick(Sender: TObject);
begin
FMXChromium1.Reload;
end;
procedure TBrowserFrame.ResizeBrowser;
begin
if (FMXWindowParent <> nil) then
FMXWindowParent.SetBounds(GetFMXWindowParentRect);
end;
procedure TBrowserFrame.ShowBrowser;
begin
if (FMXWindowParent <> nil) then
begin
FMXWindowParent.WindowState := TWindowState.wsNormal;
ResizeBrowser;
FMXWindowParent.Show;
end;
end;
procedure TBrowserFrame.HideBrowser;
begin
if (FMXWindowParent <> nil) then FMXWindowParent.Hide;
end;
procedure TBrowserFrame.DestroyWindowParent;
begin
if (FMXWindowParent <> nil) then FreeAndNil(FMXWindowParent);
end;
procedure TBrowserFrame.NotifyMoveOrResizeStarted;
begin
FMXChromium1.NotifyMoveOrResizeStarted;
end;
procedure TBrowserFrame.StopBtnClick(Sender: TObject);
begin
FMXChromium1.StopLoad;
end;
procedure TBrowserFrame.WindowParentLayResize(Sender: TObject);
begin
ResizeBrowser;
end;
procedure TBrowserFrame.CreateFMXWindowParent;
begin
if (FMXWindowParent = nil) then
begin
FMXWindowParent := TFMXWindowParent.CreateNew(nil);
FMXWindowParent.Reparent(ParentForm.Handle);
ShowBrowser;
end;
end;
procedure TBrowserFrame.FMXChromium1AddressChange(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; const url: ustring);
begin
TThread.Queue(nil, procedure
begin
URLEdt.Text := url;
end);
end;
procedure TBrowserFrame.FMXChromium1AfterCreated(Sender: TObject;
const browser: ICefBrowser);
begin
TThread.Queue(nil, procedure
begin
AddressLay.Enabled := True;
end);
end;
procedure TBrowserFrame.FMXChromium1BeforeClose(Sender: TObject;
const browser: ICefBrowser);
begin
if assigned(FOnBrowserDestroyed) then FOnBrowserDestroyed(Sender);
end;
procedure TBrowserFrame.FMXChromium1BeforePopup(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);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TBrowserFrame.FMXChromium1Close(Sender: TObject;
const browser: ICefBrowser; var aAction: TCefCloseBrowserAction);
begin
aAction := cbaDelay;
if assigned(FOnBrowserClosing) then FOnBrowserClosing(self);
end;
procedure TBrowserFrame.FMXChromium1LoadError(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer;
const errorText, 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>';
FMXChromium1.LoadString(TempString, frame);
end;
procedure TBrowserFrame.FMXChromium1LoadingStateChange(Sender: TObject;
const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
begin
TThread.Queue(nil, procedure
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);
end;
procedure TBrowserFrame.FMXChromium1OpenUrlFromTab(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring;
targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean;
out Result: Boolean);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TBrowserFrame.FMXChromium1StatusMessage(Sender: TObject;
const browser: ICefBrowser; const value: ustring);
begin
TThread.Queue(nil, procedure
begin
StatusLbl.Text := value;
end);
end;
procedure TBrowserFrame.FMXChromium1TitleChange(Sender: TObject;
const browser: ICefBrowser; const title: ustring);
begin
if assigned(FOnBrowserTitleChange) then FOnBrowserTitleChange(Sender, title);
end;
procedure TBrowserFrame.ForwardBtnClick(Sender: TObject);
begin
FMXChromium1.GoForward;
end;
function TBrowserFrame.GetParentForm : TCustomForm;
var
TempParent : TTabItem;
begin
Result := nil;
TempParent := ParentTab;
if (TempParent <> nil) and (TempParent is TBrowserTab) then
Result := TBrowserTab(TempParent).ParentForm;
end;
function TBrowserFrame.GetParentTab : TTabItem;
var
TempParent : TFMXObject;
begin
Result := nil;
TempParent := Parent;
while (TempParent <> nil) and not(TempParent is TTabItem) do
TempParent := TempParent.Parent;
if (TempParent <> nil) and (TempParent is TTabItem) then
Result := TTabItem(TempParent);
end;
procedure TBrowserFrame.GoBtnClick(Sender: TObject);
begin
FMXChromium1.LoadURL(URLEdt.Text);
end;
procedure TBrowserFrame.CreateBrowser;
var
{$IFDEF MSWINDOWS}
TempHandle : HWND;
TempRect : System.Types.TRect;
TempClientRect : TRectF;
{$ENDIF}
begin
CreateFMXWindowParent;
if not(FMXChromium1.Initialized) then
begin
{$IFDEF MSWINDOWS}
TempHandle := FmxHandleToHWND(FMXWindowParent.Handle);
TempClientRect := FMXWindowParent.ClientRect;
TempRect.Left := round(TempClientRect.Left);
TempRect.Top := round(TempClientRect.Top);
TempRect.Right := round(TempClientRect.Right);
TempRect.Bottom := round(TempClientRect.Bottom);
FMXChromium1.DefaultUrl := FHomepage;
FMXChromium1.CreateBrowser(TempHandle, TempRect);
{$ENDIF}
end;
end;
procedure TBrowserFrame.CloseBrowser;
begin
if not(FClosing) then
begin
FClosing := True;
AddressLay.Enabled := False;
FMXChromium1.CloseBrowser(True);
end;
end;
end.

View File

@ -0,0 +1,185 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2020 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
unit uBrowserTab;
{$I cef.inc}
interface
uses
System.Classes, System.SysUtils, FMX.Forms, FMX.Types, FMX.Controls, FMX.TabControl,
uBrowserFrame;
type
TBrowserTab = class(TTabItem)
protected
FBrowserFrame : TBrowserFrame;
FTabID : cardinal;
function GetParentForm : TCustomForm;
procedure BrowserFrame_OnBrowserDestroyed(Sender: TObject);
procedure BrowserFrame_OnBrowserTitleChange(Sender: TObject; const aTitle : string);
procedure BrowserFrame_OnBrowserClosing(Sender: TObject);
public
constructor Create(AOwner: TComponent; aTabID : cardinal; const aCaption : string); reintroduce;
procedure NotifyMoveOrResizeStarted;
procedure DestroyWindowParent;
procedure CreateBrowser(const aHomepage : string);
procedure CloseBrowser;
procedure ResizeBrowser;
procedure ShowBrowser;
procedure HideBrowser;
function PostFormMessage(aMsg : cardinal; wParam : cardinal = 0; lParam : integer = 0) : boolean;
property TabID : cardinal read FTabID;
property ParentForm : TCustomForm read GetParentForm;
end;
implementation
uses
uMainForm;
constructor TBrowserTab.Create(AOwner: TComponent; aTabID : cardinal; const aCaption : string);
begin
inherited Create(AOwner);
FTabID := aTabID;
Text := aCaption;
FBrowserFrame := nil;
Name := 'BrowserTab' + inttostr(aTabID);
end;
function TBrowserTab.GetParentForm : TCustomForm;
var
TempParent : TFMXObject;
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.PostFormMessage(aMsg, wParam : cardinal; lParam : integer) : boolean;
var
TempForm : TCustomForm;
begin
TempForm := ParentForm;
Result := (TempForm <> nil) and
(TempForm is TMainForm) and
TMainForm(TempForm).PostCustomMessage(aMsg, wParam, lParam);
end;
procedure TBrowserTab.NotifyMoveOrResizeStarted;
begin
if (FBrowserFrame <> nil) then
FBrowserFrame.NotifyMoveOrResizeStarted;
end;
procedure TBrowserTab.DestroyWindowParent;
begin
if (FBrowserFrame <> nil) then
FBrowserFrame.DestroyWindowParent;
end;
procedure TBrowserTab.CreateBrowser(const aHomepage : string);
begin
FBrowserFrame := TBrowserFrame.Create(self);
FBrowserFrame.Parent := self;
FBrowserFrame.Align := TAlignLayout.Client;
FBrowserFrame.Visible := True;
FBrowserFrame.Homepage := aHomepage;
FBrowserFrame.Name := 'BrowserFrame' + inttostr(FTabID);
FBrowserFrame.OnBrowserDestroyed := BrowserFrame_OnBrowserDestroyed;
FBrowserFrame.OnBrowserTitleChange := BrowserFrame_OnBrowserTitleChange;
FBrowserFrame.OnBrowserClosing := BrowserFrame_OnBrowserClosing;
FBrowserFrame.CreateBrowser;
end;
procedure TBrowserTab.CloseBrowser;
begin
if (FBrowserFrame <> nil) then FBrowserFrame.CloseBrowser;
end;
procedure TBrowserTab.ResizeBrowser;
begin
if (FBrowserFrame <> nil) then FBrowserFrame.ResizeBrowser;
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.BrowserFrame_OnBrowserDestroyed(Sender: TObject);
begin
// This event is executed in a CEF thread so we have to send a message to
// destroy the tab in the main application thread.
PostFormMessage(CEF_DESTROYTAB, TabID);
end;
procedure TBrowserTab.BrowserFrame_OnBrowserTitleChange(Sender: TObject; const aTitle : string);
begin
// This event is executed in a CEF thread so we have to use TThread.Queue to
// set the "Text" property in the main application thread.
TThread.Queue(nil, procedure
begin
Text := aTitle;
end);
end;
procedure TBrowserTab.BrowserFrame_OnBrowserClosing(Sender: TObject);
begin
// This event is executed in a CEF thread so we have to send a message to
// destroy TFMXWindowParent in the main application thread.
PostFormMessage(CEF_DESTROYWINPARENT, TabID);
end;
end.

View File

@ -0,0 +1,73 @@
object MainForm: TMainForm
Left = 0
Top = 0
Caption = 'Initializing. Please, wait...'
ClientHeight = 716
ClientWidth = 979
Position = ScreenCenter
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
OnCreate = FormCreate
OnCloseQuery = FormCloseQuery
OnResize = FormResize
OnShow = FormShow
DesignerMasterStyle = 0
object ButtonLay: TLayout
Align = Left
Enabled = False
Padding.Left = 5.000000000000000000
Padding.Right = 5.000000000000000000
Size.Width = 32.000000000000000000
Size.Height = 716.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
object AddTabBtn: TSpeedButton
Action = AddTabAction
Align = Top
Enabled = True
ImageIndex = -1
Margins.Top = 5.000000000000000000
Position.X = 5.000000000000000000
Position.Y = 5.000000000000000000
Size.Width = 22.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'additembutton'
end
object RemoveTabBtn: TSpeedButton
Action = RemoveTabAction
Align = Top
Enabled = True
ImageIndex = -1
Margins.Top = 5.000000000000000000
Position.X = 5.000000000000000000
Position.Y = 32.000000000000000000
Size.Width = 22.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'deleteitembutton'
end
end
object BrowserTabCtrl: TTabControl
Align = Client
Size.Width = 947.000000000000000000
Size.Height = 716.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
TabPosition = PlatformDefault
OnChange = BrowserTabCtrlChange
end
object ActionList1: TActionList
Left = 72
Top = 80
object AddTabAction: TAction
Text = 'AddTabAction'
OnExecute = AddTabActionExecute
end
object RemoveTabAction: TAction
Text = 'RemoveTabAction'
OnExecute = RemoveTabActionExecute
end
end
end

View File

@ -0,0 +1,507 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2020 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
unit uMainForm;
{$I cef.inc}
interface
uses
{$IFDEF MSWINDOWS}
Winapi.Messages, Winapi.Windows,
{$ENDIF}
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.TabControl,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, System.Actions,
FMX.ActnList, System.Math;
const
CEF_INITIALIZED = WM_APP + $100;
CEF_DESTROYTAB = WM_APP + $101;
CEF_SHOWBROWSER = WM_APP + $102;
CEF_DESTROYWINPARENT = WM_APP + $103;
HOMEPAGE_URL = 'https://www.google.com';
DEFAULT_TAB_CAPTION = 'New tab';
type
TMainForm = class(TForm)
ButtonLay: TLayout;
AddTabBtn: TSpeedButton;
RemoveTabBtn: TSpeedButton;
BrowserTabCtrl: TTabControl;
ActionList1: TActionList;
AddTabAction: TAction;
RemoveTabAction: TAction;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure AddTabActionExecute(Sender: TObject);
procedure RemoveTabActionExecute(Sender: TObject);
procedure BrowserTabCtrlChange(Sender: TObject);
protected
// Variables to control when can we destroy the form safely
FCanClose : boolean;
FClosing : boolean;
FLastTabID : cardinal; // Used by NextTabID to generate unique tab IDs
{$IFDEF MSWINDOWS}
// This is a workaround for the issue #253
// https://github.com/salvadordf/CEF4Delphi/issues/253
FCustomWindowState : TWindowState;
FOldWndPrc : TFNWndProc;
FFormStub : Pointer;
function GetCurrentWindowState : TWindowState;
procedure UpdateCustomWindowState;
procedure CreateHandle; override;
procedure DestroyHandle; override;
procedure CustomWndProc(var aMessage: TMessage);
{$ENDIF}
function GetNextTabID : cardinal;
procedure EnableButtonLay;
procedure ShowSelectedBrowser;
procedure DestroyWindowParent(aTabID : cardinal);
procedure DestroyTab(aTabID : cardinal);
function CloseAllTabs : boolean;
procedure CloseSelectedTab;
property NextTabID : cardinal read GetNextTabID;
public
function PostCustomMessage(aMessage : cardinal; wParam : cardinal = 0; lParam : integer = 0) : boolean;
procedure NotifyMoveOrResizeStarted;
procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
end;
var
MainForm: TMainForm;
procedure CreateGlobalCEFApp;
implementation
{$R *.fmx}
uses
FMX.Platform, FMX.Platform.Win,
uCEFMiscFunctions, uCEFApplication, uCEFConstants, uBrowserTab;
// This demo shows how to use a TTabControl with TFrames that include
// CEF4Delphi browsers.
// Instead of a regular TTabItem we use a custom TBrowserTab class that
// inherits from TTabItem 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 you free it.
// TBrowserFrame has all the usual code to close CEF4Delphi browsers following
// a similar destruction sequence than the SimpleFMXBrowser demo :
//
// 1. TBrowserTab.CloseBrowser calls TChromium.CloseBrowser which triggers the
// TChromium.OnClose event.
// 2. TChromium.OnClose sends a CEF_DESTROYWINPARENT message to destroy
// CEFWindowParent1 in the main thread, which triggers the
// TChromium.OnBeforeClose event.
// 3. TChromium.OnBeforeClose executes the TBrowserFrame.OnBrowserDestroyed
// event which will be used in TBrowserTab to send a CEF_DESTROYTAB message
// to the main form to free the tab.
// To close safely this demo you must close all the browser tabs first following
// this steps :
//
// 1. FormCloseQuery sets CanClose to FALSE and calls CloseAllTabs and FClosing
// is set to TRUE.
// 2. Each tab will send a CEF_DESTROYTAB message to free that tab.
// 3. When TTabControl has no tabs then we can set FCanClose to TRUE and close
// the main form.
procedure GlobalCEFApp_OnContextInitialized;
begin
if (MainForm <> nil) then MainForm.PostCustomMessage(CEF_INITIALIZED);
end;
procedure CreateGlobalCEFApp;
begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.cache := 'cache';
GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized;
end;
procedure TMainForm.NotifyMoveOrResizeStarted;
var
i : integer;
begin
if (BrowserTabCtrl = nil) then exit;
i := pred(BrowserTabCtrl.TabCount);
while (i >= 0) do
begin
TBrowserTab(BrowserTabCtrl.Tabs[i]).NotifyMoveOrResizeStarted;
dec(i);
end;
end;
procedure TMainForm.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
PositionChanged: Boolean;
begin
PositionChanged := (ALeft <> Left) or (ATop <> Top);
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if PositionChanged then
NotifyMoveOrResizeStarted;
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := FCanClose;
if not(FClosing) then
begin
FClosing := True;
ButtonLay.Enabled := False;
if not(CloseAllTabs) then CanClose := True;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
FCanClose := False;
FClosing := False;
FLastTabID := 0;
end;
procedure TMainForm.FormResize(Sender: TObject);
var
i : integer;
begin
i := pred(BrowserTabCtrl.TabCount);
while (i >= 0) do
begin
TBrowserTab(BrowserTabCtrl.Tabs[i]).ResizeBrowser;
dec(i);
end;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
if (GlobalCEFApp <> nil) and GlobalCEFApp.GlobalContextInitialized then
EnableButtonLay;
end;
procedure TMainForm.EnableButtonLay;
begin
if not(ButtonLay.Enabled) then
begin
ButtonLay.Enabled := True;
Caption := 'FMX Tabbed Browser';
cursor := crDefault;
if (BrowserTabCtrl.TabCount <= 0) then AddTabAction.Execute;
end;
end;
function TMainForm.GetNextTabID : cardinal;
begin
inc(FLastTabID);
Result := FLastTabID;
end;
procedure TMainForm.ShowSelectedBrowser;
begin
if (BrowserTabCtrl.ActiveTab <> nil) then
TBrowserTab(BrowserTabCtrl.ActiveTab).ShowBrowser;
end;
procedure TMainForm.AddTabActionExecute(Sender: TObject);
var
TempNewTab : TBrowserTab;
begin
TempNewTab := TBrowserTab.Create(BrowserTabCtrl, NextTabID, DEFAULT_TAB_CAPTION);
TempNewTab.Parent := BrowserTabCtrl;
BrowserTabCtrl.TabIndex := pred(BrowserTabCtrl.TabCount);
TempNewTab.CreateBrowser(HOMEPAGE_URL);
end;
procedure TMainForm.RemoveTabActionExecute(Sender: TObject);
begin
CloseSelectedTab;
end;
{$IFDEF MSWINDOWS}
procedure TMainForm.CreateHandle;
begin
inherited CreateHandle;
FFormStub := MakeObjectInstance(CustomWndProc);
FOldWndPrc := TFNWndProc(SetWindowLongPtr(FmxHandleToHWND(Handle), GWLP_WNDPROC, NativeInt(FFormStub)));
end;
procedure TMainForm.DestroyHandle;
begin
SetWindowLongPtr(FmxHandleToHWND(Handle), GWLP_WNDPROC, NativeInt(FOldWndPrc));
FreeObjectInstance(FFormStub);
inherited DestroyHandle;
end;
procedure TMainForm.CustomWndProc(var aMessage: TMessage);
const
SWP_STATECHANGED = $8000; // Undocumented
var
TempWindowPos : PWindowPos;
begin
try
case aMessage.Msg of
WM_ENTERMENULOOP :
if (aMessage.wParam = 0) and
(GlobalCEFApp <> nil) then
GlobalCEFApp.OsmodalLoop := True;
WM_EXITMENULOOP :
if (aMessage.wParam = 0) and
(GlobalCEFApp <> nil) then
GlobalCEFApp.OsmodalLoop := False;
WM_MOVE,
WM_MOVING : NotifyMoveOrResizeStarted;
WM_SIZE :
if (aMessage.wParam = SIZE_RESTORED) then
UpdateCustomWindowState;
WM_WINDOWPOSCHANGING :
begin
TempWindowPos := TWMWindowPosChanging(aMessage).WindowPos;
if ((TempWindowPos.Flags and SWP_STATECHANGED) <> 0) then
UpdateCustomWindowState;
end;
WM_SHOWWINDOW :
if (aMessage.wParam <> 0) and (aMessage.lParam = SW_PARENTOPENING) then
PostCustomMessage(CEF_SHOWBROWSER);
CEF_INITIALIZED : EnableButtonLay;
CEF_DESTROYWINPARENT : DestroyWindowParent(aMessage.wParam);
CEF_DESTROYTAB : DestroyTab(aMessage.wParam);
CEF_SHOWBROWSER : ShowSelectedBrowser;
end;
aMessage.Result := CallWindowProc(FOldWndPrc, FmxHandleToHWND(Handle), aMessage.Msg, aMessage.wParam, aMessage.lParam);
except
on e : exception do
if CustomExceptionHandler('TMainForm.CustomWndProc', e) then raise;
end;
end;
procedure TMainForm.UpdateCustomWindowState;
var
TempNewState : TWindowState;
begin
TempNewState := GetCurrentWindowState;
if (FCustomWindowState <> TempNewState) then
begin
// This is a workaround for the issue #253
// https://github.com/salvadordf/CEF4Delphi/issues/253
if (FCustomWindowState = TWindowState.wsMinimized) then
PostCustomMessage(CEF_SHOWBROWSER);
FCustomWindowState := TempNewState;
end;
end;
function TMainForm.GetCurrentWindowState : TWindowState;
var
TempPlacement : TWindowPlacement;
TempHWND : HWND;
begin
// TForm.WindowState is not updated correctly in FMX forms.
// We have to call the GetWindowPlacement function in order to read the window state correctly.
Result := TWindowState.wsNormal;
TempHWND := FmxHandleToHWND(Handle);
ZeroMemory(@TempPlacement, SizeOf(TWindowPlacement));
TempPlacement.Length := SizeOf(TWindowPlacement);
if GetWindowPlacement(TempHWND, @TempPlacement) then
case TempPlacement.showCmd of
SW_SHOWMAXIMIZED : Result := TWindowState.wsMaximized;
SW_SHOWMINIMIZED : Result := TWindowState.wsMinimized;
end;
if IsIconic(TempHWND) then Result := TWindowState.wsMinimized;
end;
{$ENDIF}
procedure TMainForm.DestroyWindowParent(aTabID : cardinal);
var
i : integer;
TempTab : TBrowserTab;
begin
i := pred(BrowserTabCtrl.TabCount);
while (i >= 0) do
begin
TempTab := TBrowserTab(BrowserTabCtrl.Tabs[i]);
if (TempTab.TabID = aTabID) then
begin
TempTab.DestroyWindowParent;
break;
end
else
dec(i);
end;
end;
procedure TMainForm.DestroyTab(aTabID : cardinal);
var
i : integer;
TempTab : TBrowserTab;
TempText : string;
begin
i := pred(BrowserTabCtrl.TabCount);
while (i >= 0) do
begin
TempTab := TBrowserTab(BrowserTabCtrl.Tabs[i]);
if (TempTab.TabID = aTabID) then
begin
BrowserTabCtrl.Delete(i);
break;
end
else
dec(i);
end;
if FClosing then
begin
if (BrowserTabCtrl.TabCount <= 0) then
begin
FCanClose := True;
Close;
end;
end
else
begin
ShowSelectedBrowser;
// Sometimes TTabControl doesn't draw the new selected tab correctly.
// Changing TTabItem.Text forces the component to redraw all the tabs.
// A nicer solution would be to use a custom ttabcontrol that publishes
// the TTabControl.RealignTabs procedure.
if (BrowserTabCtrl.ActiveTab <> nil) then
begin
TempText := BrowserTabCtrl.ActiveTab.Text;
BrowserTabCtrl.ActiveTab.Text := TempText + '-';
BrowserTabCtrl.ActiveTab.Text := TempText;
end;
end;
end;
function TMainForm.PostCustomMessage(aMessage, wParam : cardinal; lParam : integer) : boolean;
{$IFDEF MSWINDOWS}
var
TempHWND : HWND;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
TempHWND := FmxHandleToHWND(Handle);
Result := (TempHWND <> 0) and WinApi.Windows.PostMessage(TempHWND, aMessage, wParam, lParam);
{$ELSE}
Result := False;
{$ENDIF}
end;
procedure TMainForm.BrowserTabCtrlChange(Sender: TObject);
var
i : integer;
begin
i := pred(BrowserTabCtrl.TabCount);
while (i >= 0) do
begin
if (BrowserTabCtrl.TabIndex = i) then
TBrowserTab(BrowserTabCtrl.Tabs[i]).ShowBrowser
else
TBrowserTab(BrowserTabCtrl.Tabs[i]).HideBrowser;
dec(i);
end;
end;
function TMainForm.CloseAllTabs : boolean;
var
i : integer;
begin
Result := False;
i := pred(BrowserTabCtrl.TabCount);
while (i >= 0) do
begin
TBrowserTab(BrowserTabCtrl.Tabs[i]).CloseBrowser;
Result := True;
dec(i);
end;
end;
procedure TMainForm.CloseSelectedTab;
begin
if (BrowserTabCtrl.ActiveTab <> nil) then
TBrowserTab(BrowserTabCtrl.ActiveTab).CloseBrowser;
end;
end.

View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 97,
"InternalVersion" : 98,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "79.1.36.0"
}