mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2025-04-17 06:57:13 +02:00
f764c39cc1
Remove the outdated license text. Use the main cef.inc file in all Delphi demos. Fixed issue #493.
415 lines
13 KiB
ObjectPascal
415 lines
13 KiB
ObjectPascal
unit uMiniBrowser;
|
|
|
|
{$I ..\..\..\source\cef.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Variants, Classes, Graphics, Menus,
|
|
Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Types, ComCtrls,
|
|
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFApplication, uCEFTypes,
|
|
uCEFConstants, uCEFWinControl, uCEFChromiumCore;
|
|
|
|
const
|
|
MINIBROWSER_HOMEPAGE = 'https://www.google.com';
|
|
|
|
MINIBROWSER_CONTEXTMENU_MUTEAUDIO = MENU_ID_USER_FIRST + 1;
|
|
MINIBROWSER_CONTEXTMENU_UNMUTEAUDIO = MENU_ID_USER_FIRST + 2;
|
|
MINIBROWSER_CONTEXTMENU_INCZOOM = MENU_ID_USER_FIRST + 3;
|
|
MINIBROWSER_CONTEXTMENU_DECZOOM = MENU_ID_USER_FIRST + 4;
|
|
MINIBROWSER_CONTEXTMENU_RESETZOOM = MENU_ID_USER_FIRST + 5;
|
|
|
|
type
|
|
TMiniBrowserFrm = class(TForm)
|
|
NavControlPnl: TPanel;
|
|
NavButtonPnl: TPanel;
|
|
URLEditPnl: TPanel;
|
|
BackBtn: TButton;
|
|
ForwardBtn: TButton;
|
|
ReloadBtn: TButton;
|
|
CEFWindowParent1: TCEFWindowParent;
|
|
Chromium1: TChromium;
|
|
StopBtn: TButton;
|
|
StatusBar1: TStatusBar;
|
|
URLCbx: TComboBox;
|
|
ConfigPnl: TPanel;
|
|
ConfigBtn: TButton;
|
|
PopupMenu1: TPopupMenu;
|
|
GoBtn: TButton;
|
|
Print1: TMenuItem;
|
|
N3: TMenuItem;
|
|
Zoom1: TMenuItem;
|
|
Inczoom1: TMenuItem;
|
|
Deczoom1: TMenuItem;
|
|
Resetzoom1: TMenuItem;
|
|
Timer1: TTimer;
|
|
|
|
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
|
|
procedure Chromium1AddressChange(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const url: ustring);
|
|
procedure Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
|
|
procedure Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser);
|
|
procedure Chromium1BeforeContextMenu(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel);
|
|
procedure Chromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
|
|
procedure Chromium1ContextMenuCommand(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; commandId: Integer; eventFlags: Cardinal; out Result: Boolean);
|
|
procedure Chromium1LoadEnd(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; httpStatusCode: Integer);
|
|
procedure Chromium1LoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring);
|
|
procedure Chromium1StatusMessage(Sender: TObject; const browser: ICefBrowser; const value: ustring);
|
|
procedure Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring);
|
|
|
|
procedure BackBtnClick(Sender: TObject);
|
|
procedure ConfigBtnClick(Sender: TObject);
|
|
procedure Deczoom1Click(Sender: TObject);
|
|
procedure ForwardBtnClick(Sender: TObject);
|
|
procedure GoBtnClick(Sender: TObject);
|
|
procedure Inczoom1Click(Sender: TObject);
|
|
procedure Print1Click(Sender: TObject);
|
|
procedure ReloadBtnClick(Sender: TObject);
|
|
procedure Resetzoom1Click(Sender: TObject);
|
|
procedure StopBtnClick(Sender: TObject);
|
|
procedure Timer1Timer(Sender: TObject);
|
|
|
|
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.
|
|
|
|
procedure AddURL(const aURL : string);
|
|
|
|
procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED;
|
|
procedure BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY;
|
|
procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP;
|
|
procedure WMExitMenuLoop(var aMessage: TMessage); message WM_EXITMENULOOP;
|
|
procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
|
|
procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
|
|
|
|
public
|
|
procedure ShowStatusText(const aText : string);
|
|
|
|
end;
|
|
|
|
var
|
|
MiniBrowserFrm : TMiniBrowserFrm;
|
|
|
|
procedure CreateGlobalCEFApp;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
// 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 CreateGlobalCEFApp;
|
|
begin
|
|
GlobalCEFApp := TCefApplication.Create;
|
|
GlobalCEFApp.cache := 'cache';
|
|
GlobalCEFApp.EnablePrintPreview := True;
|
|
GlobalCEFApp.EnableGPU := True;
|
|
GlobalCEFApp.LogFile := 'debug.log';
|
|
GlobalCEFApp.LogSeverity := LOGSEVERITY_INFO;
|
|
//GlobalCEFApp.ChromeRuntime := True;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.BackBtnClick(Sender: TObject);
|
|
begin
|
|
Chromium1.GoBack;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.ForwardBtnClick(Sender: TObject);
|
|
begin
|
|
Chromium1.GoForward;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.GoBtnClick(Sender: TObject);
|
|
begin
|
|
Chromium1.LoadURL(URLCbx.Text);
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.ReloadBtnClick(Sender: TObject);
|
|
begin
|
|
Chromium1.Reload;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Resetzoom1Click(Sender: TObject);
|
|
begin
|
|
Chromium1.ResetZoomStep;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.StopBtnClick(Sender: TObject);
|
|
begin
|
|
Chromium1.StopLoad;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Inczoom1Click(Sender: TObject);
|
|
begin
|
|
Chromium1.IncZoomStep;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Deczoom1Click(Sender: TObject);
|
|
begin
|
|
Chromium1.DecZoomStep;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Print1Click(Sender: TObject);
|
|
begin
|
|
Chromium1.Print;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.ConfigBtnClick(Sender: TObject);
|
|
var
|
|
TempPoint : TPoint;
|
|
begin
|
|
TempPoint.x := ConfigBtn.left;
|
|
TempPoint.y := ConfigBtn.top + ConfigBtn.Height;
|
|
TempPoint := ConfigPnl.ClientToScreen(TempPoint);
|
|
|
|
PopupMenu1.Popup(TempPoint.x, TempPoint.y);
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Chromium1AddressChange(Sender: TObject;
|
|
const browser: ICefBrowser; const frame: ICefFrame; const url: ustring);
|
|
begin
|
|
if Chromium1.IsSameBrowser(browser) then AddURL(url);
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
|
|
begin
|
|
if Chromium1.IsSameBrowser(browser) then
|
|
PostMessage(Handle, CEF_AFTERCREATED, 0, 0)
|
|
else
|
|
SendMessage(browser.Host.WindowHandle, WM_SETICON, 1, Application.Icon.Handle); // Use the same icon in the popup window
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser);
|
|
begin
|
|
// The main browser is being destroyed
|
|
if (Chromium1.BrowserId = 0) then
|
|
begin
|
|
FCanClose := True;
|
|
PostMessage(Handle, WM_CLOSE, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Chromium1BeforeContextMenu(Sender: TObject;
|
|
const browser: ICefBrowser; const frame: ICefFrame;
|
|
const params: ICefContextMenuParams; const model: ICefMenuModel);
|
|
begin
|
|
model.AddSeparator;
|
|
if Chromium1.AudioMuted then
|
|
model.AddItem(MINIBROWSER_CONTEXTMENU_UNMUTEAUDIO, 'Unmute audio')
|
|
else
|
|
model.AddItem(MINIBROWSER_CONTEXTMENU_MUTEAUDIO, 'Mute audio');
|
|
|
|
model.AddSeparator;
|
|
if Chromium1.CanIncZoom then
|
|
model.AddItem(MINIBROWSER_CONTEXTMENU_INCZOOM, 'Increment zoom');
|
|
|
|
if Chromium1.CanDecZoom then
|
|
model.AddItem(MINIBROWSER_CONTEXTMENU_DECZOOM, 'Decrement zoom');
|
|
|
|
if Chromium1.CanResetZoom then
|
|
model.AddItem(MINIBROWSER_CONTEXTMENU_RESETZOOM, 'Reset zoom');
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Chromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
|
|
begin
|
|
if (browser <> nil) and
|
|
(Chromium1.BrowserId = browser.Identifier) and
|
|
(CEFWindowParent1 <> nil) then
|
|
begin
|
|
PostMessage(Handle, CEF_DESTROY, 0, 0);
|
|
aAction := cbaDelay;
|
|
end;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Chromium1ContextMenuCommand(Sender: TObject;
|
|
const browser: ICefBrowser; const frame: ICefFrame;
|
|
const params: ICefContextMenuParams; commandId: Integer;
|
|
eventFlags: Cardinal; out Result: Boolean);
|
|
begin
|
|
Result := False;
|
|
|
|
case commandId of
|
|
MINIBROWSER_CONTEXTMENU_UNMUTEAUDIO :
|
|
Chromium1.AudioMuted := False;
|
|
|
|
MINIBROWSER_CONTEXTMENU_MUTEAUDIO :
|
|
Chromium1.AudioMuted := True;
|
|
|
|
MINIBROWSER_CONTEXTMENU_INCZOOM :
|
|
Chromium1.IncZoomCommand;
|
|
|
|
MINIBROWSER_CONTEXTMENU_DECZOOM :
|
|
Chromium1.DecZoomCommand;
|
|
|
|
MINIBROWSER_CONTEXTMENU_RESETZOOM :
|
|
Chromium1.ResetZoomCommand;
|
|
end;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Chromium1LoadEnd(Sender: TObject;
|
|
const browser: ICefBrowser; const frame: ICefFrame;
|
|
httpStatusCode: Integer);
|
|
var
|
|
TempHandle : THandle;
|
|
begin
|
|
if FClosing or (frame = nil) or not(frame.IsValid) or (browser = nil) then exit;
|
|
|
|
if not Chromium1.IsSameBrowser(browser) then
|
|
begin
|
|
// This is a workaround for a focus issue in popup windows handled by CEF
|
|
TempHandle := Windows.GetWindow(Browser.Host.WindowHandle, GW_OWNER);
|
|
if (TempHandle <> Handle) then
|
|
Windows.SetFocus(TempHandle);
|
|
end;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Chromium1LoadError(Sender: TObject;
|
|
const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer;
|
|
const errorText, failedUrl: ustring);
|
|
var
|
|
TempString : string;
|
|
begin
|
|
if (errorCode = ERR_ABORTED) then exit;
|
|
|
|
TempString := '<html><body bgcolor="white">' +
|
|
'<h2>Failed to load URL ' + failedUrl +
|
|
' with error ' + errorText +
|
|
' (' + inttostr(errorCode) + ').</h2></body></html>';
|
|
|
|
Chromium1.LoadString(TempString, frame);
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.ShowStatusText(const aText : string);
|
|
begin
|
|
if not(FClosing) then StatusBar1.Panels[1].Text := aText;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Chromium1StatusMessage(Sender: TObject;
|
|
const browser: ICefBrowser; const value: ustring);
|
|
begin
|
|
if Chromium1.IsSameBrowser(browser) then ShowStatusText(value);
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.Chromium1TitleChange(Sender: TObject;
|
|
const browser: ICefBrowser; const title: ustring);
|
|
begin
|
|
if not(Chromium1.IsSameBrowser(browser)) then exit;
|
|
|
|
if (title <> '') then
|
|
caption := 'MiniBrowser - ' + title
|
|
else
|
|
caption := 'MiniBrowser';
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
begin
|
|
CanClose := FCanClose;
|
|
|
|
if not(FClosing) then
|
|
begin
|
|
FClosing := True;
|
|
Visible := False;
|
|
|
|
// if TChromium.MultiBrowserMode is enabled then we have to close all
|
|
// stored browsers and not only the main browser.
|
|
Chromium1.CloseAllBrowsers;
|
|
|
|
// Workaround for the missing TChormium.OnClose event when "Chrome runtime" is enabled.
|
|
if GlobalCEFApp.ChromeRuntime then
|
|
CEFWindowParent1.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.FormCreate(Sender: TObject);
|
|
begin
|
|
FCanClose := False;
|
|
FClosing := False;
|
|
|
|
// The MultiBrowserMode store all the browser references in TChromium.
|
|
// The first browser reference is the browser in the main form.
|
|
// When MiniBrowser allows CEF to create child popup browsers it will also
|
|
// store their reference inside TChromium and you can use all the TChromium's
|
|
// methods and properties to manipulate those browsers.
|
|
// To do that call TChromium.SelectBrowser with the browser ID that will be
|
|
// used when you call any method or property in TChromium.
|
|
Chromium1.MultiBrowserMode := True;
|
|
Chromium1.DefaultURL := MINIBROWSER_HOMEPAGE;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.FormShow(Sender: TObject);
|
|
begin
|
|
ShowStatusText('Initializing browser. Please wait...');
|
|
|
|
// 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 TMiniBrowserFrm.Timer1Timer(Sender: TObject);
|
|
begin
|
|
Timer1.Enabled := False;
|
|
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) and not(Chromium1.Initialized) then
|
|
Timer1.Enabled := True;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.AddURL(const aURL : string);
|
|
begin
|
|
if (URLCbx.Items.IndexOf(aURL) < 0) then
|
|
URLCbx.Items.Add(aURL);
|
|
|
|
URLCbx.Text := aURL;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.BrowserCreatedMsg(var aMessage : TMessage);
|
|
begin
|
|
CEFWindowParent1.UpdateSize;
|
|
NavControlPnl.Enabled := True;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.BrowserDestroyMsg(var aMessage : TMessage);
|
|
begin
|
|
FreeAndNil(CEFWindowParent1);
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.WMMove(var aMessage : TWMMove);
|
|
begin
|
|
inherited;
|
|
|
|
if (Chromium1 <> nil) then
|
|
Chromium1.NotifyMoveOrResizeStarted;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.WMMoving(var aMessage : TMessage);
|
|
begin
|
|
inherited;
|
|
|
|
if (Chromium1 <> nil) then
|
|
Chromium1.NotifyMoveOrResizeStarted;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.WMEnterMenuLoop(var aMessage: TMessage);
|
|
begin
|
|
inherited;
|
|
|
|
if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then
|
|
GlobalCEFApp.OsmodalLoop := True;
|
|
end;
|
|
|
|
procedure TMiniBrowserFrm.WMExitMenuLoop(var aMessage: TMessage);
|
|
begin
|
|
inherited;
|
|
|
|
if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then
|
|
GlobalCEFApp.OsmodalLoop := False;
|
|
end;
|
|
|
|
end.
|