From b0259524c514fa6360da0037039dc4856c0c89a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Salvador=20D=C3=ADaz=20Fau?= Date: Sun, 20 Jun 2021 13:08:37 +0200 Subject: [PATCH] Update to CEF 91.1.21 The TabbedBrowser2 demo for Windows can now open new tabs without losing the POST data. --- README.md | 16 +- .../TabbedBrowser2/TabbedBrowser2.dpr | 8 +- .../TabbedBrowser2/TabbedBrowser2.dproj | 2 +- .../TabbedBrowser2/uBrowserFrame.dfm | 18 +- .../TabbedBrowser2/uBrowserFrame.pas | 281 ++++- .../Delphi_VCL/TabbedBrowser2/uBrowserTab.pas | 83 +- .../Delphi_VCL/TabbedBrowser2/uChildForm.dfm | 2 + .../Delphi_VCL/TabbedBrowser2/uChildForm.pas | 111 +- demos/Delphi_VCL/TabbedBrowser2/uMainForm.dfm | 7 +- demos/Delphi_VCL/TabbedBrowser2/uMainForm.pas | 227 +++- .../TabbedBrowser2/TabbedBrowser2.dproj | 983 ------------------ .../TabbedBrowser2/TabbedBrowser2.lpi | 9 +- .../TabbedBrowser2/TabbedBrowser2.lpr | 19 +- .../TabbedBrowser2/uBrowserFrame.lfm | 134 +-- .../TabbedBrowser2/uBrowserFrame.pas | 373 ++++++- .../TabbedBrowser2/uBrowserTab.pas | 108 +- .../TabbedBrowser2/uChildForm.lfm | 37 + .../TabbedBrowser2/uChildForm.pas | 314 ++++++ .../TabbedBrowser2/uMainForm.lfm | 48 +- .../TabbedBrowser2/uMainForm.pas | 337 +++++- packages/cef4delphi_lazarus.lpk | 2 +- source/uCEFApplicationCore.pas | 4 +- update_CEF4Delphi.json | 4 +- 23 files changed, 1796 insertions(+), 1331 deletions(-) delete mode 100644 demos/Lazarus_Windows/TabbedBrowser2/TabbedBrowser2.dproj create mode 100644 demos/Lazarus_Windows/TabbedBrowser2/uChildForm.lfm create mode 100644 demos/Lazarus_Windows/TabbedBrowser2/uChildForm.pas diff --git a/README.md b/README.md index e8b23ed9..7cdd1390 100644 --- a/README.md +++ b/README.md @@ -3,15 +3,15 @@ CEF4Delphi is an open source project created by Salvador Díaz Fau to embed Chro CEF4Delphi is based on DCEF3 and fpCEF3. The original license of those projects still applies to CEF4Delphi. Read the license terms in the first lines of any *.pas file. -CEF4Delphi uses CEF 91.1.20 which includes Chromium 91.0.4472.101. +CEF4Delphi uses CEF 91.1.21 which includes Chromium 91.0.4472.114. The CEF binaries used by CEF4Delphi are available for download at spotify : -* [Windows 32 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.20%2Bg5800665%2Bchromium-91.0.4472.101_windows32.tar.bz2) -* [Windows 64 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.20%2Bg5800665%2Bchromium-91.0.4472.101_windows64.tar.bz2) -* [Linux x86 32 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.20%2Bg5800665%2Bchromium-91.0.4472.101_linux32.tar.bz2) -* [Linux x86 64 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.20%2Bg5800665%2Bchromium-91.0.4472.101_linux64.tar.bz2) -* [Linux ARM 32 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.20%2Bg5800665%2Bchromium-91.0.4472.101_linuxarm.tar.bz2) -* [Linux ARM 64 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.20%2Bg5800665%2Bchromium-91.0.4472.101_linuxarm64.tar.bz2) -* [MacOS x86 64 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.20%2Bg5800665%2Bchromium-91.0.4472.101_macosx64.tar.bz2) +* [Windows 32 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.21%2Bg9dd45fe%2Bchromium-91.0.4472.114_windows32.tar.bz2) +* [Windows 64 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.21%2Bg9dd45fe%2Bchromium-91.0.4472.114_windows64.tar.bz2) +* [Linux x86 32 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.21%2Bg9dd45fe%2Bchromium-91.0.4472.114_linux32.tar.bz2) +* [Linux x86 64 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.21%2Bg9dd45fe%2Bchromium-91.0.4472.114_linux64.tar.bz2) +* [Linux ARM 32 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.21%2Bg9dd45fe%2Bchromium-91.0.4472.114_linuxarm.tar.bz2) +* [Linux ARM 64 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.21%2Bg9dd45fe%2Bchromium-91.0.4472.114_linuxarm64.tar.bz2) +* [MacOS x86 64 bits](https://cef-builds.spotifycdn.com/cef_binary_91.1.21%2Bg9dd45fe%2Bchromium-91.0.4472.114_macosx64.tar.bz2) CEF4Delphi was developed and tested on Delphi 10.4.2 and it has been tested in Delphi 7, Delphi XE, Delphi 10, Delphi 10.2, Delphi 10.3 and Lazarus 2.0.12/FPC 3.2.0. CEF4Delphi includes VCL, FireMonkey (FMX) and Lazarus components. diff --git a/demos/Delphi_VCL/TabbedBrowser2/TabbedBrowser2.dpr b/demos/Delphi_VCL/TabbedBrowser2/TabbedBrowser2.dpr index 3545464f..660a0f1a 100644 --- a/demos/Delphi_VCL/TabbedBrowser2/TabbedBrowser2.dpr +++ b/demos/Delphi_VCL/TabbedBrowser2/TabbedBrowser2.dpr @@ -55,9 +55,11 @@ uses {$R *.res} -// 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} +{$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; diff --git a/demos/Delphi_VCL/TabbedBrowser2/TabbedBrowser2.dproj b/demos/Delphi_VCL/TabbedBrowser2/TabbedBrowser2.dproj index b44cb296..3520c959 100644 --- a/demos/Delphi_VCL/TabbedBrowser2/TabbedBrowser2.dproj +++ b/demos/Delphi_VCL/TabbedBrowser2/TabbedBrowser2.dproj @@ -6,7 +6,7 @@ TabbedBrowser2.dpr True Debug - Win32 + Win64 3 Application diff --git a/demos/Delphi_VCL/TabbedBrowser2/uBrowserFrame.dfm b/demos/Delphi_VCL/TabbedBrowser2/uBrowserFrame.dfm index 60d93490..4e2f227d 100644 --- a/demos/Delphi_VCL/TabbedBrowser2/uBrowserFrame.dfm +++ b/demos/Delphi_VCL/TabbedBrowser2/uBrowserFrame.dfm @@ -30,7 +30,6 @@ object BrowserFrame: TBrowserFrame Top = 5 Width = 25 Height = 25 - Align = alLeft Caption = '3' Font.Charset = SYMBOL_CHARSET Font.Color = clWindowText @@ -76,7 +75,6 @@ object BrowserFrame: TBrowserFrame Top = 5 Width = 25 Height = 25 - Align = alRight Caption = '=' Font.Charset = SYMBOL_CHARSET Font.Color = clWindowText @@ -95,15 +93,16 @@ object BrowserFrame: TBrowserFrame Height = 35 Align = alClient BevelOuter = bvNone - Padding.Top = 7 - Padding.Bottom = 10 TabOrder = 1 + DesignSize = ( + 774 + 35) object URLCbx: TComboBox - Left = 0 + Left = 2 Top = 7 - Width = 774 + Width = 770 Height = 21 - Align = alClient + Anchors = [akLeft, akTop, akRight] ItemIndex = 0 TabOrder = 0 Text = 'https://www.google.com' @@ -173,17 +172,12 @@ object BrowserFrame: TBrowserFrame Height = 35 Align = alRight BevelOuter = bvNone - Padding.Left = 5 - Padding.Top = 5 - Padding.Right = 5 - Padding.Bottom = 5 TabOrder = 2 object GoBtn: TButton Left = 5 Top = 5 Width = 25 Height = 25 - Align = alClient Caption = #9658 Font.Charset = ANSI_CHARSET Font.Color = clWindowText diff --git a/demos/Delphi_VCL/TabbedBrowser2/uBrowserFrame.pas b/demos/Delphi_VCL/TabbedBrowser2/uBrowserFrame.pas index 33e50974..8d49ac37 100644 --- a/demos/Delphi_VCL/TabbedBrowser2/uBrowserFrame.pas +++ b/demos/Delphi_VCL/TabbedBrowser2/uBrowserFrame.pas @@ -45,15 +45,22 @@ 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, + Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.StdCtrls, System.SyncObjs, {$ELSE} Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, - ExtCtrls, ComCtrls, StdCtrls, + ExtCtrls, ComCtrls, StdCtrls, SyncObjs, {$ENDIF} uCEFWinControl, uCEFWindowParent, uCEFChromiumCore, uCEFChromium, uCEFInterfaces, uCEFTypes, uCEFConstants; +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; @@ -90,24 +97,59 @@ type procedure GoBtnClick(Sender: TObject); protected + FCriticalSection : TCriticalSection; FClosing : boolean; // Indicates that this frame is destroying the browser FHomepage : string; + FPendingAddress : string; + FPendingTitle : string; + FPendingStatus : string; + FPendingIsLoading : boolean; + FPendingCanGoBack : boolean; + FPendingCanGoForward : boolean; FOnBrowserDestroyed : TNotifyEvent; FOnBrowserTitleChange : TBrowserTitleEvent; - function CreateClientHandler(var windowInfo : TCefWindowInfo; var client : ICefClient; const targetFrameName : string; const popupFeatures : TCefPopupFeatures) : boolean; + function GetInitialized : boolean; + function GetPendingAddress : string; + function GetPendingTitle : string; + function GetPendingStatus : string; + function GetPendingIsLoading : boolean; + function GetPendingCanGoBack : boolean; + function GetPendingCanGoForward : boolean; + + procedure SetPendingAddress(const aValue : string); + procedure SetPendingTitle(const aValue : string); + procedure SetPendingStatus(const aValue : string); + procedure SetPendingIsLoading(aValue : boolean); + procedure SetPendingCanGoBack(aValue : boolean); + procedure SetPendingCanGoForward(aValue : boolean); procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED; procedure BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY; + procedure BrowserUpdateCaptionMsg(var aMessage : TMessage); message CEF_UPDATECAPTION; + procedure BrowserUpdateAddressMsg(var aMessage : TMessage); message CEF_UPDATEADDRESS; + procedure BrowserUpdateStateMsg(var aMessage : TMessage); message CEF_UPDATESTATE; + procedure BrowserUpdateStatusTextMsg(var aMessage : TMessage); message CEF_UPDATESTATUSTEXT; + + property PendingAddress : string read GetPendingAddress write SetPendingAddress; + property PendingTitle : string read GetPendingTitle write SetPendingTitle; + property PendingStatus : string read GetPendingStatus write SetPendingStatus; + property PendingIsLoading : boolean read GetPendingIsLoading write SetPendingIsLoading; + property PendingCanGoBack : boolean read GetPendingCanGoBack write SetPendingCanGoBack; + property PendingCanGoForward : boolean read GetPendingCanGoForward write SetPendingCanGoForward; public constructor Create(AOwner : TComponent); override; + destructor Destroy; override; procedure NotifyMoveOrResizeStarted; + procedure CreateAllHandles; procedure CreateBrowser; procedure CloseBrowser; procedure ShowBrowser; procedure HideBrowser; + function CreateClientHandler(var windowInfo : TCefWindowInfo; var client : ICefClient; const targetFrameName : string; const popupFeatures : TCefPopupFeatures) : boolean; + property Initialized : boolean read GetInitialized; property Closing : boolean read FClosing; property Homepage : string read FHomepage write FHomepage; property OnBrowserDestroyed : TNotifyEvent read FOnBrowserDestroyed write FOnBrowserDestroyed; @@ -119,18 +161,137 @@ implementation {$R *.dfm} uses - uBrowserTab; + uCEFMiscFunctions, 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 sets CanClose to FALSE calls TChromium.CloseBrowser +// which triggers the TChromium.OnClose event. +// 2. TChromium.OnClose sends a CEFBROWSER_DESTROY message to destroy CEFWindowParent1 +// in the main thread, which triggers the TChromium.OnBeforeClose event. +// 3. TChromium.OnBeforeClose triggers the TBrowserFrame.OnBrowserDestroyed event +// which sends a CEF_DESTROYTAB message with the TabID to the main form. constructor TBrowserFrame.Create(AOwner : TComponent); begin inherited Create(AOwner); + FCriticalSection := TCriticalSection.Create; FClosing := False; FHomepage := ''; FOnBrowserDestroyed := nil; FOnBrowserTitleChange := nil; end; +destructor TBrowserFrame.Destroy; +begin + FreeAndNil(FCriticalSection); + + inherited Destroy; +end; + +procedure TBrowserFrame.CreateAllHandles; +begin + CreateHandle; + + CEFWindowParent1.CreateHandle; +end; + +function TBrowserFrame.GetInitialized : boolean; +begin + Result := Chromium1.Initialized; +end; + +function TBrowserFrame.GetPendingAddress : string; +begin + FCriticalSection.Acquire; + Result := FPendingAddress; + FCriticalSection.Release; +end; + +function TBrowserFrame.GetPendingTitle : string; +begin + FCriticalSection.Acquire; + Result := FPendingTitle; + FCriticalSection.Release; +end; + +function TBrowserFrame.GetPendingStatus : string; +begin + FCriticalSection.Acquire; + Result := FPendingStatus; + FCriticalSection.Release; +end; + +function TBrowserFrame.GetPendingIsLoading : boolean; +begin + FCriticalSection.Acquire; + Result := FPendingIsLoading; + FCriticalSection.Release; +end; + +function TBrowserFrame.GetPendingCanGoBack : boolean; +begin + FCriticalSection.Acquire; + Result := FPendingCanGoBack; + FCriticalSection.Release; +end; + +function TBrowserFrame.GetPendingCanGoForward : boolean; +begin + FCriticalSection.Acquire; + Result := FPendingCanGoForward; + FCriticalSection.Release; +end; + +procedure TBrowserFrame.SetPendingAddress(const aValue : string); +begin + FCriticalSection.Acquire; + FPendingAddress := aValue; + FCriticalSection.Release; +end; + +procedure TBrowserFrame.SetPendingTitle(const aValue : string); +begin + FCriticalSection.Acquire; + FPendingTitle := aValue; + FCriticalSection.Release; +end; + +procedure TBrowserFrame.SetPendingStatus(const aValue : string); +begin + FCriticalSection.Acquire; + FPendingStatus := aValue; + FCriticalSection.Release; +end; + +procedure TBrowserFrame.SetPendingIsLoading(aValue : boolean); +begin + FCriticalSection.Acquire; + FPendingIsLoading := aValue; + FCriticalSection.Release; +end; + +procedure TBrowserFrame.SetPendingCanGoBack(aValue : boolean); +begin + FCriticalSection.Acquire; + FPendingCanGoBack := aValue; + FCriticalSection.Release; +end; + +procedure TBrowserFrame.SetPendingCanGoForward(aValue : boolean); +begin + FCriticalSection.Acquire; + FPendingCanGoForward := aValue; + FCriticalSection.Release; +end; + procedure TBrowserFrame.NotifyMoveOrResizeStarted; begin Chromium1.NotifyMoveOrResizeStarted; @@ -201,9 +362,8 @@ procedure TBrowserFrame.Chromium1AddressChange( Sender : TObject; const frame : ICefFrame; const url : ustring); begin - if (URLCbx.Items.IndexOf(url) < 0) then URLCbx.Items.Add(url); - - URLCbx.Text := url; + PendingAddress := url; + PostMessage(Handle, CEF_UPDATEADDRESS, 0, 0); end; procedure TBrowserFrame.Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser); @@ -226,15 +386,9 @@ procedure TBrowserFrame.Chromium1BeforePopup( Sender : TObject; var noJavascriptAccess : Boolean; var Result : Boolean); begin - case targetDisposition of - WOD_NEW_FOREGROUND_TAB, - WOD_NEW_BACKGROUND_TAB, - WOD_NEW_WINDOW : Result := True; // For simplicity, this demo blocks new tabs and new windows. - - WOD_NEW_POPUP : Result := not(CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures)); - - else Result := False; - end; + Result := not(assigned(Parent) and + (Parent is TBrowserTab) and + TBrowserTab(Parent).DoOnBeforePopup(windowInfo, client, targetFrameName, popupFeatures, targetDisposition)); end; procedure TBrowserFrame.Chromium1OpenUrlFromTab( Sender : TObject; @@ -245,7 +399,9 @@ procedure TBrowserFrame.Chromium1OpenUrlFromTab( Sender : TObjec userGesture : Boolean; out Result : Boolean); begin - Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]); + Result := assigned(Parent) and + (Parent is TBrowserTab) and + TBrowserTab(Parent).DoOpenUrlFromTab(targetUrl, targetDisposition); end; procedure TBrowserFrame.Chromium1Close( Sender : TObject; @@ -281,38 +437,32 @@ procedure TBrowserFrame.Chromium1LoadingStateChange( Sender : TObject canGoBack : Boolean; canGoForward : Boolean); begin - BackBtn.Enabled := canGoBack; - ForwardBtn.Enabled := canGoForward; + PendingIsLoading := isLoading; + PendingCanGoBack := canGoBack; + PendingCanGoForward := canGoForward; - if isLoading then - begin - ReloadBtn.Enabled := False; - StopBtn.Enabled := True; - end - else - begin - ReloadBtn.Enabled := True; - StopBtn.Enabled := False; - end; + PostMessage(Handle, CEF_UPDATESTATE, 0, 0); end; procedure TBrowserFrame.Chromium1StatusMessage( Sender : TObject; const browser : ICefBrowser; const value : ustring); begin - StatusBar1.Panels[0].Text := value; + PendingStatus := value; + + PostMessage(Handle, CEF_UPDATESTATUSTEXT, 0, 0); end; procedure TBrowserFrame.Chromium1TitleChange( Sender : TObject; const browser : ICefBrowser; const title : ustring); begin - if not(assigned(FOnBrowserTitleChange)) then exit; - if (length(title) > 0) then - FOnBrowserTitleChange(self, title) + PendingTitle := title else - FOnBrowserTitleChange(self, Chromium1.DocumentURL); + PendingTitle := Chromium1.DocumentURL; + + PostMessage(Handle, CEF_UPDATECAPTION, 0, 0); end; procedure TBrowserFrame.BrowserCreatedMsg(var aMessage : TMessage); @@ -326,14 +476,63 @@ begin CEFWindowParent1.Free; end; -function TBrowserFrame.CreateClientHandler(var windowInfo : TCefWindowInfo; - var client : ICefClient; - const targetFrameName : string; - const popupFeatures : TCefPopupFeatures) : boolean; +procedure TBrowserFrame.BrowserUpdateCaptionMsg(var aMessage : TMessage); begin - Result := assigned(Parent) and - (Parent is TBrowserTab) and - TBrowserTab(Parent).CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures); + if assigned(FOnBrowserTitleChange) then + FOnBrowserTitleChange(self, PendingTitle); +end; + +procedure TBrowserFrame.BrowserUpdateAddressMsg(var aMessage : TMessage); +var + TempAddress : string; +begin + TempAddress := PendingAddress; + + if (URLCbx.Items.IndexOf(TempAddress) < 0) then + URLCbx.Items.Add(TempAddress); + + URLCbx.Text := TempAddress; +end; + +procedure TBrowserFrame.BrowserUpdateStateMsg(var aMessage : TMessage); +begin + BackBtn.Enabled := PendingCanGoBack; + ForwardBtn.Enabled := PendingCanGoForward; + + if PendingIsLoading then + begin + ReloadBtn.Enabled := False; + StopBtn.Enabled := True; + end + else + begin + ReloadBtn.Enabled := True; + StopBtn.Enabled := False; + end; +end; + +procedure TBrowserFrame.BrowserUpdateStatusTextMsg(var aMessage : TMessage); +begin + StatusBar1.Panels[0].Text := PendingStatus; +end; + +function TBrowserFrame.CreateClientHandler(var windowInfo : TCefWindowInfo; + var client : ICefClient; + const targetFrameName : string; + const popupFeatures : TCefPopupFeatures) : boolean; +var + TempRect : TRect; +begin + if CEFWindowParent1.HandleAllocated and + Chromium1.CreateClientHandler(client, False) then + begin + Result := True; + TempRect := CEFWindowParent1.ClientRect; + + WindowInfoAsChild(windowInfo, CEFWindowParent1.Handle, TempRect, ''); + end + else + Result := False; end; end. diff --git a/demos/Delphi_VCL/TabbedBrowser2/uBrowserTab.pas b/demos/Delphi_VCL/TabbedBrowser2/uBrowserTab.pas index 31e8fa44..97f7df30 100644 --- a/demos/Delphi_VCL/TabbedBrowser2/uBrowserTab.pas +++ b/demos/Delphi_VCL/TabbedBrowser2/uBrowserTab.pas @@ -44,10 +44,10 @@ interface uses {$IFDEF DELPHI16_UP} Winapi.Windows, System.Classes, Winapi.Messages, Vcl.ComCtrls, Vcl.Controls, - Vcl.Forms, + Vcl.Forms, System.SysUtils, {$ELSE} Windows, Classes, Messages, ComCtrls, Controls, - Forms, + Forms, SysUtils, {$ENDIF} uCEFInterfaces, uCEFTypes, uBrowserFrame; @@ -58,6 +58,8 @@ type FTabID : cardinal; function GetParentForm : TCustomForm; + function GetInitialized : boolean; + function GetClosing : boolean; function PostFormMessage(aMsg : cardinal; aWParam : WPARAM = 0; aLParam : LPARAM = 0) : boolean; @@ -69,13 +71,18 @@ type 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; 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 TabID : cardinal read FTabID; + property Closing : boolean read GetClosing; + property Initialized : boolean read GetInitialized; end; implementation @@ -107,6 +114,18 @@ begin 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; @@ -122,17 +141,28 @@ 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.OnBrowserDestroyed := BrowserFrame_OnBrowserDestroyed; + FBrowserFrame.OnBrowserTitleChange := BrowserFrame_OnBrowserTitleChange; + FBrowserFrame.CreateAllHandles; + end; + + FBrowserFrame.Homepage := aHomepage; +end; + procedure TBrowserTab.CreateBrowser(const aHomepage : string); begin - FBrowserFrame := TBrowserFrame.Create(self); - FBrowserFrame.Parent := self; - FBrowserFrame.Align := alClient; - FBrowserFrame.Visible := True; - FBrowserFrame.Homepage := aHomepage; - FBrowserFrame.OnBrowserDestroyed := BrowserFrame_OnBrowserDestroyed; - FBrowserFrame.OnBrowserTitleChange := BrowserFrame_OnBrowserTitleChange; + CreateFrame(aHomepage); - FBrowserFrame.CreateBrowser; + if (FBrowserFrame <> nil) then FBrowserFrame.CreateBrowser; end; procedure TBrowserTab.CloseBrowser; @@ -162,17 +192,38 @@ begin Caption := aTitle; end; -function TBrowserTab.CreateClientHandler(var windowInfo : TCefWindowInfo; - var client : ICefClient; - const targetFrameName : string; - const popupFeatures : TCefPopupFeatures) : boolean; +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).CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures); + TMainForm(TempForm).DoOnBeforePopup(windowInfo, client, targetFrameName, popupFeatures, targetDisposition); +end; + +function TBrowserTab.DoOpenUrlFromTab(const targetUrl : string; + targetDisposition : TCefWindowOpenDisposition) : boolean; +var + TempForm : TCustomForm; +begin + TempForm := ParentForm; + Result := (TempForm <> nil) and + (TempForm is TMainForm) and + TMainForm(TempForm).DoOpenUrlFromTab(targetUrl, targetDisposition); end; end. diff --git a/demos/Delphi_VCL/TabbedBrowser2/uChildForm.dfm b/demos/Delphi_VCL/TabbedBrowser2/uChildForm.dfm index 60c65c9a..f98de1c4 100644 --- a/demos/Delphi_VCL/TabbedBrowser2/uChildForm.dfm +++ b/demos/Delphi_VCL/TabbedBrowser2/uChildForm.dfm @@ -29,8 +29,10 @@ object ChildForm: TChildForm object Chromium1: TChromium OnTitleChange = Chromium1TitleChange OnBeforePopup = Chromium1BeforePopup + OnAfterCreated = Chromium1AfterCreated OnBeforeClose = Chromium1BeforeClose OnClose = Chromium1Close + OnOpenUrlFromTab = Chromium1OpenUrlFromTab Left = 24 Top = 56 end diff --git a/demos/Delphi_VCL/TabbedBrowser2/uChildForm.pas b/demos/Delphi_VCL/TabbedBrowser2/uChildForm.pas index 5c023eeb..b63a88dd 100644 --- a/demos/Delphi_VCL/TabbedBrowser2/uChildForm.pas +++ b/demos/Delphi_VCL/TabbedBrowser2/uChildForm.pas @@ -53,6 +53,9 @@ uses uCEFChromium, uCEFTypes, uCEFInterfaces, uCEFConstants, uCEFWindowParent, uCEFWinControl, uCEFChromiumCore; +const + CEF_UPDATECAPTION = WM_APP + $A55; + type TChildForm = class(TForm) Chromium1: TChromium; @@ -63,30 +66,38 @@ type procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + procedure Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser); procedure Chromium1BeforePopup(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl, targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; const popupFeatures: TCefPopupFeatures; var windowInfo: TCefWindowInfo; var client: ICefClient; var settings: TCefBrowserSettings; var extra_info: ICefDictionaryValue; var noJavascriptAccess: Boolean; var Result: Boolean); procedure Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring); procedure Chromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction); 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); protected + FCriticalSection : TCriticalSection; FCanClose : boolean; FClosing : boolean; - FClientInitialized : boolean; + FBrowserWasCreated : boolean; + FTitle : string; FPopupFeatures : TCefPopupFeatures; + function GetInitialized : boolean; + 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 BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY; + procedure BrowserUpdateCaptionMsg(var aMessage : TMessage); message CEF_UPDATECAPTION; public procedure AfterConstruction; override; + function CreateBrowser(const aHomepage : string) : boolean; function CreateClientHandler(var windowInfo : TCefWindowInfo; var client : ICefClient; const targetFrameName : string; const popupFeatures : TCefPopupFeatures) : boolean; procedure ApplyPopupFeatures; - property ClientInitialized : boolean read FClientInitialized; - property Closing : boolean read FClosing; + property Initialized : boolean read GetInitialized; + property Closing : boolean read FClosing; end; implementation @@ -103,8 +114,10 @@ uses // Destruction steps // ================= -// 1. FormCloseQuery sets CanClose to FALSE calls TChromium.CloseBrowser which triggers the TChromium.OnClose event. -// 2. TChromium.OnClose sends a CEFBROWSER_DESTROY message to destroy CEFWindowParent1 in the main thread, which triggers the TChromium.OnBeforeClose event. +// 1. FormCloseQuery sets CanClose to FALSE calls TChromium.CloseBrowser which +// triggers the TChromium.OnClose event. +// 2. TChromium.OnClose sends a CEFBROWSER_DESTROY message to destroy CEFWindowParent1 +// in the main thread, which triggers the TChromium.OnBeforeClose event. // 3. TChromium.OnBeforeClose sets FCanClose := True and sends WM_CLOSE to the form. procedure TChildForm.AfterConstruction; @@ -126,10 +139,9 @@ begin if CEFWindowParent1.HandleAllocated and Chromium1.CreateClientHandler(client, False) then begin - Result := True; - FClientInitialized := True; - FPopupFeatures := popupFeatures; - TempRect := CEFWindowParent1.ClientRect; + Result := True; + FPopupFeatures := popupFeatures; + TempRect := CEFWindowParent1.ClientRect; if (FPopupFeatures.widthset <> 0) then TempRect.Right := max(FPopupFeatures.width, 100); if (FPopupFeatures.heightset <> 0) then TempRect.Bottom := max(FPopupFeatures.height, 100); @@ -140,6 +152,12 @@ begin Result := False; end; +function TChildForm.CreateBrowser(const aHomepage : string) : boolean; +begin + Chromium1.DefaultURL := aHomepage; + Result := Chromium1.CreateBrowser(CEFWindowParent1); +end; + procedure TChildForm.ApplyPopupFeatures; begin if (FPopupFeatures.xset <> 0) then Chromium1.SetFormLeftTo(FPopupFeatures.x); @@ -148,13 +166,18 @@ begin if (FPopupFeatures.heightset <> 0) then Chromium1.ResizeFormHeightTo(FPopupFeatures.height); 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; +procedure TChildForm.Chromium1BeforePopup( Sender : TObject; const browser : ICefBrowser; const frame : ICefFrame; const targetUrl : ustring; @@ -169,15 +192,18 @@ procedure TChildForm.Chromium1BeforePopup(Sender : TObject; var noJavascriptAccess : Boolean; var Result : Boolean); begin - case targetDisposition of - WOD_NEW_FOREGROUND_TAB, - WOD_NEW_BACKGROUND_TAB, - WOD_NEW_WINDOW : Result := True; // For simplicity, this demo blocks new tabs and new windows. + Result := not(TMainForm(Owner).DoOnBeforePopup(windowInfo, client, targetFrameName, popupFeatures, targetDisposition)); +end; - WOD_NEW_POPUP : Result := not(TMainForm(Owner).CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures)); - - else Result := False; - 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.Chromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction); @@ -188,7 +214,18 @@ end; procedure TChildForm.Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring); begin - Caption := title; + try + FCriticalSection.Acquire; + FTitle := title; + finally + FCriticalSection.Release; + PostMessage(Handle, CEF_UPDATECAPTION, 0, 0); + end; +end; + +function TChildForm.GetInitialized : boolean; +begin + Result := Chromium1.Initialized; end; procedure TChildForm.WMMove(var aMessage : TWMMove); @@ -226,26 +263,34 @@ end; procedure TChildForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin - CanClose := FCanClose; - - if not(FClosing) then + if FBrowserWasCreated then begin - FClosing := True; - Visible := False; - Chromium1.CloseBrowser(True); - end; + 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 + FCriticalSection := TCriticalSection.Create; + FBrowserWasCreated := False; FCanClose := False; FClosing := False; - FClientInitialized := False; end; procedure TChildForm.FormDestroy(Sender: TObject); begin - if FClientInitialized and TMainForm(Owner).HandleAllocated then + FCriticalSection.Free; + + if FBrowserWasCreated and TMainForm(Owner).HandleAllocated then PostMessage(TMainForm(Owner).Handle, CEF_CHILDDESTROYED, 0, 0); end; @@ -254,4 +299,14 @@ begin CEFWindowParent1.Free; end; +procedure TChildForm.BrowserUpdateCaptionMsg(var aMessage : TMessage); +begin + try + FCriticalSection.Acquire; + Caption := FTitle; + finally + FCriticalSection.Release; + end; +end; + end. diff --git a/demos/Delphi_VCL/TabbedBrowser2/uMainForm.dfm b/demos/Delphi_VCL/TabbedBrowser2/uMainForm.dfm index 562a5f2e..3e40b8e2 100644 --- a/demos/Delphi_VCL/TabbedBrowser2/uMainForm.dfm +++ b/demos/Delphi_VCL/TabbedBrowser2/uMainForm.dfm @@ -25,6 +25,7 @@ object MainForm: TMainForm Height = 703 Align = alClient TabOrder = 0 + TabWidth = 150 end object ButtonPnl: TPanel Left = 0 @@ -39,15 +40,11 @@ object MainForm: TMainForm Padding.Right = 3 Padding.Bottom = 3 TabOrder = 1 - DesignSize = ( - 32 - 703) object AddTabBtn: TSpeedButton Left = 3 Top = 3 Width = 26 Height = 26 - Align = alTop Caption = '+' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -56,14 +53,12 @@ object MainForm: TMainForm Font.Style = [] ParentFont = False OnClick = AddTabBtnClick - ExplicitWidth = 27 end object RemoveTabBtn: TSpeedButton Left = 3 Top = 32 Width = 26 Height = 26 - Anchors = [akLeft, akTop, akRight] Caption = #8722 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText diff --git a/demos/Delphi_VCL/TabbedBrowser2/uMainForm.pas b/demos/Delphi_VCL/TabbedBrowser2/uMainForm.pas index 61c0b502..90dc16d3 100644 --- a/demos/Delphi_VCL/TabbedBrowser2/uMainForm.pas +++ b/demos/Delphi_VCL/TabbedBrowser2/uMainForm.pas @@ -49,13 +49,14 @@ uses Windows, Messages, SysUtils, Variants, Classes, Graphics, SyncObjs, Controls, Forms, Dialogs, ComCtrls, ToolWin, Buttons, ExtCtrls, {$ENDIF} - uCEFApplication, uCEFInterfaces, uCEFTypes, uCEFConstants, uChildForm; + uCEFApplication, uCEFInterfaces, uCEFTypes, uCEFConstants, uChildForm, uBrowserTab; const - CEF_INITIALIZED = WM_APP + $A50; - CEF_DESTROYTAB = WM_APP + $A51; - CEF_CREATENEXTCHILD = WM_APP + $A52; - CEF_CHILDDESTROYED = WM_APP + $A53; + 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; HOMEPAGE_URL = 'https://www.google.com'; DEFAULT_TAB_CAPTION = 'New tab'; @@ -76,33 +77,41 @@ type procedure FormDestroy(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 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 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 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; end; var @@ -114,8 +123,6 @@ implementation {$R *.dfm} -uses - uBrowserTab; // This demo shows how to use a TPageControl with TFrames that include // CEF4Delphi browsers. @@ -146,6 +153,24 @@ uses // 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. + +// VCL components *MUST* be created and destroyed in the main thread but CEF +// executes the TChromium.OnBeforePopup in a different thread. + +// For this reason this demo creates a hidden popup form (TChildForm) and a +// hidden TBrowserTab in case CEF needs to show a popup window. + +// TChromium.OnBeforePopup calls TMainForm.DoOnBeforePopup to handle all the +// events in the same place. + +// TMainForm.DoOnBeforePopup will call CreateClientHandler to initialize some +// parameters and create the new ICefClient using the hidden form or tab. + +// After that, it sends a custom message to show the popup form or tab and create +// a new one. + // To close safely this demo you must close all the browser tabs first following // this steps : // @@ -167,7 +192,12 @@ procedure CreateGlobalCEFApp; begin GlobalCEFApp := TCefApplication.Create; GlobalCEFApp.cache := 'cache'; + GlobalCEFApp.EnablePrintPreview := True; GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized; + + // This is a workaround for the CEF4Delphi issue #324 : + // https://github.com/salvadordf/CEF4Delphi/issues/324 + GlobalCEFApp.DisableFeatures := 'WinUseBrowserSpellChecker'; end; procedure TMainForm.EnableButtonPnl; @@ -177,7 +207,7 @@ begin ButtonPnl.Enabled := True; Caption := 'Tabbed Browser 2'; cursor := crDefault; - if (BrowserPageCtrl.PageCount = 0) then AddTabBtn.Click; + if (BrowserTabCount = 0) then AddTabBtn.Click; end; end; @@ -197,12 +227,28 @@ begin while (i >= 0) do begin - TempForm := screen.CustomForms[i]; - // 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).ClientInitialized then + 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); @@ -224,9 +270,7 @@ end; procedure TMainForm.CEFInitializedMsg(var aMessage : TMessage); begin EnableButtonPnl; - - if (FChildForm = nil) then - TChildForm.Create(self); + CreateHiddenBrowsers; end; procedure TMainForm.DestroyTabMsg(var aMessage : TMessage); @@ -234,6 +278,8 @@ 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 @@ -248,7 +294,9 @@ begin inc(i); end; - if FClosing and (PopupChildCount = 0) and (BrowserPageCtrl.PageCount = 0) then + // 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); @@ -257,7 +305,10 @@ end; procedure TMainForm.ChildDestroyedMsg(var aMessage : TMessage); begin - if FClosing and (PopupChildCount = 0) and (BrowserPageCtrl.PageCount = 0) then + // 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); @@ -271,7 +322,12 @@ begin if (FChildForm <> nil) then begin - FChildForm.ApplyPopupFeatures; + if (aMessage.lParam <> 0) then + FChildForm.CreateBrowser(FPendingURL) + + else + FChildForm.ApplyPopupFeatures; + FChildForm.Show; end; @@ -281,6 +337,31 @@ begin 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); + + BrowserPageCtrl.ActivePageIndex := FHiddenTab.PageIndex; + 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; @@ -304,6 +385,7 @@ begin FClosing := False; FLastTabID := 0; FChildForm := nil; + FHiddenTab := nil; FCriticalSection := TCriticalSection.Create; end; @@ -317,14 +399,13 @@ begin if (GlobalCEFApp <> nil) and GlobalCEFApp.GlobalContextInitialized then begin EnableButtonPnl; - - if (FChildForm = nil) then - FChildForm := TChildForm.Create(self); + CreateHiddenBrowsers; end; end; procedure TMainForm.RemoveTabBtnClick(Sender: TObject); begin + // Call TBrowserTab.CloseBrowser in the active tab CloseTab(BrowserPageCtrl.ActivePageIndex); end; @@ -332,16 +413,16 @@ 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).ClientInitialized and + TChildForm(TempForm).Initialized and not(TChildForm(TempForm).Closing) then begin PostMessage(TempForm.Handle, WM_CLOSE, 0, 0); @@ -352,11 +433,16 @@ begin end; i := pred(BrowserPageCtrl.PageCount); - while (i >= 0) do begin - TBrowserTab(BrowserPageCtrl.Pages[i]).CloseBrowser; - Result := True; + TempTab := TBrowserTab(BrowserPageCtrl.Pages[i]); + + if TempTab.Initialized and not(TempTab.Closing) then + begin + TempTab.CloseBrowser; + Result := True; + end; + dec(i); end; end; @@ -367,6 +453,26 @@ begin 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; @@ -411,17 +517,70 @@ begin GlobalCEFApp.OsmodalLoop := False; end; -function TMainForm.CreateClientHandler(var windowInfo : TCefWindowInfo; - var client : ICefClient; - const targetFrameName : string; - const popupFeatures : TCefPopupFeatures) : boolean; +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; - Result := (FChildForm <> nil) and - FChildForm.CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures) and - PostMessage(Handle, CEF_CREATENEXTCHILD, 0, 0); + 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; diff --git a/demos/Lazarus_Windows/TabbedBrowser2/TabbedBrowser2.dproj b/demos/Lazarus_Windows/TabbedBrowser2/TabbedBrowser2.dproj deleted file mode 100644 index c6a0dab1..00000000 --- a/demos/Lazarus_Windows/TabbedBrowser2/TabbedBrowser2.dproj +++ /dev/null @@ -1,983 +0,0 @@ - - - {2A491C1D-D0F3-4D4B-9606-F7FC09C7713E} - 18.8 - VCL - TabbedBrowser2.dpr - True - Debug - Win32 - 1 - Application - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - .\$(Platform)\$(Config) - ..\..\..\bin - false - false - false - false - false - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - $(BDS)\bin\delphi_PROJECTICON.ico - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - TabbedBrowser2 - 3082 - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - - - DBXSqliteDriver;bindcompdbx;fmxase;DBXDb2Driver;DBXInterBaseDriver;vcl;DBXSybaseASEDriver;vclactnband;RESTComponents;vclFireDAC;IndyProtocols250;FireDACDb2Driver;IndyCore250;DataSnapFireDAC;svnui;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;DBXMSSQLDriver;vclimg;FireDACInfxDriver;DatasnapConnectorsFreePascal;FireDAC;FireDACMSSQLDriver;vcltouch;Componentes_UI;vcldb;bindcompfmx;svn;Detours;FireDACSqliteDriver;FireDACPgDriver;DBXOracleDriver;inetdb;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;SVGPackage;soaprtl;DbxCommonDriver;FireDACIBDriver;fmx;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;fmxdae;vclwinx;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;dbexpress;FireDACDBXDriver;vclx;bindcomp;appanalytics;dsnap;DataSnapCommon;DBXInformixDriver;FireDACCommon;bindcompvcl;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;vclie;CEF4Delphi_FMX;bindengine;DBXMySQLDriver;FireDACOracleDriver;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;DBXFirebirdDriver;DataSnapProviderClient;FireDACMongoDBDriver;FireDACCommonODBC;FireDACCommonDriver;CloudService;DataSnapClient;VisualStyles;IndySystem250;inet;DataSnapServerMidas;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - - - DBXSqliteDriver;bindcompdbx;fmxase;DBXDb2Driver;DBXInterBaseDriver;vcl;DBXSybaseASEDriver;vclactnband;RESTComponents;vclFireDAC;IndyProtocols250;FireDACDb2Driver;IndyCore250;DataSnapFireDAC;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;DBXMSSQLDriver;vclimg;FireDACInfxDriver;DatasnapConnectorsFreePascal;FireDAC;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;DBXOracleDriver;inetdb;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;soaprtl;DbxCommonDriver;FireDACIBDriver;fmx;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;fmxdae;vclwinx;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;dbexpress;FireDACDBXDriver;vclx;bindcomp;appanalytics;dsnap;DataSnapCommon;DBXInformixDriver;FireDACCommon;bindcompvcl;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;vclie;CEF4Delphi_FMX;bindengine;DBXMySQLDriver;FireDACOracleDriver;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;DBXFirebirdDriver;DataSnapProviderClient;FireDACMongoDBDriver;FireDACCommonODBC;FireDACCommonDriver;CloudService;DataSnapClient;IndySystem250;inet;DataSnapServerMidas;$(DCC_UsePackage) - - - DEBUG;$(DCC_Define) - true - false - true - true - true - - - false - true - PerMonitorV2 - true - 1033 - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - true - PerMonitorV2 - - - - MainSource - - -
MainForm
- - -
BrowserFrame
- TFrame - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - Delphi.Personality.12 - Application - - - - TabbedBrowser2.dpr - - - IP Abstraction Indy Implementation Design Time - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - - - - - - TabbedBrowser2.exe - true - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - classes - 1 - - - classes - 1 - - - - - res\xml - 1 - - - res\xml - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\armeabi - 1 - - - library\lib\armeabi - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\mips - 1 - - - library\lib\mips - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\values-v21 - 1 - - - res\values-v21 - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-ldpi - 1 - - - res\drawable-ldpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-xxxhdpi - 1 - - - res\drawable-xxxhdpi - 1 - - - - - res\drawable-small - 1 - - - res\drawable-small - 1 - - - - - res\drawable-normal - 1 - - - res\drawable-normal - 1 - - - - - res\drawable-large - 1 - - - res\drawable-large - 1 - - - - - res\drawable-xlarge - 1 - - - res\drawable-xlarge - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - Contents\MacOS - 1 - .framework - - - Contents\MacOS - 1 - .framework - - - 0 - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .bpl - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - Contents\Resources\StartUp\ - 0 - - - Contents\Resources\StartUp\ - 0 - - - 0 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - - - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - Contents - 1 - - - Contents - 1 - - - - - Contents\Resources - 1 - - - Contents\Resources - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - 1 - - - 1 - - - 1 - - - 1 - - - Contents\MacOS - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - - - - - - - - - - - True - False - - - 12 - - - - - diff --git a/demos/Lazarus_Windows/TabbedBrowser2/TabbedBrowser2.lpi b/demos/Lazarus_Windows/TabbedBrowser2/TabbedBrowser2.lpi index e4f2fe9d..a898545a 100644 --- a/demos/Lazarus_Windows/TabbedBrowser2/TabbedBrowser2.lpi +++ b/demos/Lazarus_Windows/TabbedBrowser2/TabbedBrowser2.lpi @@ -35,7 +35,7 @@ - + @@ -50,14 +50,17 @@ - - + + + + + diff --git a/demos/Lazarus_Windows/TabbedBrowser2/TabbedBrowser2.lpr b/demos/Lazarus_Windows/TabbedBrowser2/TabbedBrowser2.lpr index 94758ad2..b76acb26 100644 --- a/demos/Lazarus_Windows/TabbedBrowser2/TabbedBrowser2.lpr +++ b/demos/Lazarus_Windows/TabbedBrowser2/TabbedBrowser2.lpr @@ -42,18 +42,26 @@ program TabbedBrowser2; {$I cef.inc} uses + {$IFDEF DELPHI16_UP} + Vcl.Forms, + WinApi.Windows, + {$ELSE} Forms, LCLIntf, LCLType, LMessages, Interfaces, + {$ENDIF } uCEFApplication, uMainForm in 'uMainForm.pas' {MainForm}, uBrowserFrame in 'uBrowserFrame.pas' {BrowserFrame: TFrame}, - uBrowserTab in 'uBrowserTab.pas'; + uBrowserTab in 'uBrowserTab.pas', + uChildForm in 'uChildForm.pas' {ChildForm}; {.$R *.res} -// 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 $20} +{$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; @@ -61,6 +69,9 @@ begin if GlobalCEFApp.StartMainProcess then begin Application.Initialize; + {$IFDEF DELPHI11_UP} + Application.MainFormOnTaskbar := True; + {$ENDIF} Application.CreateForm(TMainForm, MainForm); Application.Run; end; diff --git a/demos/Lazarus_Windows/TabbedBrowser2/uBrowserFrame.lfm b/demos/Lazarus_Windows/TabbedBrowser2/uBrowserFrame.lfm index d447cc8c..ccf7dd8b 100644 --- a/demos/Lazarus_Windows/TabbedBrowser2/uBrowserFrame.lfm +++ b/demos/Lazarus_Windows/TabbedBrowser2/uBrowserFrame.lfm @@ -1,116 +1,115 @@ object BrowserFrame: TBrowserFrame Left = 0 - Height = 670 Top = 0 Width = 932 - ClientHeight = 670 - ClientWidth = 932 + Height = 670 TabOrder = 0 - DesignLeft = 269 - DesignTop = 169 object NavControlPnl: TPanel Left = 0 - Height = 28 Top = 0 Width = 932 + Height = 35 Align = alTop BevelOuter = bvNone - ClientHeight = 28 - ClientWidth = 932 Enabled = False TabOrder = 0 object NavButtonPnl: TPanel Left = 0 - Height = 28 Top = 0 Width = 123 + Height = 35 Align = alLeft BevelOuter = bvNone - ClientHeight = 28 - ClientWidth = 123 TabOrder = 0 object BackBtn: TButton - Left = 0 - Height = 25 - Top = 0 + Left = 3 + Top = 3 Width = 25 + Height = 25 Caption = '3' - Font.CharSet = SYMBOL_CHARSET + Font.Charset = SYMBOL_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Webdings' - OnClick = BackBtnClick + Font.Style = [] ParentFont = False TabOrder = 0 + OnClick = BackBtnClick end object ForwardBtn: TButton - Left = 30 - Height = 25 - Top = 0 + Left = 33 + Top = 3 Width = 25 + Height = 25 Caption = '4' - Font.CharSet = SYMBOL_CHARSET + Font.Charset = SYMBOL_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Webdings' - OnClick = ForwardBtnClick + Font.Style = [] ParentFont = False TabOrder = 1 + OnClick = ForwardBtnClick end object ReloadBtn: TButton - Left = 59 - Height = 25 - Top = 0 + Left = 62 + Top = 3 Width = 25 + Height = 25 Caption = 'q' - Font.CharSet = SYMBOL_CHARSET + Font.Charset = SYMBOL_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Webdings' - OnClick = ReloadBtnClick + Font.Style = [] ParentFont = False TabOrder = 2 + OnClick = ReloadBtnClick end object StopBtn: TButton - Left = 88 - Height = 25 - Top = 0 + Left = 91 + Top = 3 Width = 25 + Height = 25 Caption = '=' - Font.CharSet = SYMBOL_CHARSET + Font.Charset = SYMBOL_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Webdings' - OnClick = StopBtnClick + Font.Style = [] ParentFont = False TabOrder = 3 + OnClick = StopBtnClick end end object URLEditPnl: TPanel - Left = 123 - Height = 28 + Left = 121 Top = 0 Width = 774 + Height = 35 Align = alClient BevelOuter = bvNone - ClientHeight = 28 - ClientWidth = 774 TabOrder = 1 object URLCbx: TComboBox Left = 0 - Height = 23 - Top = 1 - Width = 774 - Anchors = [akTop, akLeft, akRight] - ItemHeight = 15 + Top = 5 + Width = 770 + Height = 21 + 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-browser-sending' + + '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_style_backgroundcolor' + + '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/' @@ -118,7 +117,9 @@ object BrowserFrame: TBrowserFrame 'https://www.ultrasounds.com/' 'https://www.whatismybrowser.com/detect/is-flash-installed' 'http://html5test.com/' - 'https://webrtc.github.io/samples/src/content/devices/input-output/' + + 'https://webrtc.github.io/samples/src/content/devices/input-outpu' + + 't/' 'https://test.webrtc.org/' 'https://www.w3schools.com/' 'http://webglsamples.org/' @@ -126,9 +127,15 @@ object BrowserFrame: TBrowserFrame 'https://www.briskbard.com' 'https://www.youtube.com' 'https://html5demos.com/drag/' - 'https://developers.google.com/maps/documentation/javascript/examples/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://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/' @@ -148,45 +155,40 @@ object BrowserFrame: TBrowserFrame 'chrome://gpucrash' 'chrome://gpuhang' 'chrome://extensions-support' - 'chrome://process-internals' - ) - TabOrder = 0 - Text = 'https://www.google.com' + 'chrome://process-internals') end end object ConfigPnl: TPanel - Left = 897 - Height = 28 + Left = 895 Top = 0 Width = 35 + Height = 35 Align = alRight BevelOuter = bvNone - ClientHeight = 28 - ClientWidth = 35 TabOrder = 2 object GoBtn: TButton - Left = 5 - Height = 25 - Top = 0 + Left = 3 + Top = 3 Width = 25 + Height = 25 Caption = '►' - Font.CharSet = ANSI_CHARSET + Font.Charset = ANSI_CHARSET Font.Color = clWindowText Font.Height = -17 Font.Name = 'Arial' Font.Style = [fsBold] - OnClick = GoBtnClick ParentFont = False TabOrder = 0 + OnClick = GoBtnClick end end end object StatusBar1: TStatusBar Left = 0 - Height = 23 - Top = 647 + Top = 651 Width = 932 - Panels = < + Height = 19 + Panels = < item Width = 500 end> @@ -194,9 +196,9 @@ object BrowserFrame: TBrowserFrame end object CEFWindowParent1: TCEFWindowParent Left = 0 - Height = 619 - Top = 28 + Top = 35 Width = 932 + Height = 616 Align = alClient TabOrder = 2 end @@ -211,7 +213,7 @@ object BrowserFrame: TBrowserFrame OnBeforeClose = Chromium1BeforeClose OnClose = Chromium1Close OnOpenUrlFromTab = Chromium1OpenUrlFromTab - left = 40 - top = 72 + Left = 40 + Top = 72 end end diff --git a/demos/Lazarus_Windows/TabbedBrowser2/uBrowserFrame.pas b/demos/Lazarus_Windows/TabbedBrowser2/uBrowserFrame.pas index fae3239d..924b0ea6 100644 --- a/demos/Lazarus_Windows/TabbedBrowser2/uBrowserFrame.pas +++ b/demos/Lazarus_Windows/TabbedBrowser2/uBrowserFrame.pas @@ -44,12 +44,25 @@ unit uBrowserFrame; 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} LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, - ExtCtrls, ComCtrls, StdCtrls, + ExtCtrls, ComCtrls, StdCtrls, SyncObjs, + {$ENDIF} uCEFWinControl, uCEFWindowParent, uCEFChromiumCore, uCEFChromium, uCEFInterfaces, uCEFTypes, uCEFConstants; +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; @@ -86,20 +99,59 @@ type procedure GoBtnClick(Sender: TObject); protected + FCriticalSection : TCriticalSection; FClosing : boolean; // Indicates that this frame is destroying the browser FHomepage : string; + FPendingAddress : string; + FPendingTitle : string; + FPendingStatus : string; + FPendingIsLoading : boolean; + FPendingCanGoBack : boolean; + FPendingCanGoForward : boolean; FOnBrowserDestroyed : TNotifyEvent; FOnBrowserTitleChange : TBrowserTitleEvent; + function GetInitialized : boolean; + function GetPendingAddress : string; + function GetPendingTitle : string; + function GetPendingStatus : string; + function GetPendingIsLoading : boolean; + function GetPendingCanGoBack : boolean; + function GetPendingCanGoForward : boolean; + + procedure SetPendingAddress(const aValue : string); + procedure SetPendingTitle(const aValue : string); + procedure SetPendingStatus(const aValue : string); + procedure SetPendingIsLoading(aValue : boolean); + procedure SetPendingCanGoBack(aValue : boolean); + procedure SetPendingCanGoForward(aValue : boolean); + procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED; procedure BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY; + procedure BrowserUpdateCaptionMsg(var aMessage : TMessage); message CEF_UPDATECAPTION; + procedure BrowserUpdateAddressMsg(var aMessage : TMessage); message CEF_UPDATEADDRESS; + procedure BrowserUpdateStateMsg(var aMessage : TMessage); message CEF_UPDATESTATE; + procedure BrowserUpdateStatusTextMsg(var aMessage : TMessage); message CEF_UPDATESTATUSTEXT; + + property PendingAddress : string read GetPendingAddress write SetPendingAddress; + property PendingTitle : string read GetPendingTitle write SetPendingTitle; + property PendingStatus : string read GetPendingStatus write SetPendingStatus; + property PendingIsLoading : boolean read GetPendingIsLoading write SetPendingIsLoading; + property PendingCanGoBack : boolean read GetPendingCanGoBack write SetPendingCanGoBack; + property PendingCanGoForward : boolean read GetPendingCanGoForward write SetPendingCanGoForward; public constructor Create(AOwner : TComponent); override; + destructor Destroy; override; procedure NotifyMoveOrResizeStarted; + procedure CreateAllHandles; procedure CreateBrowser; procedure CloseBrowser; + procedure ShowBrowser; + procedure HideBrowser; + function CreateClientHandler(var windowInfo : TCefWindowInfo; var client : ICefClient; const targetFrameName : string; const popupFeatures : TCefPopupFeatures) : boolean; + property Initialized : boolean read GetInitialized; property Closing : boolean read FClosing; property Homepage : string read FHomepage write FHomepage; property OnBrowserDestroyed : TNotifyEvent read FOnBrowserDestroyed write FOnBrowserDestroyed; @@ -110,16 +162,138 @@ implementation {$R *.lfm} +uses + uCEFMiscFunctions, 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 sets CanClose to FALSE calls TChromium.CloseBrowser +// which triggers the TChromium.OnClose event. +// 2. TChromium.OnClose sends a CEFBROWSER_DESTROY message to destroy CEFWindowParent1 +// in the main thread, which triggers the TChromium.OnBeforeClose event. +// 3. TChromium.OnBeforeClose triggers the TBrowserFrame.OnBrowserDestroyed event +// which sends a CEF_DESTROYTAB message with the TabID to the main form. + constructor TBrowserFrame.Create(AOwner : TComponent); begin inherited Create(AOwner); + FCriticalSection := TCriticalSection.Create; FClosing := False; FHomepage := ''; FOnBrowserDestroyed := nil; FOnBrowserTitleChange := nil; end; +destructor TBrowserFrame.Destroy; +begin + FreeAndNil(FCriticalSection); + + inherited Destroy; +end; + +procedure TBrowserFrame.CreateAllHandles; +begin + CreateHandle; + + CEFWindowParent1.CreateHandle; +end; + +function TBrowserFrame.GetInitialized : boolean; +begin + Result := Chromium1.Initialized; +end; + +function TBrowserFrame.GetPendingAddress : string; +begin + FCriticalSection.Acquire; + Result := FPendingAddress; + FCriticalSection.Release; +end; + +function TBrowserFrame.GetPendingTitle : string; +begin + FCriticalSection.Acquire; + Result := FPendingTitle; + FCriticalSection.Release; +end; + +function TBrowserFrame.GetPendingStatus : string; +begin + FCriticalSection.Acquire; + Result := FPendingStatus; + FCriticalSection.Release; +end; + +function TBrowserFrame.GetPendingIsLoading : boolean; +begin + FCriticalSection.Acquire; + Result := FPendingIsLoading; + FCriticalSection.Release; +end; + +function TBrowserFrame.GetPendingCanGoBack : boolean; +begin + FCriticalSection.Acquire; + Result := FPendingCanGoBack; + FCriticalSection.Release; +end; + +function TBrowserFrame.GetPendingCanGoForward : boolean; +begin + FCriticalSection.Acquire; + Result := FPendingCanGoForward; + FCriticalSection.Release; +end; + +procedure TBrowserFrame.SetPendingAddress(const aValue : string); +begin + FCriticalSection.Acquire; + FPendingAddress := aValue; + FCriticalSection.Release; +end; + +procedure TBrowserFrame.SetPendingTitle(const aValue : string); +begin + FCriticalSection.Acquire; + FPendingTitle := aValue; + FCriticalSection.Release; +end; + +procedure TBrowserFrame.SetPendingStatus(const aValue : string); +begin + FCriticalSection.Acquire; + FPendingStatus := aValue; + FCriticalSection.Release; +end; + +procedure TBrowserFrame.SetPendingIsLoading(aValue : boolean); +begin + FCriticalSection.Acquire; + FPendingIsLoading := aValue; + FCriticalSection.Release; +end; + +procedure TBrowserFrame.SetPendingCanGoBack(aValue : boolean); +begin + FCriticalSection.Acquire; + FPendingCanGoBack := aValue; + FCriticalSection.Release; +end; + +procedure TBrowserFrame.SetPendingCanGoForward(aValue : boolean); +begin + FCriticalSection.Acquire; + FPendingCanGoForward := aValue; + FCriticalSection.Release; +end; + procedure TBrowserFrame.NotifyMoveOrResizeStarted; begin Chromium1.NotifyMoveOrResizeStarted; @@ -151,6 +325,20 @@ begin end; end; +procedure TBrowserFrame.ShowBrowser; +begin + Chromium1.WasHidden(False); + Chromium1.SendFocusEvent(True); + Chromium1.AudioMuted := False; +end; + +procedure TBrowserFrame.HideBrowser; +begin + Chromium1.SendFocusEvent(False); + Chromium1.WasHidden(True); + Chromium1.AudioMuted := True; +end; + procedure TBrowserFrame.ForwardBtnClick(Sender: TObject); begin Chromium1.GoForward; @@ -161,8 +349,7 @@ begin Chromium1.LoadURL(URLCbx.Text); end; -procedure TBrowserFrame.Chromium1AfterCreated(Sender: TObject; - const browser: ICefBrowser); +procedure TBrowserFrame.Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser); begin PostMessage(Handle, CEF_AFTERCREATED, 0, 0); end; @@ -172,42 +359,67 @@ begin Chromium1.GoBack; end; -procedure TBrowserFrame.Chromium1AddressChange(Sender: TObject; - const browser: ICefBrowser; const frame: ICefFrame; const url: ustring); +procedure TBrowserFrame.Chromium1AddressChange( 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; + PendingAddress := url; + PostMessage(Handle, CEF_UPDATEADDRESS, 0, 0); end; -procedure TBrowserFrame.Chromium1BeforeClose(Sender: TObject; - const browser: ICefBrowser); +procedure TBrowserFrame.Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser); begin if assigned(FOnBrowserDestroyed) then FOnBrowserDestroyed(self); end; -procedure TBrowserFrame.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 TBrowserFrame.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 - // 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]); + Result := not(assigned(Parent) and + (Parent is TBrowserTab) and + TBrowserTab(Parent).DoOnBeforePopup(windowInfo, client, targetFrameName, popupFeatures, targetDisposition)); end; -procedure TBrowserFrame.Chromium1Close(Sender: TObject; - const browser: ICefBrowser; var aAction: TCefCloseBrowserAction); +procedure TBrowserFrame.Chromium1OpenUrlFromTab( 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.Chromium1Close( Sender : TObject; + const browser : ICefBrowser; + var aAction : TCefCloseBrowserAction); begin PostMessage(Handle, CEF_DESTROY, 0, 0); aAction := cbaDelay; end; -procedure TBrowserFrame.Chromium1LoadError(Sender: TObject; - const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; - const errorText, failedUrl: ustring); +procedure TBrowserFrame.Chromium1LoadError( Sender : TObject; + const browser : ICefBrowser; + const frame : ICefFrame; + errorCode : Integer; + const errorText : ustring; + const failedUrl : ustring); var TempString : string; begin @@ -221,48 +433,38 @@ begin Chromium1.LoadString(TempString, frame); end; -procedure TBrowserFrame.Chromium1LoadingStateChange(Sender: TObject; - const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean); +procedure TBrowserFrame.Chromium1LoadingStateChange( Sender : TObject; + const browser : ICefBrowser; + isLoading : Boolean; + canGoBack : Boolean; + canGoForward : Boolean); begin - BackBtn.Enabled := canGoBack; - ForwardBtn.Enabled := canGoForward; + PendingIsLoading := isLoading; + PendingCanGoBack := canGoBack; + PendingCanGoForward := canGoForward; - if isLoading then - begin - ReloadBtn.Enabled := False; - StopBtn.Enabled := True; - end - else - begin - ReloadBtn.Enabled := True; - StopBtn.Enabled := False; - end; + PostMessage(Handle, CEF_UPDATESTATE, 0, 0); end; -procedure TBrowserFrame.Chromium1OpenUrlFromTab(Sender: TObject; - const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; - targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; - out Result: Boolean); +procedure TBrowserFrame.Chromium1StatusMessage( Sender : TObject; + const browser : ICefBrowser; + const value : ustring); 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]); + PendingStatus := value; + + PostMessage(Handle, CEF_UPDATESTATUSTEXT, 0, 0); end; -procedure TBrowserFrame.Chromium1StatusMessage(Sender: TObject; - const browser: ICefBrowser; const value: ustring); +procedure TBrowserFrame.Chromium1TitleChange( Sender : TObject; + const browser : ICefBrowser; + const title : ustring); begin - StatusBar1.Panels[0].Text := value; -end; - -procedure TBrowserFrame.Chromium1TitleChange(Sender: TObject; - const browser: ICefBrowser; const title: ustring); -begin - if not(assigned(FOnBrowserTitleChange)) then exit; - if (length(title) > 0) then - FOnBrowserTitleChange(self, title) + PendingTitle := title else - FOnBrowserTitleChange(self, Chromium1.DocumentURL); + PendingTitle := Chromium1.DocumentURL; + + PostMessage(Handle, CEF_UPDATECAPTION, 0, 0); end; procedure TBrowserFrame.BrowserCreatedMsg(var aMessage : TMessage); @@ -276,6 +478,65 @@ begin CEFWindowParent1.Free; end; +procedure TBrowserFrame.BrowserUpdateCaptionMsg(var aMessage : TMessage); +begin + if assigned(FOnBrowserTitleChange) then + FOnBrowserTitleChange(self, PendingTitle); +end; + +procedure TBrowserFrame.BrowserUpdateAddressMsg(var aMessage : TMessage); +var + TempAddress : string; +begin + TempAddress := PendingAddress; + + if (URLCbx.Items.IndexOf(TempAddress) < 0) then + URLCbx.Items.Add(TempAddress); + + URLCbx.Text := TempAddress; +end; + +procedure TBrowserFrame.BrowserUpdateStateMsg(var aMessage : TMessage); +begin + BackBtn.Enabled := PendingCanGoBack; + ForwardBtn.Enabled := PendingCanGoForward; + + if PendingIsLoading then + begin + ReloadBtn.Enabled := False; + StopBtn.Enabled := True; + end + else + begin + ReloadBtn.Enabled := True; + StopBtn.Enabled := False; + end; +end; + +procedure TBrowserFrame.BrowserUpdateStatusTextMsg(var aMessage : TMessage); +begin + StatusBar1.Panels[0].Text := PendingStatus; +end; + +function TBrowserFrame.CreateClientHandler(var windowInfo : TCefWindowInfo; + var client : ICefClient; + const targetFrameName : string; + const popupFeatures : TCefPopupFeatures) : boolean; +var + TempRect : TRect; +begin + if CEFWindowParent1.HandleAllocated and + Chromium1.CreateClientHandler(client, False) then + begin + Result := True; + TempRect := CEFWindowParent1.ClientRect; + + WindowInfoAsChild(windowInfo, CEFWindowParent1.Handle, TempRect, ''); + end + else + Result := False; +end; + end. diff --git a/demos/Lazarus_Windows/TabbedBrowser2/uBrowserTab.pas b/demos/Lazarus_Windows/TabbedBrowser2/uBrowserTab.pas index 26fe879e..8f2f927e 100644 --- a/demos/Lazarus_Windows/TabbedBrowser2/uBrowserTab.pas +++ b/demos/Lazarus_Windows/TabbedBrowser2/uBrowserTab.pas @@ -1,4 +1,4 @@ -// ************************************************************************ +// ************************************************************************ // ***************************** CEF4Delphi ******************************* // ************************************************************************ // @@ -44,9 +44,14 @@ unit uBrowserTab; interface uses + {$IFDEF DELPHI16_UP} + Winapi.Windows, System.Classes, Winapi.Messages, Vcl.ComCtrls, Vcl.Controls, + Vcl.Forms, System.SysUtils, + {$ELSE} LCLIntf, LCLType, LMessages, Classes, Messages, ComCtrls, Controls, - Forms, - uBrowserFrame; + Forms, SysUtils, + {$ENDIF} + uCEFInterfaces, uCEFTypes, uBrowserFrame; type TBrowserTab = class(TTabSheet) @@ -55,6 +60,8 @@ type FTabID : cardinal; function GetParentForm : TCustomForm; + function GetInitialized : boolean; + function GetClosing : boolean; function PostFormMessage(aMsg : cardinal; aWParam : WPARAM = 0; aLParam : LPARAM = 0) : boolean; @@ -66,10 +73,18 @@ type 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; + 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 TabID : cardinal read FTabID; + property Closing : boolean read GetClosing; + property Initialized : boolean read GetInitialized; end; implementation @@ -101,6 +116,18 @@ begin 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; @@ -116,17 +143,28 @@ 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.OnBrowserDestroyed := BrowserFrame_OnBrowserDestroyed; + FBrowserFrame.OnBrowserTitleChange := BrowserFrame_OnBrowserTitleChange; + FBrowserFrame.CreateAllHandles; + end; + + FBrowserFrame.Homepage := aHomepage; +end; + procedure TBrowserTab.CreateBrowser(const aHomepage : string); begin - FBrowserFrame := TBrowserFrame.Create(self); - FBrowserFrame.Parent := self; - FBrowserFrame.Align := alClient; - FBrowserFrame.Visible := True; - FBrowserFrame.Homepage := aHomepage; - FBrowserFrame.OnBrowserDestroyed := BrowserFrame_OnBrowserDestroyed; - FBrowserFrame.OnBrowserTitleChange := BrowserFrame_OnBrowserTitleChange; + CreateFrame(aHomepage); - FBrowserFrame.CreateBrowser; + if (FBrowserFrame <> nil) then FBrowserFrame.CreateBrowser; end; procedure TBrowserTab.CloseBrowser; @@ -134,8 +172,18 @@ 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.BrowserFrame_OnBrowserDestroyed(Sender: TObject); -begin +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); @@ -146,4 +194,38 @@ begin Caption := aTitle; end; +function TBrowserTab.CreateClientHandler(var windowInfo : TCefWindowInfo; + var client : ICefClient; + const targetFrameName : string; + const popupFeatures : TCefPopupFeatures) : boolean; +begin + Result := (FBrowserFrame <> nil) and + FBrowserFrame.CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures); +end; + +function TBrowserTab.DoOnBeforePopup(var windowInfo : TCefWindowInfo; + var client : ICefClient; + const targetFrameName : string; + const popupFeatures : TCefPopupFeatures; + targetDisposition : TCefWindowOpenDisposition) : boolean; +var + TempForm : TCustomForm; +begin + TempForm := ParentForm; + Result := (TempForm <> nil) and + (TempForm is TMainForm) and + TMainForm(TempForm).DoOnBeforePopup(windowInfo, client, targetFrameName, popupFeatures, targetDisposition); +end; + +function TBrowserTab.DoOpenUrlFromTab(const targetUrl : string; + targetDisposition : TCefWindowOpenDisposition) : boolean; +var + TempForm : TCustomForm; +begin + TempForm := ParentForm; + Result := (TempForm <> nil) and + (TempForm is TMainForm) and + TMainForm(TempForm).DoOpenUrlFromTab(targetUrl, targetDisposition); +end; + end. diff --git a/demos/Lazarus_Windows/TabbedBrowser2/uChildForm.lfm b/demos/Lazarus_Windows/TabbedBrowser2/uChildForm.lfm new file mode 100644 index 00000000..26411739 --- /dev/null +++ b/demos/Lazarus_Windows/TabbedBrowser2/uChildForm.lfm @@ -0,0 +1,37 @@ +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 + OnClose = FormClose + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + object CEFWindowParent1: TCEFWindowParent + Left = 0 + Top = 0 + Width = 352 + Height = 256 + Align = alClient + TabOrder = 0 + end + object Chromium1: TChromium + OnTitleChange = Chromium1TitleChange + OnBeforePopup = Chromium1BeforePopup + OnAfterCreated = Chromium1AfterCreated + OnBeforeClose = Chromium1BeforeClose + OnClose = Chromium1Close + OnOpenUrlFromTab = Chromium1OpenUrlFromTab + Left = 24 + Top = 56 + end +end diff --git a/demos/Lazarus_Windows/TabbedBrowser2/uChildForm.pas b/demos/Lazarus_Windows/TabbedBrowser2/uChildForm.pas new file mode 100644 index 00000000..7f5bdf39 --- /dev/null +++ b/demos/Lazarus_Windows/TabbedBrowser2/uChildForm.pas @@ -0,0 +1,314 @@ +// ************************************************************************ +// ***************************** 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 © 2021 Salvador Diaz Fau. All rights reserved. +// +// ************************************************************************ +// ************ vvvv Original license and comments below vvvv ************* +// ************************************************************************ +(* + * Delphi Chromium Embedded 3 + * + * Usage allowed under the restrictions of the Lesser GNU General Public License + * or alternatively the restrictions of the Mozilla Public License 1.1 + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for + * the specific language governing rights and limitations under the License. + * + * Unit owner : Henri Gourvest + * Web site : http://www.progdigy.com + * Repository : http://code.google.com/p/delphichromiumembedded/ + * Group : http://groups.google.com/group/delphichromiumembedded + * + * Embarcadero Technologies, Inc is not permitted to use or redistribute + * this source code without explicit permission. + * + *) + +unit uChildForm; + +{$MODE Delphi} + +{$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, + {$ELSE} + LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, SyncObjs, + Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, + {$ENDIF} + uCEFChromium, uCEFTypes, uCEFInterfaces, uCEFConstants, uCEFWindowParent, uCEFWinControl, + uCEFChromiumCore; + +const + CEF_UPDATECAPTION = WM_APP + $A55; + +type + TChildForm = class(TForm) + Chromium1: TChromium; + CEFWindowParent1: TCEFWindowParent; + + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + + procedure Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser); + procedure Chromium1BeforePopup(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl, targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; const popupFeatures: TCefPopupFeatures; var windowInfo: TCefWindowInfo; var client: ICefClient; var settings: TCefBrowserSettings; var extra_info: ICefDictionaryValue; var noJavascriptAccess: Boolean; var Result: Boolean); + procedure Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring); + procedure Chromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction); + 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); + + protected + FCriticalSection : TCriticalSection; + FCanClose : boolean; + FClosing : boolean; + FBrowserWasCreated : boolean; + FTitle : string; + FPopupFeatures : TCefPopupFeatures; + + function GetInitialized : boolean; + + 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 BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY; + procedure BrowserUpdateCaptionMsg(var aMessage : TMessage); message CEF_UPDATECAPTION; + + public + procedure AfterConstruction; override; + function CreateBrowser(const aHomepage : string) : boolean; + function CreateClientHandler(var windowInfo : TCefWindowInfo; var client : ICefClient; const targetFrameName : string; const popupFeatures : TCefPopupFeatures) : boolean; + procedure ApplyPopupFeatures; + + property Initialized : boolean read GetInitialized; + property Closing : boolean read FClosing; + end; + +implementation + +{$R *.lfm} + +uses + {$IFDEF DELPHI16_UP} + System.Math, + {$ELSE} + Math, + {$ENDIF} + uCEFMiscFunctions, uCEFApplication, uMainForm; + +// Destruction steps +// ================= +// 1. FormCloseQuery sets CanClose to FALSE calls TChromium.CloseBrowser which +// triggers the TChromium.OnClose event. +// 2. TChromium.OnClose sends a CEFBROWSER_DESTROY message to destroy CEFWindowParent1 +// in the main thread, which triggers the TChromium.OnBeforeClose event. +// 3. TChromium.OnBeforeClose sets FCanClose := True and sends WM_CLOSE to the form. + +procedure TChildForm.AfterConstruction; +begin + inherited AfterConstruction; + + CreateHandle; + + CEFWindowParent1.CreateHandle; +end; + +function TChildForm.CreateClientHandler(var windowInfo : TCefWindowInfo; + var client : ICefClient; + const targetFrameName : string; + const popupFeatures : TCefPopupFeatures) : boolean; +var + TempRect : TRect; +begin + if CEFWindowParent1.HandleAllocated and + Chromium1.CreateClientHandler(client, False) then + begin + Result := True; + FPopupFeatures := popupFeatures; + TempRect := CEFWindowParent1.ClientRect; + + if (FPopupFeatures.widthset <> 0) then TempRect.Right := max(FPopupFeatures.width, 100); + if (FPopupFeatures.heightset <> 0) then TempRect.Bottom := max(FPopupFeatures.height, 100); + + WindowInfoAsChild(windowInfo, CEFWindowParent1.Handle, TempRect, ''); + end + else + Result := False; +end; + +function TChildForm.CreateBrowser(const aHomepage : string) : boolean; +begin + Chromium1.DefaultURL := aHomepage; + Result := Chromium1.CreateBrowser(CEFWindowParent1); +end; + +procedure TChildForm.ApplyPopupFeatures; +begin + if (FPopupFeatures.xset <> 0) then Chromium1.SetFormLeftTo(FPopupFeatures.x); + if (FPopupFeatures.yset <> 0) then Chromium1.SetFormTopTo(FPopupFeatures.y); + if (FPopupFeatures.widthset <> 0) then Chromium1.ResizeFormWidthTo(FPopupFeatures.width); + if (FPopupFeatures.heightset <> 0) then Chromium1.ResizeFormHeightTo(FPopupFeatures.height); +end; + +procedure TChildForm.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.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.Chromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction); +begin + PostMessage(Handle, CEF_DESTROY, 0, 0); + aAction := cbaDelay; +end; + +procedure TChildForm.Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring); +begin + try + FCriticalSection.Acquire; + FTitle := title; + finally + FCriticalSection.Release; + PostMessage(Handle, CEF_UPDATECAPTION, 0, 0); + end; +end; + +function TChildForm.GetInitialized : boolean; +begin + Result := Chromium1.Initialized; +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.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.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 + FCriticalSection := TCriticalSection.Create; + FBrowserWasCreated := False; + FCanClose := False; + FClosing := False; +end; + +procedure TChildForm.FormDestroy(Sender: TObject); +begin + FCriticalSection.Free; + + if FBrowserWasCreated and TMainForm(Owner).HandleAllocated then + PostMessage(TMainForm(Owner).Handle, CEF_CHILDDESTROYED, 0, 0); +end; + +procedure TChildForm.BrowserDestroyMsg(var aMessage : TMessage); +begin + CEFWindowParent1.Free; +end; + +procedure TChildForm.BrowserUpdateCaptionMsg(var aMessage : TMessage); +begin + try + FCriticalSection.Acquire; + Caption := FTitle; + finally + FCriticalSection.Release; + end; +end; + +end. diff --git a/demos/Lazarus_Windows/TabbedBrowser2/uMainForm.lfm b/demos/Lazarus_Windows/TabbedBrowser2/uMainForm.lfm index 60b0ca46..33bc8894 100644 --- a/demos/Lazarus_Windows/TabbedBrowser2/uMainForm.lfm +++ b/demos/Lazarus_Windows/TabbedBrowser2/uMainForm.lfm @@ -1,62 +1,66 @@ object MainForm: TMainForm - Left = 357 - Height = 704 - Top = 89 - Width = 991 + Left = 0 + Top = 0 Caption = 'Initializing. Please, wait...' - ClientHeight = 704 + 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 - Position = poScreenCenter - LCLVersion = '2.0.6.0' + PixelsPerInch = 96 object BrowserPageCtrl: TPageControl - Left = 34 - Height = 704 + Left = 32 Top = 0 - Width = 957 + Width = 959 + Height = 703 Align = alClient TabOrder = 0 + TabWidth = 150 end object ButtonPnl: TPanel Left = 0 - Height = 704 Top = 0 - Width = 34 + Width = 32 + Height = 703 Align = alLeft BevelOuter = bvNone - ClientHeight = 704 - ClientWidth = 34 Enabled = False TabOrder = 1 object AddTabBtn: TSpeedButton - Left = 4 - Height = 26 - Top = 4 + Left = 1 + Top = 1 Width = 26 + Height = 26 Caption = '+' + Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -24 Font.Name = 'Arial Black' - OnClick = AddTabBtnClick + Font.Style = [] ParentFont = False + OnClick = AddTabBtnClick end object RemoveTabBtn: TSpeedButton - Left = 4 - Height = 26 - Top = 33 + Left = 1 + Top = 30 Width = 26 + Height = 26 Caption = '−' + Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -24 Font.Name = 'Arial Black' - OnClick = RemoveTabBtnClick + Font.Style = [] ParentFont = False + OnClick = RemoveTabBtnClick end end end diff --git a/demos/Lazarus_Windows/TabbedBrowser2/uMainForm.pas b/demos/Lazarus_Windows/TabbedBrowser2/uMainForm.pas index 44438b2f..dc703fa5 100644 --- a/demos/Lazarus_Windows/TabbedBrowser2/uMainForm.pas +++ b/demos/Lazarus_Windows/TabbedBrowser2/uMainForm.pas @@ -44,13 +44,21 @@ unit uMainForm; interface uses - LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics, + {$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} + LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics, SyncObjs, Controls, Forms, Dialogs, ComCtrls, ToolWin, Buttons, ExtCtrls, - uCEFApplication, uCEFTypes, uCEFConstants; + {$ENDIF} + uCEFApplication, uCEFInterfaces, uCEFTypes, uCEFConstants, uChildForm, uBrowserTab; const - CEF_INITIALIZED = WM_APP + $100; - CEF_DESTROYTAB = WM_APP + $101; + 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; HOMEPAGE_URL = 'https://www.google.com'; DEFAULT_TAB_CAPTION = 'New tab'; @@ -68,28 +76,44 @@ type procedure FormShow(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + procedure FormDestroy(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 + 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 CloseAllTabs : boolean; + function CloseAllBrowsers : boolean; procedure CloseTab(aIndex : integer); + procedure CreateHiddenBrowsers; 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 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 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 @@ -101,8 +125,6 @@ implementation {$R *.lfm} -uses - uBrowserTab; // This demo shows how to use a TPageControl with TFrames that include // CEF4Delphi browsers. @@ -129,14 +151,38 @@ uses // event which will be used in TBrowserTab to send a CEF_DESTROYTAB message // to the main form to free the tab. +// 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. + +// VCL components *MUST* be created and destroyed in the main thread but CEF +// executes the TChromium.OnBeforePopup in a different thread. + +// For this reason this demo creates a hidden popup form (TChildForm) and a +// hidden TBrowserTab in case CEF needs to show a popup window. + +// TChromium.OnBeforePopup calls TMainForm.DoOnBeforePopup to handle all the +// events in the same place. + +// TMainForm.DoOnBeforePopup will call CreateClientHandler to initialize some +// parameters and create the new ICefClient using the hidden form or tab. + +// After that, it sends a custom message to show the popup form or tab and create +// a new one. + // 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 +// 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 free that tab. -// 3. When TPageControl has no tabs then we can set FCanClose to TRUE and send a -// WM_CLOSE to the main form to close the application. +// 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 @@ -148,7 +194,12 @@ procedure CreateGlobalCEFApp; begin GlobalCEFApp := TCefApplication.Create; GlobalCEFApp.cache := 'cache'; + GlobalCEFApp.EnablePrintPreview := True; GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized; + + // This is a workaround for the CEF4Delphi issue #324 : + // https://github.com/salvadordf/CEF4Delphi/issues/324 + GlobalCEFApp.DisableFeatures := 'WinUseBrowserSpellChecker'; end; procedure TMainForm.EnableButtonPnl; @@ -158,7 +209,7 @@ begin ButtonPnl.Enabled := True; Caption := 'Tabbed Browser 2'; cursor := crDefault; - if (BrowserPageCtrl.PageCount = 0) then AddTabBtn.Click; + if (BrowserTabCount = 0) then AddTabBtn.Click; end; end; @@ -168,6 +219,44 @@ begin 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; @@ -183,6 +272,7 @@ end; procedure TMainForm.CEFInitializedMsg(var aMessage : TMessage); begin EnableButtonPnl; + CreateHiddenBrowsers; end; procedure TMainForm.DestroyTabMsg(var aMessage : TMessage); @@ -190,6 +280,8 @@ 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 @@ -204,13 +296,74 @@ begin inc(i); end; - if FClosing and (BrowserPageCtrl.PageCount = 0) then + // 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.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.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); + + BrowserPageCtrl.ActivePageIndex := FHiddenTab.PageIndex; + 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; @@ -220,7 +373,7 @@ begin FClosing := True; ButtonPnl.Enabled := False; - if not(CloseAllTabs) then + if not(CloseAllBrowsers) then begin FCanClose := True; PostMessage(Handle, WM_CLOSE, 0, 0); @@ -230,33 +383,68 @@ end; procedure TMainForm.FormCreate(Sender: TObject); begin - FCanClose := False; - FClosing := False; - FLastTabID := 0; + 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 - EnableButtonPnl; + begin + EnableButtonPnl; + CreateHiddenBrowsers; + end; end; procedure TMainForm.RemoveTabBtnClick(Sender: TObject); begin + // Call TBrowserTab.CloseBrowser in the active tab CloseTab(BrowserPageCtrl.ActivePageIndex); end; -function TMainForm.CloseAllTabs : boolean; +function TMainForm.CloseAllBrowsers : boolean; var - i : integer; + i : integer; + TempForm : TCustomForm; + TempTab : TBrowserTab; begin Result := False; - i := pred(BrowserPageCtrl.PageCount); - + i := pred(screen.CustomFormCount); while (i >= 0) do begin - TBrowserTab(BrowserPageCtrl.Pages[i]).CloseBrowser; - Result := True; + 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; @@ -267,6 +455,26 @@ begin 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; @@ -311,4 +519,73 @@ begin GlobalCEFApp.OsmodalLoop := False; end; +procedure TMainForm.WMQueryEndSession(var aMessage: TWMQueryEndSession); +begin + // We return False (0) to close the browser correctly while we can. + // This is not what Microsoft recommends doing when an application receives + // WM_QUERYENDSESSION but at least we avoid TApplication calling HALT when + // it receives WM_ENDSESSION. + // The CEF subprocesses may receive WM_QUERYENDSESSION and WM_ENDSESSION + // before the main process and they may crash before closing the main form. + aMessage.Result := 0; + PostMessage(Handle, WM_CLOSE, 0, 0); +end; + +function TMainForm.DoOnBeforePopup(var windowInfo : TCefWindowInfo; + var client : ICefClient; + const targetFrameName : string; + const popupFeatures : TCefPopupFeatures; + targetDisposition : TCefWindowOpenDisposition) : boolean; +begin + try + FCriticalSection.Acquire; + + case targetDisposition of + WOD_NEW_FOREGROUND_TAB, + WOD_NEW_BACKGROUND_TAB : + Result := (FHiddenTab <> nil) and + FHiddenTab.CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures) and + PostMessage(Handle, CEF_CREATENEXTTAB, 0, ord(False)); + + WOD_NEW_WINDOW, + WOD_NEW_POPUP : + Result := (FChildForm <> nil) and + FChildForm.CreateClientHandler(windowInfo, client, targetFrameName, popupFeatures) and + PostMessage(Handle, CEF_CREATENEXTCHILD, 0, ord(False)); + + else Result := False; + end; + finally + FCriticalSection.Release; + end; +end; + +function TMainForm.DoOpenUrlFromTab(const targetUrl : string; + targetDisposition : TCefWindowOpenDisposition) : boolean; +begin + try + FCriticalSection.Acquire; + + case targetDisposition of + WOD_NEW_FOREGROUND_TAB, + WOD_NEW_BACKGROUND_TAB : + begin + FPendingURL := targetUrl; + Result := PostMessage(Handle, CEF_CREATENEXTTAB, 0, ord(True)); + end; + + WOD_NEW_WINDOW, + WOD_NEW_POPUP : + begin + FPendingURL := targetUrl; + Result := PostMessage(Handle, CEF_CREATENEXTCHILD, 0, ord(True)); + end + + else Result := False; + end; + finally + FCriticalSection.Release; + end; +end; + end. diff --git a/packages/cef4delphi_lazarus.lpk b/packages/cef4delphi_lazarus.lpk index 1e9a0bdc..d1aab48c 100644 --- a/packages/cef4delphi_lazarus.lpk +++ b/packages/cef4delphi_lazarus.lpk @@ -21,7 +21,7 @@ - + diff --git a/source/uCEFApplicationCore.pas b/source/uCEFApplicationCore.pas index cb6a4685..abe850dc 100644 --- a/source/uCEFApplicationCore.pas +++ b/source/uCEFApplicationCore.pas @@ -66,13 +66,13 @@ uses const CEF_SUPPORTED_VERSION_MAJOR = 91; CEF_SUPPORTED_VERSION_MINOR = 1; - CEF_SUPPORTED_VERSION_RELEASE = 20; + CEF_SUPPORTED_VERSION_RELEASE = 21; CEF_SUPPORTED_VERSION_BUILD = 0; CEF_CHROMEELF_VERSION_MAJOR = 91; CEF_CHROMEELF_VERSION_MINOR = 0; CEF_CHROMEELF_VERSION_RELEASE = 4472; - CEF_CHROMEELF_VERSION_BUILD = 101; + CEF_CHROMEELF_VERSION_BUILD = 114; {$IFDEF MSWINDOWS} LIBCEF_DLL = 'libcef.dll'; diff --git a/update_CEF4Delphi.json b/update_CEF4Delphi.json index fd5cb954..c4d8dad1 100644 --- a/update_CEF4Delphi.json +++ b/update_CEF4Delphi.json @@ -2,9 +2,9 @@ "UpdateLazPackages" : [ { "ForceNotify" : true, - "InternalVersion" : 305, + "InternalVersion" : 306, "Name" : "cef4delphi_lazarus.lpk", - "Version" : "91.1.20.0" + "Version" : "91.1.21.0" } ], "UpdatePackageData" : {