mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2024-11-16 08:15:55 +01:00
e3f1a0902d
Added the GlobalCEFApp.DisableZygote property Added the GlobalCEFApp.OnPrintStart event. Added the GlobalCEFApp.OnPrintSettings event. Added the GlobalCEFApp.OnPrintDialog event. Added the GlobalCEFApp.OnPrintJob event. Added the GlobalCEFApp.OnPrintReset event. Added the GlobalCEFApp.OnGetPDFPaperSize event.
279 lines
10 KiB
ObjectPascal
279 lines
10 KiB
ObjectPascal
// ************************************************************************
|
|
// ***************************** 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 <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 uExternalPumpBrowser;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, LMessages,
|
|
uCEFChromium, uCEFWindowParent, uCEFConstants, uCEFTypes, uCEFInterfaces,
|
|
uCEFChromiumEvents, uCEFLinkedWindowParent, uCEFWorkScheduler;
|
|
|
|
type
|
|
|
|
{ TForm1 }
|
|
|
|
TForm1 = class(TForm)
|
|
AddressEdt: TEdit;
|
|
CEFLinkedWindowParent1: TCEFLinkedWindowParent;
|
|
GoBtn: TButton;
|
|
Chromium1: TChromium;
|
|
AddressPnl: TPanel;
|
|
Timer1: TTimer;
|
|
|
|
procedure CEFLinkedWindowParent1Enter(Sender: TObject);
|
|
procedure CEFLinkedWindowParent1Exit(Sender: TObject);
|
|
|
|
procedure Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
|
|
procedure Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser);
|
|
procedure Chromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction: TCefCloseBrowserAction);
|
|
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 Chromium1OpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; out Result: Boolean);
|
|
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormActivate(Sender: TObject);
|
|
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
|
|
|
|
procedure GoBtnClick(Sender: TObject);
|
|
procedure Timer1Timer(Sender: TObject);
|
|
private
|
|
|
|
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.
|
|
|
|
// CEF needs to handle these messages to call TChromium.NotifyMoveOrResizeStarted
|
|
procedure WMMove(var Message: TLMMove); message LM_MOVE;
|
|
procedure WMSize(var Message: TLMSize); message LM_SIZE;
|
|
procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
|
|
public
|
|
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
procedure CreateGlobalCEFApp;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
// 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 TCEFLinkedWindowParent
|
|
|
|
// We need to use TCEFLinkedWindowParent in Linux to update the browser
|
|
// visibility and size automatically.
|
|
|
|
// Destruction steps
|
|
// =================
|
|
// 1. FormCloseQuery sets CanClose to FALSE calls TChromium.CloseBrowser which triggers the TChromium.OnClose event.
|
|
// 2. TChromium.OnClose sets aAction to cbaClose to destroy the browser, which triggers the TChromium.OnBeforeClose event.
|
|
// 3. TChromium.OnBeforeClose sets FCanClose := True and sends CEF_BEFORECLOSE to close the form.
|
|
|
|
uses
|
|
uCEFApplication;
|
|
|
|
{ TForm1 }
|
|
|
|
procedure GlobalCEFApp_OnScheduleMessagePumpWork(const aDelayMS : int64);
|
|
begin
|
|
if (GlobalCEFWorkScheduler <> nil) then GlobalCEFWorkScheduler.ScheduleMessagePumpWork(aDelayMS);
|
|
end;
|
|
|
|
procedure CreateGlobalCEFApp;
|
|
begin
|
|
// TCEFWorkScheduler will call cef_do_message_loop_work when
|
|
// it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event.
|
|
// GlobalCEFWorkScheduler needs to be created before the
|
|
// GlobalCEFApp.StartMainProcess call.
|
|
GlobalCEFWorkScheduler := TCEFWorkScheduler.Create(nil);
|
|
|
|
GlobalCEFApp := TCefApplication.Create;
|
|
GlobalCEFApp.ExternalMessagePump := True;
|
|
GlobalCEFApp.MultiThreadedMessageLoop := False;
|
|
GlobalCEFApp.OnScheduleMessagePumpWork := @GlobalCEFApp_OnScheduleMessagePumpWork;
|
|
|
|
// This is a workaround for the 'GPU is not usable error' issue :
|
|
// https://bitbucket.org/chromiumembedded/cef/issues/2964/gpu-is-not-usable-error-during-cef
|
|
GlobalCEFApp.DisableZygote := True; // this property adds the "--no-zygote" command line switch
|
|
{
|
|
GlobalCEFApp.LogFile := 'cef.log';
|
|
GlobalCEFApp.LogSeverity := LOGSEVERITY_VERBOSE;
|
|
}
|
|
end;
|
|
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
begin
|
|
FCanClose := False;
|
|
FClosing := False;
|
|
|
|
Chromium1.DefaultURL := UTF8Decode(AddressEdt.Text);
|
|
end;
|
|
|
|
procedure TForm1.GoBtnClick(Sender: TObject);
|
|
begin
|
|
Chromium1.LoadURL(UTF8Decode(AddressEdt.Text));
|
|
end;
|
|
|
|
procedure TForm1.Timer1Timer(Sender: TObject);
|
|
begin
|
|
Timer1.Enabled := False;
|
|
|
|
if not(Chromium1.CreateBrowser(CEFLinkedWindowParent1.Handle, CEFLinkedWindowParent1.BoundsRect)) and
|
|
not(Chromium1.Initialized) then
|
|
Timer1.Enabled := True;
|
|
end;
|
|
|
|
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
|
|
begin
|
|
CanClose := FCanClose;
|
|
|
|
if not(FClosing) then
|
|
begin
|
|
FClosing := True;
|
|
Visible := False;
|
|
Chromium1.CloseBrowser(True);
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.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);
|
|
begin
|
|
// For simplicity, this demo blocks all popup windows and new tabs
|
|
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
|
|
end;
|
|
|
|
procedure 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
|
|
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
|
|
end;
|
|
|
|
procedure TForm1.FormActivate(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.
|
|
|
|
// Linux needs a visible form to create a browser so we need to use the
|
|
// TForm.OnActivate event instead of the TForm.OnShow event
|
|
|
|
if not(Chromium1.Initialized) and
|
|
not(Chromium1.CreateBrowser(CEFLinkedWindowParent1.Handle, CEFLinkedWindowParent1.BoundsRect)) then
|
|
Timer1.Enabled := True;
|
|
end;
|
|
|
|
procedure TForm1.Chromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction: TCefCloseBrowserAction);
|
|
begin
|
|
// continue closing the browser
|
|
aAction := cbaClose;
|
|
end;
|
|
|
|
procedure TForm1.Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser);
|
|
begin
|
|
// We must wait until all browsers trigger the TChromium.OnBeforeClose event
|
|
// in order to close the application safely or we will have shutdown issues.
|
|
FCanClose := True;
|
|
Close;
|
|
end;
|
|
|
|
procedure TForm1.Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
|
|
begin
|
|
// Now the browser is fully initialized we can initialize the UI.
|
|
Caption := 'External Pump Browser';
|
|
AddressPnl.Enabled := True;
|
|
end;
|
|
|
|
procedure TForm1.CEFLinkedWindowParent1Enter(Sender: TObject);
|
|
begin
|
|
If not(csDesigning in ComponentState) then Chromium1.SetFocus(True);
|
|
end;
|
|
|
|
procedure TForm1.CEFLinkedWindowParent1Exit(Sender: TObject);
|
|
begin
|
|
if not(csDesigning in ComponentState) then Chromium1.SendCaptureLostEvent;
|
|
end;
|
|
|
|
procedure TForm1.WMMove(var Message: TLMMove);
|
|
begin
|
|
inherited;
|
|
Chromium1.NotifyMoveOrResizeStarted;
|
|
end;
|
|
|
|
procedure TForm1.WMSize(var Message: TLMSize);
|
|
begin
|
|
inherited;
|
|
Chromium1.NotifyMoveOrResizeStarted;
|
|
end;
|
|
|
|
procedure TForm1.WMWindowPosChanged(var Message: TLMWindowPosChanged);
|
|
begin
|
|
inherited;
|
|
Chromium1.NotifyMoveOrResizeStarted;
|
|
end;
|
|
|
|
|
|
end.
|
|
|