2018-01-08 16:22:54 +01:00
unit uSimpleBrowser2;
2023-11-26 19:28:28 +01:00
{$I ..\..\..\source\cef.inc}
2018-01-08 16:22:54 +01:00
interface
uses
{$IFDEF DELPHI16_UP}
Winapi . Windows, Winapi . Messages, System. SysUtils, System. Variants, System. Classes, Vcl. Graphics,
Vcl. Controls, Vcl. Forms, Vcl. Dialogs, Vcl. StdCtrls, Vcl. ExtCtrls,
{$ELSE}
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
{$ENDIF}
2018-10-20 14:46:24 +02:00
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFConstants, uCEFTypes,
2023-11-27 18:21:07 +01:00
uCEFWinControl, uCEFChromiumCore;
2018-01-08 16:22:54 +01:00
type
TForm1 = class( TForm)
AddressPnl: TPanel;
AddressEdt: TEdit;
GoBtn: TButton;
Timer1: TTimer;
Chromium1: TChromium;
CEFWindowParent1: TCEFWindowParent;
2020-04-10 09:49:34 +02:00
2018-01-08 16:22:54 +01:00
procedure GoBtnClick( Sender: TObject) ;
procedure Timer1Timer( Sender: TObject) ;
2020-04-10 09:49:34 +02:00
procedure FormShow( Sender: TObject) ;
2018-03-31 18:08:18 +02:00
procedure FormCreate( Sender: TObject) ;
procedure FormCloseQuery( Sender: TObject; var CanClose: Boolean ) ;
2020-04-10 09:49:34 +02:00
procedure Chromium1AfterCreated( Sender: TObject; const browser: ICefBrowser) ;
procedure Chromium1BeforeClose( Sender: TObject; const browser: ICefBrowser) ;
2024-11-16 12:19:26 +01:00
procedure Chromium1BeforePopup( Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; popup_id: Integer ; 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 ) ;
2020-04-10 09:49:34 +02:00
procedure Chromium1OpenUrlFromTab( Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean ; out Result : Boolean ) ;
2018-03-31 18:08:18 +02:00
protected
// Variables to control when can we destroy the form safely
FCanClose : boolean ; // Set to True in TChromium.OnBeforeClose
FClosing : boolean ; // Set to True in the CloseQuery event.
2018-01-08 16:22:54 +01:00
// You have to handle this two messages to call NotifyMoveOrResizeStarted or some page elements will be misaligned.
procedure WMMove( var aMessage : TWMMove) ; message WM_MOVE;
procedure WMMoving( var aMessage : TMessage) ; message WM_MOVING;
// You also have to handle these two messages to set GlobalCEFApp.OsmodalLoop
procedure WMEnterMenuLoop( var aMessage: TMessage) ; message WM_ENTERMENULOOP;
procedure WMExitMenuLoop( var aMessage: TMessage) ; message WM_EXITMENULOOP;
procedure BrowserCreatedMsg( var aMessage : TMessage) ; message CEF_AFTERCREATED;
public
{ Public declarations }
end ;
var
Form1: TForm1;
2024-06-17 11:44:07 +02:00
procedure CreateGlobalCEFApp;
2018-01-08 16:22:54 +01:00
implementation
{$R *.dfm}
uses
2018-10-25 12:50:01 +02:00
uCEFApplication, uCefMiscFunctions;
2018-01-08 16:22:54 +01:00
// This is a demo with the simplest web browser you can build using CEF4Delphi and
// it doesn't show any sign of progress like other web browsers do.
// Remember that it may take a few seconds to load if Windows update, your antivirus or
// any other windows service is using your hard drive.
// Depending on your internet connection it may take longer than expected.
// Please check that your firewall or antivirus are not blocking this application
// or the domain "google.com". If you don't live in the US, you'll be redirected to
// another domain which will take a little time too.
// This demo uses a TChromium and a TCEFWindowParent
2018-10-20 14:46:24 +02:00
// Destruction steps
// =================
2024-09-03 17:26:03 +02:00
// 1. FormCloseQuery sets CanClose to FALSE, destroys CEFWindowParent1 and calls TChromium.CloseBrowser which triggers the TChromium.OnBeforeClose event.
// 2. TChromium.OnBeforeClose sets FCanClose := True and sends WM_CLOSE to the form.
2018-10-20 14:46:24 +02:00
2024-06-17 11:44:07 +02:00
procedure CreateGlobalCEFApp;
begin
GlobalCEFApp : = TCefApplication. Create;
GlobalCEFApp. cache : = 'cache' ;
GlobalCEFApp. EnablePrintPreview : = True ;
GlobalCEFApp. EnableGPU : = True ;
{$IFDEF DEBUG}
GlobalCEFApp. LogFile : = 'debug.log' ;
GlobalCEFApp. LogSeverity : = LOGSEVERITY_INFO;
{$ENDIF}
end ;
2018-03-31 18:08:18 +02:00
procedure TForm1. FormCloseQuery( Sender: TObject; var CanClose: Boolean ) ;
begin
CanClose : = FCanClose;
if not( FClosing) then
begin
FClosing : = True ;
Visible : = False ;
Chromium1. CloseBrowser( True ) ;
2024-09-03 17:26:03 +02:00
CEFWindowParent1. Free;
2018-03-31 18:08:18 +02:00
end ;
end ;
procedure TForm1. FormCreate( Sender: TObject) ;
begin
FCanClose : = False ;
FClosing : = False ;
2018-10-25 12:50:01 +02:00
Chromium1. DefaultURL : = AddressEdt. Text ;
2018-03-31 18:08:18 +02:00
end ;
2018-01-08 16:22:54 +01:00
procedure TForm1. FormShow( Sender: TObject) ;
begin
// You *MUST* call CreateBrowser to create and initialize the browser.
// This will trigger the AfterCreated event when the browser is fully
// initialized and ready to receive commands.
// GlobalCEFApp.GlobalContextInitialized has to be TRUE before creating any browser
// If it's not initialized yet, we use a simple timer to create the browser later.
if not( Chromium1. CreateBrowser( CEFWindowParent1) ) then Timer1. Enabled : = True ;
end ;
procedure TForm1. Chromium1AfterCreated( Sender: TObject; const browser: ICefBrowser) ;
begin
// Now the browser is fully initialized we can send a message to the main form to load the initial web page.
PostMessage( Handle, CEF_AFTERCREATED, 0 , 0 ) ;
end ;
2018-03-31 18:08:18 +02:00
procedure TForm1. Chromium1BeforeClose( Sender: TObject;
const browser: ICefBrowser) ;
begin
2020-01-01 12:48:10 +01:00
FCanClose : = True ;
PostMessage( Handle, WM_CLOSE, 0 , 0 ) ;
2018-03-31 18:08:18 +02:00
end ;
2018-02-16 18:41:13 +01:00
procedure TForm1. Chromium1BeforePopup( Sender: TObject;
2024-11-16 12:19:26 +01:00
const browser: ICefBrowser; const frame: ICefFrame; popup_id: Integer ;
const targetUrl, targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition;
2018-03-29 20:02:04 +02:00
userGesture: Boolean ; const popupFeatures: TCefPopupFeatures;
2018-02-16 18:41:13 +01:00
var windowInfo: TCefWindowInfo; var client: ICefClient;
2019-06-16 10:31:13 +02:00
var settings: TCefBrowserSettings; var extra_info: ICefDictionaryValue;
var noJavascriptAccess, Result : Boolean ) ;
2018-02-16 18:41:13 +01:00
begin
// For simplicity, this demo blocks all popup windows and new tabs
2023-12-15 18:06:46 +01:00
Result : = ( targetDisposition in [ CEF_WOD_NEW_FOREGROUND_TAB, CEF_WOD_NEW_BACKGROUND_TAB, CEF_WOD_NEW_POPUP, CEF_WOD_NEW_WINDOW] ) ;
2018-02-16 18:41:13 +01:00
end ;
2019-08-27 09:52:33 +02:00
procedure TForm1. Chromium1OpenUrlFromTab( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition;
userGesture: Boolean ; out Result : Boolean ) ;
begin
// For simplicity, this demo blocks all popup windows and new tabs
2023-12-15 18:06:46 +01:00
Result : = ( targetDisposition in [ CEF_WOD_NEW_FOREGROUND_TAB, CEF_WOD_NEW_BACKGROUND_TAB, CEF_WOD_NEW_POPUP, CEF_WOD_NEW_WINDOW] ) ;
2019-08-27 09:52:33 +02:00
end ;
2018-01-08 16:22:54 +01:00
procedure TForm1. BrowserCreatedMsg( var aMessage : TMessage) ;
begin
Caption : = 'Simple Browser 2' ;
AddressPnl. Enabled : = True ;
end ;
procedure TForm1. GoBtnClick( Sender: TObject) ;
begin
// This will load the URL in the edit box
Chromium1. LoadURL( AddressEdt. Text ) ;
end ;
procedure TForm1. Timer1Timer( Sender: TObject) ;
begin
Timer1. Enabled : = False ;
if not( Chromium1. CreateBrowser( CEFWindowParent1) ) and not( Chromium1. Initialized) then
Timer1. Enabled : = True ;
end ;
procedure TForm1. WMMove( var aMessage : TWMMove) ;
begin
inherited ;
if ( Chromium1 < > nil ) then Chromium1. NotifyMoveOrResizeStarted;
end ;
procedure TForm1. WMMoving( var aMessage : TMessage) ;
begin
inherited ;
if ( Chromium1 < > nil ) then Chromium1. NotifyMoveOrResizeStarted;
end ;
procedure TForm1. WMEnterMenuLoop( var aMessage: TMessage) ;
begin
inherited ;
if ( aMessage. wParam = 0 ) and ( GlobalCEFApp < > nil ) then GlobalCEFApp. OsmodalLoop : = True ;
end ;
procedure TForm1. WMExitMenuLoop( var aMessage: TMessage) ;
begin
inherited ;
if ( aMessage. wParam = 0 ) and ( GlobalCEFApp < > nil ) then GlobalCEFApp. OsmodalLoop : = False ;
end ;
end .