1
0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-06-12 22:07:39 +02:00
Files
.github
bin
demos
Delphi_FMX_Linux
Delphi_FMX_Windows
Delphi_VCL
ConsoleBrowser
ConsoleBrowser2
00-DeleteDCUs.bat
ConsoleBrowser2.dpr
ConsoleBrowser2.dproj
ConsoleBrowser2Grp.groupproj
ConsoleBrowser2_sp.dpr
ConsoleBrowser2_sp.dproj
cef.inc
uCEFBrowserThread.pas
uEncapsulatedBrowser.pas
CookieVisitor
CustomResourceBrowser
DLLBrowser
DOMVisitor
EditorBrowser
Extensions
ExternalPumpBrowser
FullScreenBrowser
JavaScript
KioskOSRBrowser
MDIBrowser
MDIExternalPumpBrowser
MediaRouter
MiniBrowser
OAuth2Tester
OSRExternalPumpBrowser
PopupBrowser
PopupBrowser2
PostInspectorBrowser
ResponseFilterBrowser
SchemeRegistrationBrowser
SimpleBrowser
SimpleBrowser2
SimpleExternalPumpBrowser
SimpleOSRBrowser
SimpleServer
SubProcess
TabbedBrowser
TabbedBrowser2
TinyBrowser
TinyBrowser2
ToolBoxBrowser
ToolBoxBrowser2
ToolBoxSubProcessBrowser
URLRequest
WebpageSnapshot
Lazarus_Linux
Lazarus_Mac
Lazarus_Windows
packages
source
tools
.gitignore
Delphinus.Info.json
Delphinus.Install.json
LICENSE.md
README.md
update_CEF4Delphi.json
CEF4Delphi/demos/Delphi_VCL/ConsoleBrowser2/uEncapsulatedBrowser.pas

242 lines
7.5 KiB
ObjectPascal
Raw Normal View History

// ************************************************************************
// ***************************** 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
//
2021-01-01 11:11:30 +01:00
// 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 uEncapsulatedBrowser;
{$I cef.inc}
interface
uses
{$IFDEF DELPHI16_UP}
System.SyncObjs, System.SysUtils,
{$ELSE}
SyncObjs, SysUtils,
{$ENDIF}
uCEFTypes, uCEFBrowserThread;
type
TEncapsulatedBrowser = class
protected
FThread : TCEFBrowserThread;
FWidth : integer;
FHeight : integer;
FDelayMs : integer;
FScale : single;
FSnapshotPath : ustring;
FErrorText : ustring;
procedure Thread_OnError(Sender: TObject);
procedure Thread_OnSnapshotAvailable(Sender: TObject);
public
constructor Create;
destructor Destroy; override;
procedure LoadURL(const aURL : ustring);
property Width : integer read FWidth write FWidth;
property Height : integer read FHeight write FHeight;
property DelayMs : integer read FDelayMs write FDelayMs;
property Scale : single read FScale write FScale;
property SnapshotPath : ustring read FSnapshotPath write FSnapshotPath;
property ErrorText : ustring read FErrorText;
end;
procedure CreateGlobalCEFApp;
function WaitForMainAppEvent : boolean;
procedure WriteResult;
implementation
uses
uCEFApplication;
var
MainAppEvent : TEvent;
EncapsulatedBrowser : TEncapsulatedBrowser = nil;
procedure GlobalCEFApp_OnContextInitialized;
var
TempParam, TempURL : ustring;
begin
TempURL := '';
// This demo reads the "/url" parameter to load it as the default URL in the browser.
// For example : ConsoleBrowser2.exe /url=https://www.briskbard.com
if (ParamCount > 0) then
begin
TempParam := paramstr(1);
if (Copy(TempParam, 1, 5) = '/url=') then
begin
TempURL := trim(Copy(TempParam, 6, length(TempParam)));
if (length(TempURL) > 0) then WriteLn('Loading ' + TempURL);
end;
end;
if (length(TempURL) = 0) then
begin
TempURL := 'https://www.google.com';
WriteLn('No URL has been specified. Using the default...');
end;
EncapsulatedBrowser := TEncapsulatedBrowser.Create;
EncapsulatedBrowser.LoadURL(TempURL);
end;
function WaitForMainAppEvent : boolean;
begin
Result := True;
// Wait for 1 minute max.
if (MainAppEvent.WaitFor(60000) = wrTimeout) then
begin
WriteLn('Timeout expired!');
Result := False;
end;
end;
procedure WriteResult;
begin
if (EncapsulatedBrowser = nil) then
WriteLn('There was a problem in the browser initialization')
else
if (length(EncapsulatedBrowser.ErrorText) > 0) then
WriteLn(EncapsulatedBrowser.ErrorText)
else
WriteLn('Snapshot saved successfully as ' + EncapsulatedBrowser.SnapshotPath);
end;
procedure CreateGlobalCEFApp;
begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
GlobalCEFApp.ShowMessageDlg := False; // This demo shouldn't show any window, just console messages.
GlobalCEFApp.BrowserSubprocessPath := 'ConsoleBrowser2_sp.exe'; // This is the other EXE for the CEF subprocesses. It's on the same directory as this app.
GlobalCEFApp.BlinkSettings := 'hideScrollbars'; // This setting removes all scrollbars to capture a cleaner snapshot
GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized;
{
// In case you use a custom directory for the CEF binaries you have to set these properties
// here and in the subprocess
GlobalCEFApp.FrameworkDirPath := 'c:\cef';
GlobalCEFApp.ResourcesDirPath := 'c:\cef';
GlobalCEFApp.LocalesDirPath := 'c:\cef\locales';
GlobalCEFApp.SetCurrentDir := True;
}
GlobalCEFApp.StartMainProcess;
end;
constructor TEncapsulatedBrowser.Create;
begin
inherited Create;
FThread := nil;
FWidth := 1024;
FHeight := 768;
FDelayMs := 500;
FScale := 1; // This is the relative scale to a 96 DPI screen. It's calculated with the formula : scale = custom_DPI / 96
FSnapshotPath := 'snapshot.bmp';
FErrorText := '';
end;
destructor TEncapsulatedBrowser.Destroy;
begin
if (FThread <> nil) then
begin
if FThread.TerminateBrowserThread then
FThread.WaitFor;
FreeAndNil(FThread);
end;
inherited Destroy;
end;
procedure TEncapsulatedBrowser.LoadURL(const aURL : ustring);
begin
if (FThread = nil) then
begin
FThread := TCEFBrowserThread.Create(aURL, FWidth, FHeight, FDelayMs, FScale);
FThread.OnError := Thread_OnError;
FThread.OnSnapshotAvailable := Thread_OnSnapshotAvailable;
FThread.Start;
end
else
FThread.LoadUrl(aURL);
end;
procedure TEncapsulatedBrowser.Thread_OnError(Sender: TObject);
begin
// This code is executed in the TCEFBrowserThread thread context while the main application thread is waiting for MainAppEvent.
FErrorText := 'Error';
if (FThread.ErrorCode <> 0) then
FErrorText := FErrorText + ' ' + inttostr(FThread.ErrorCode);
FErrorText := FErrorText + ' : ' + FThread.ErrorText;
if (length(FThread.FailedUrl) > 0) then
FErrorText := FErrorText + ' - ' + FThread.FailedUrl;
if assigned(MainAppEvent) then
MainAppEvent.SetEvent;
end;
procedure TEncapsulatedBrowser.Thread_OnSnapshotAvailable(Sender: TObject);
begin
// This code is executed in the TCEFBrowserThread thread context while the main application thread is waiting for MainAppEvent.
if (FThread = nil) or not(FThread.SaveSnapshotToFile(FSnapshotPath)) then
FErrorText := 'There was an error copying the snapshot';
if assigned(MainAppEvent) then
MainAppEvent.SetEvent;
end;
initialization
MainAppEvent := TEvent.Create;
finalization
MainAppEvent.Free;
if (EncapsulatedBrowser <> nil) then FreeAndNil(EncapsulatedBrowser);
end.