2018-01-06 15:25:32 +01:00
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
2019-10-19 10:58:34 +02:00
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
2018-01-06 15:25:32 +01:00
// 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
//
2021-01-01 11:11:30 +01:00
// Copyright <20> 2021 Salvador Diaz Fau. All rights reserved.
2018-01-06 15:25:32 +01:00
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
( *
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest < hgourvest@ gmail. com>
* Web site : http: //www.progdigy.com
* Repository : http: //code.google.com/p/delphichromiumembedded/
* Group : http: //groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
* )
unit uMainForm;
{$I cef.inc}
interface
uses
{$IFDEF DELPHI16_UP}
Winapi . Windows, System. SysUtils, System. Classes, Vcl. Graphics, Vcl. Forms,
Vcl. Controls, Vcl. StdCtrls, Vcl. Dialogs, Vcl. Buttons, Winapi . Messages,
Vcl. ExtCtrls, Vcl. ComCtrls,
{$ELSE}
Windows, SysUtils, Classes, Graphics, Forms,
Controls, StdCtrls, Dialogs, Buttons, Messages,
ExtCtrls, ComCtrls,
{$ENDIF}
2019-10-13 18:50:23 +02:00
uCEFWorkScheduler, uCEFSentinel;
2018-01-06 15:25:32 +01:00
const
CEFBROWSER_CREATED = WM_APP + $100 ;
CEFBROWSER_CHILDDESTROYED = WM_APP + $101 ;
CEFBROWSER_DESTROY = WM_APP + $102 ;
CEFBROWSER_INITIALIZED = WM_APP + $103 ;
type
TMainForm = class( TForm)
ButtonPnl: TPanel;
NewBtn: TSpeedButton;
ExitBtn: TSpeedButton;
NewContextChk: TCheckBox;
2021-06-04 15:10:40 +02:00
2018-01-06 15:25:32 +01:00
procedure FormCreate( Sender: TObject) ;
procedure NewBtnClick( Sender: TObject) ;
procedure ExitBtnClick( Sender: TObject) ;
procedure FormShow( Sender: TObject) ;
2021-06-04 15:10:40 +02:00
2018-01-06 15:25:32 +01:00
private
// Variables to control when can we destroy the form safely
FCanClose : boolean ; // Set to True when all the child forms are closed
FClosing : boolean ; // Set to True in the CloseQuery event.
procedure CreateMDIChild( const Name : string ) ;
procedure CloseAllChildForms;
function GetChildClosing : boolean ;
protected
procedure ChildDestroyedMsg( var aMessage : TMessage) ; message CEFBROWSER_CHILDDESTROYED;
procedure CEFInitializedMsg( var aMessage : TMessage) ; message CEFBROWSER_INITIALIZED;
public
function CloseQuery: Boolean ; override ;
property ChildClosing : boolean read GetChildClosing;
end ;
var
2018-04-07 20:24:55 +02:00
MainForm : TMainForm;
2018-01-06 15:25:32 +01:00
2018-06-17 14:18:11 +02:00
procedure CreateGlobalCEFApp;
2018-01-06 15:25:32 +01:00
implementation
{$R *.dfm}
uses
uChildForm, uCEFApplication;
// Destruction steps
// =================
// 1. Destroy all child forms
2019-10-13 18:50:23 +02:00
// 2. Wait until all the child forms are closed before calling TCEFSentinel.Start, which will trigger TCEFSentinel.OnClose when all renderer processes are closed
// 3. TCEFSentinel.OnClose closes the main form.
2018-01-06 15:25:32 +01:00
procedure GlobalCEFApp_OnContextInitialized;
begin
if ( MainForm < > nil ) and MainForm. HandleAllocated then
PostMessage( MainForm. Handle, CEFBROWSER_INITIALIZED, 0 , 0 ) ;
end ;
procedure GlobalCEFApp_OnScheduleMessagePumpWork( const aDelayMS : int64 ) ;
begin
2021-06-04 15:10:40 +02:00
if ( GlobalCEFWorkScheduler < > nil ) then
GlobalCEFWorkScheduler. ScheduleMessagePumpWork( aDelayMS) ;
2018-01-06 15:25:32 +01:00
end ;
2018-06-17 14:18:11 +02:00
procedure CreateGlobalCEFApp;
begin
GlobalCEFApp : = TCefApplication. Create;
GlobalCEFApp. ExternalMessagePump : = True ;
GlobalCEFApp. MultiThreadedMessageLoop : = False ;
GlobalCEFApp. OnScheduleMessagePumpWork : = GlobalCEFApp_OnScheduleMessagePumpWork;
GlobalCEFApp. OnContextInitialized : = GlobalCEFApp_OnContextInitialized;
2021-06-04 15:10:40 +02:00
GlobalCEFApp. RootCache : = ExtractFileDir( ParamStr( 0 ) ) ;
GlobalCEFApp. cache : = GlobalCEFApp. RootCache + '\cache' ;
// TCEFWorkScheduler will call cef_do_message_loop_work when
// it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event.
// GlobalCEFWorkScheduler needs to be created before the
// GlobalCEFApp.StartMainProcess call.
GlobalCEFWorkScheduler : = TCEFWorkScheduler. Create( nil ) ;
2018-06-17 14:18:11 +02:00
end ;
2018-01-06 15:25:32 +01:00
procedure TMainForm. CreateMDIChild( const Name : string ) ;
var
TempChild : TChildForm;
begin
TempChild : = TChildForm. Create( Application) ;
TempChild. Caption : = Name ;
end ;
procedure TMainForm. CloseAllChildForms;
var
i : integer ;
begin
i : = pred( MDIChildCount) ;
while ( i > = 0 ) do
begin
if not( TChildForm( MDIChildren[ i] ) . Closing) then
PostMessage( MDIChildren[ i] . Handle, WM_CLOSE, 0 , 0 ) ;
dec( i) ;
end ;
end ;
function TMainForm. GetChildClosing : boolean ;
var
i : integer ;
begin
Result : = false ;
i : = pred( MDIChildCount) ;
while ( i > = 0 ) do
if TChildForm( MDIChildren[ i] ) . Closing then
begin
Result : = True ;
exit;
end
else
dec( i) ;
end ;
procedure TMainForm. FormCreate( Sender: TObject) ;
begin
FCanClose : = False ;
FClosing : = False ;
end ;
procedure TMainForm. NewBtnClick( Sender: TObject) ;
begin
CreateMDIChild( 'ChildForm' + IntToStr( MDIChildCount + 1 ) ) ;
end ;
procedure TMainForm. ExitBtnClick( Sender: TObject) ;
begin
ButtonPnl. Enabled : = False ;
if ( MDIChildCount = 0 ) then
Close
else
CloseAllChildForms;
end ;
procedure TMainForm. ChildDestroyedMsg( var aMessage : TMessage) ;
begin
// If there are no more child forms we can destroy the main form
2021-06-04 15:10:40 +02:00
2019-07-10 14:31:45 +02:00
if FClosing and ( MDIChildCount = 0 ) then
2018-01-06 15:25:32 +01:00
begin
ButtonPnl. Enabled : = False ;
2020-02-26 13:28:29 +01:00
FCanClose : = True ;
PostMessage( Handle, WM_CLOSE, 0 , 0 ) ;
2018-01-06 15:25:32 +01:00
end ;
end ;
procedure TMainForm. CEFInitializedMsg( var aMessage : TMessage) ;
begin
Caption : = 'MDI External Pump Browser' ;
ButtonPnl. Enabled : = True ;
cursor : = crDefault;
end ;
procedure TMainForm. FormShow( Sender: TObject) ;
begin
if ( GlobalCEFApp < > nil ) and GlobalCEFApp. GlobalContextInitialized then
begin
Caption : = 'MDI External Pump Browser' ;
ButtonPnl. Enabled : = True ;
cursor : = crDefault;
end ;
end ;
function TMainForm. CloseQuery: Boolean ;
begin
if FClosing or ChildClosing then
Result : = FCanClose
else
begin
FClosing : = True ;
if ( MDIChildCount = 0 ) then
Result : = True
else
begin
Result : = False ;
CloseAllChildForms;
end ;
end ;
end ;
end .