mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2024-11-24 08:02:15 +02:00
Added the ConsoleBrowser demo for Linux
This commit is contained in:
Salvador Díaz Fau
parent
efad8d654b
commit
0c117497c3
2
demos/Lazarus_Linux_Console/ConsoleBrowser/00-Delete.bat
Normal file
2
demos/Lazarus_Linux_Console/ConsoleBrowser/00-Delete.bat
Normal file
@ -0,0 +1,2 @@
|
||||
rmdir /S /Q lib
|
||||
rmdir /S /Q backup
|
||||
@ -0,0 +1,93 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="ConsoleBrowser"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<MacroValues Count="1">
|
||||
<Macro2 Name="LCLWidgetType" Value="gtk3"/>
|
||||
</MacroValues>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
<SharedMatrixOptions Count="2">
|
||||
<Item1 ID="459818913724"/>
|
||||
<Item2 ID="286517618039" Modes="Default" Type="IDEMacro" MacroName="LCLWidgetType" Value="gtk3"/>
|
||||
</SharedMatrixOptions>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<RequiredPackages>
|
||||
<Item>
|
||||
<PackageName Value="CEF4Delphi_Lazarus"/>
|
||||
</Item>
|
||||
</RequiredPackages>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="consolebrowser.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="ucustommessage.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="uencapsulatedbrowser.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="uworkerthread.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="ucefbrowserthread.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="interfaces.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="../../../bin/consolebrowser"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
@ -0,0 +1,33 @@
|
||||
program consolebrowser;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
cthreads,
|
||||
{$ENDIF}
|
||||
// "Interfaces" is a custom unit used to initialize the LCL WidgetSet
|
||||
// We keep the same name to avoid a Lazarus warning.
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Classes, SysUtils, uCEFApplication, uencapsulatedbrowser;
|
||||
|
||||
begin
|
||||
try
|
||||
try
|
||||
CreateGlobalCEFApp;
|
||||
|
||||
// The LCL Widgetset must be initialized after the CEF initialization
|
||||
CustomWidgetSetInitialization;
|
||||
|
||||
if WaitForMainAppEvent then
|
||||
WriteResult;
|
||||
except
|
||||
on E: Exception do
|
||||
Writeln(E.ClassName, ': ', E.Message);
|
||||
end;
|
||||
finally
|
||||
CustomWidgetSetFinalization;
|
||||
DestroyGlobalCEFApp;
|
||||
end;
|
||||
end.
|
||||
|
||||
@ -0,0 +1,66 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="ConsoleBrowser"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<RequiredPackages>
|
||||
<Item>
|
||||
<PackageName Value="CEF4Delphi_Lazarus"/>
|
||||
</Item>
|
||||
</RequiredPackages>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="consolebrowser_sp.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="../../../bin/consolebrowser_sp"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
@ -0,0 +1,20 @@
|
||||
program consolebrowser_sp;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
cthreads,
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, uCEFApplicationCore;
|
||||
|
||||
begin
|
||||
GlobalCEFApp := TCefApplicationCore.Create;
|
||||
GlobalCEFApp.WindowlessRenderingEnabled := True;
|
||||
GlobalCEFApp.ShowMessageDlg := False;
|
||||
GlobalCEFApp.BlinkSettings := 'hideScrollbars';
|
||||
GlobalCEFApp.SetCurrentDir := True;
|
||||
GlobalCEFApp.StartSubProcess;
|
||||
DestroyGlobalCEFApp;
|
||||
end.
|
||||
|
||||
68
demos/Lazarus_Linux_Console/ConsoleBrowser/interfaces.pas
Normal file
68
demos/Lazarus_Linux_Console/ConsoleBrowser/interfaces.pas
Normal file
@ -0,0 +1,68 @@
|
||||
{
|
||||
/***************************************************************************
|
||||
Interfaces.pp - determines what interface to use
|
||||
-------------------
|
||||
|
||||
Initial Revision : Thu July 1st CST 1999
|
||||
|
||||
|
||||
***************************************************************************/
|
||||
|
||||
*****************************************************************************
|
||||
This file is part of the Lazarus Component Library (LCL)
|
||||
|
||||
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
||||
for details about the license.
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
unit interfaces;
|
||||
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFNDEF DisableCWString}cwstring,{$ENDIF}{$ENDIF}
|
||||
InterfaceBase;
|
||||
|
||||
procedure CustomWidgetSetInitialization;
|
||||
procedure CustomWidgetSetFinalization;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
gtk3int, Forms, xlib,
|
||||
uCEFLinuxFunctions;
|
||||
|
||||
function CustomX11ErrorHandler(Display:PDisplay; ErrorEv:PXErrorEvent):longint;cdecl;
|
||||
begin
|
||||
{$IFDEF DEBUG}
|
||||
XError := ErrorEv^.error_code;
|
||||
WriteLn('Error: ' + IntToStr(XError));
|
||||
{$ENDIF}
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function CustomXIOErrorHandler(Display:PDisplay):longint;cdecl;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
procedure CustomWidgetSetInitialization;
|
||||
begin
|
||||
//gdk_set_allowed_backends('X11');
|
||||
CreateWidgetset(TGtk3WidgetSet);
|
||||
// Install xlib error handlers so that the application won't be terminated
|
||||
// on non-fatal errors. Must be done after initializing GTK.
|
||||
XSetErrorHandler(@CustomX11ErrorHandler);
|
||||
XSetIOErrorHandler(@CustomXIOErrorHandler);
|
||||
end;
|
||||
|
||||
procedure CustomWidgetSetFinalization;
|
||||
begin
|
||||
FreeWidgetSet;
|
||||
end;
|
||||
|
||||
end.
|
||||
443
demos/Lazarus_Linux_Console/ConsoleBrowser/ucefbrowserthread.pas
Normal file
443
demos/Lazarus_Linux_Console/ConsoleBrowser/ucefbrowserthread.pas
Normal file
@ -0,0 +1,443 @@
|
||||
unit ucefbrowserthread;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, SyncObjs,
|
||||
uworkerthread, ucustommessage,
|
||||
uCEFChromium, uCEFTypes, uCEFInterfaces, uCEFConstants, uCEFBufferPanel,
|
||||
uCEFChromiumCore, uCEFMiscFunctions;
|
||||
|
||||
type
|
||||
TThreadStatus = (tsInitializing, tsIdle, tsLoading, tsClosing, tsDestroyed, tsInitError);
|
||||
|
||||
TSize = record
|
||||
cx : integer;
|
||||
cy : integer;
|
||||
end;
|
||||
|
||||
TCEFBrowserThread = class(TWorkerThread)
|
||||
protected
|
||||
FBrowser : TChromium;
|
||||
FStatus : TThreadStatus;
|
||||
FBrowserSize : TSize;
|
||||
FBrowserCS : TCriticalSection;
|
||||
FErrorCode : integer;
|
||||
FErrorText : string;
|
||||
FFailedURL : string;
|
||||
FDefaultURL : string;
|
||||
FFileName : string;
|
||||
FMessageID : integer;
|
||||
FOnInitialized : TNotifyEvent;
|
||||
FOnSnapshotAvailable : TNotifyEvent;
|
||||
FOnError : TNotifyEvent;
|
||||
|
||||
function GetErrorCode : integer;
|
||||
function GetErrorText : string;
|
||||
function GetFailedURL : string;
|
||||
function GetInitialized : boolean;
|
||||
function GetClosing : boolean;
|
||||
function GetStatus : TThreadStatus;
|
||||
function GetFileName : string;
|
||||
|
||||
procedure SetErrorText(const aValue : string);
|
||||
procedure SetFileName(const aValue : string);
|
||||
procedure SetStatus(aValue : TThreadStatus);
|
||||
|
||||
procedure Browser_OnAfterCreated(Sender: TObject; const browser: ICefBrowser);
|
||||
procedure Browser_OnGetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect);
|
||||
procedure Browser_OnGetScreenInfo(Sender: TObject; const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out Result: Boolean);
|
||||
procedure Browser_OnBeforePopup(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 Browser_OnBeforeClose(Sender: TObject; const browser: ICefBrowser);
|
||||
procedure Browser_OnLoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring);
|
||||
procedure Browser_OnLoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
|
||||
procedure Browser_OnDevToolsMethodResult(Sender: TObject; const browser: ICefBrowser; message_id: Integer; success: Boolean; const result: ICefValue);
|
||||
procedure Browser_OnOpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; out Result: Boolean);
|
||||
|
||||
procedure DoOnInitialized;
|
||||
procedure DoOnError;
|
||||
procedure DoOnSnapshotAvailable;
|
||||
|
||||
procedure ProcessValue(const aInfo : TMsgInfo); override;
|
||||
procedure DoLoadURL(const aURL : string);
|
||||
function CreateBrowser : boolean;
|
||||
procedure CloseBrowser;
|
||||
procedure InitError;
|
||||
procedure Execute; override;
|
||||
|
||||
public
|
||||
constructor Create(aWidth, aHeight : integer; const aDefaultURL, aFileName : string);
|
||||
destructor Destroy; override;
|
||||
procedure AfterConstruction; override;
|
||||
procedure TerminateBrowserThread;
|
||||
procedure LoadURL(const aURL : string);
|
||||
|
||||
property ErrorCode : integer read GetErrorCode;
|
||||
property ErrorText : string read GetErrorText write SetErrorText;
|
||||
property FailedUrl : string read GetFailedUrl;
|
||||
property Initialized : boolean read GetInitialized;
|
||||
property Closing : boolean read GetClosing;
|
||||
property Status : TThreadStatus read GetStatus write SetStatus;
|
||||
property FileName : string read GetFileName write SetFileName;
|
||||
|
||||
property OnInitialized : TNotifyEvent read FOnInitialized write FOnInitialized;
|
||||
property OnSnapshotAvailable : TNotifyEvent read FOnSnapshotAvailable write FOnSnapshotAvailable;
|
||||
property OnError : TNotifyEvent read FOnError write FOnError;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uCEFDictionaryValue, uCEFJson;
|
||||
|
||||
const
|
||||
WORKERTHREADMSG_LOADURL = WORKERTHREADMSG_QUIT + 1;
|
||||
WORKERTHREADMSG_DOONERROR = WORKERTHREADMSG_QUIT + 2;
|
||||
WORKERTHREADMSG_CLOSEBROWSER = WORKERTHREADMSG_QUIT + 3;
|
||||
|
||||
constructor TCEFBrowserThread.Create(aWidth, aHeight : integer; const aDefaultURL, aFileName : string);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FStatus := tsInitializing;
|
||||
FBrowser := nil;
|
||||
FBrowserSize.cx := aWidth;
|
||||
FBrowserSize.cy := aHeight;
|
||||
FDefaultURL := aDefaultURL;
|
||||
FFileName := aFileName;
|
||||
FBrowserCS := nil;
|
||||
FMessageID := -1;
|
||||
FOnInitialized := nil;
|
||||
FOnSnapshotAvailable := nil;
|
||||
FOnError := nil;
|
||||
end;
|
||||
|
||||
destructor TCEFBrowserThread.Destroy;
|
||||
begin
|
||||
if (FBrowser <> nil) then
|
||||
FreeAndNil(FBrowser);
|
||||
|
||||
if (FBrowserCS <> nil) then
|
||||
FreeAndNil(FBrowserCS);
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.AfterConstruction;
|
||||
begin
|
||||
inherited AfterConstruction;
|
||||
|
||||
FBrowserCS := TCriticalSection.Create;
|
||||
|
||||
FBrowser := TChromium.Create(nil);
|
||||
FBrowser.DefaultURL := FDefaultURL;
|
||||
FBrowser.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF);
|
||||
FBrowser.OnAfterCreated := @Browser_OnAfterCreated;
|
||||
FBrowser.OnGetViewRect := @Browser_OnGetViewRect;
|
||||
FBrowser.OnGetScreenInfo := @Browser_OnGetScreenInfo;
|
||||
FBrowser.OnBeforePopup := @Browser_OnBeforePopup;
|
||||
FBrowser.OnBeforeClose := @Browser_OnBeforeClose;
|
||||
FBrowser.OnLoadError := @Browser_OnLoadError;
|
||||
FBrowser.OnLoadingStateChange := @Browser_OnLoadingStateChange;
|
||||
FBrowser.OnOpenUrlFromTab := @Browser_OnOpenUrlFromTab;
|
||||
FBrowser.OnDevToolsMethodResult := @Browser_OnDevToolsMethodResult;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.TerminateBrowserThread;
|
||||
begin
|
||||
Terminate;
|
||||
EnqueueMessage(WORKERTHREADMSG_CLOSEBROWSER);
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.LoadURL(const aURL : string);
|
||||
begin
|
||||
EnqueueMessage(WORKERTHREADMSG_LOADURL, 0, aURL);
|
||||
end;
|
||||
|
||||
function TCEFBrowserThread.GetErrorCode : integer;
|
||||
begin
|
||||
FBrowserCS.Acquire;
|
||||
Result := FErrorCode;
|
||||
FBrowserCS.Release;
|
||||
end;
|
||||
|
||||
function TCEFBrowserThread.GetErrorText : string;
|
||||
begin
|
||||
FBrowserCS.Acquire;
|
||||
Result := FErrorText;
|
||||
FBrowserCS.Release;
|
||||
end;
|
||||
|
||||
function TCEFBrowserThread.GetFailedURL : string;
|
||||
begin
|
||||
FBrowserCS.Acquire;
|
||||
Result := FFailedURL;
|
||||
FBrowserCS.Release;
|
||||
end;
|
||||
|
||||
function TCEFBrowserThread.GetInitialized : boolean;
|
||||
begin
|
||||
FBrowserCS.Acquire;
|
||||
Result := not(Terminated) and (FStatus in [tsIdle, tsLoading]);
|
||||
FBrowserCS.Release;
|
||||
end;
|
||||
|
||||
function TCEFBrowserThread.GetClosing : boolean;
|
||||
begin
|
||||
FBrowserCS.Acquire;
|
||||
Result := (FStatus = tsClosing);
|
||||
FBrowserCS.Release;
|
||||
end;
|
||||
|
||||
function TCEFBrowserThread.GetStatus : TThreadStatus;
|
||||
begin
|
||||
FBrowserCS.Acquire;
|
||||
Result := FStatus;
|
||||
FBrowserCS.Release;
|
||||
end;
|
||||
|
||||
function TCEFBrowserThread.GetFileName : string;
|
||||
begin
|
||||
FBrowserCS.Acquire;
|
||||
Result := FFileName;
|
||||
FBrowserCS.Release;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.SetErrorText(const aValue : string);
|
||||
begin
|
||||
FBrowserCS.Acquire;
|
||||
FErrorText := aValue;
|
||||
FBrowserCS.Release;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.SetFileName(const aValue : string);
|
||||
begin
|
||||
FBrowserCS.Acquire;
|
||||
FFileName := aValue;
|
||||
FBrowserCS.Release;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.SetStatus(aValue : TThreadStatus);
|
||||
begin
|
||||
FBrowserCS.Acquire;
|
||||
FStatus := aValue;
|
||||
FBrowserCS.Release;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.DoOnInitialized;
|
||||
begin
|
||||
if assigned(FOnInitialized) then
|
||||
FOnInitialized(self);
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.DoOnError;
|
||||
begin
|
||||
if assigned(FOnError) then
|
||||
FOnError(self);
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.DoOnSnapshotAvailable;
|
||||
begin
|
||||
if assigned(FOnSnapshotAvailable) then
|
||||
FOnSnapshotAvailable(self);
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.Browser_OnAfterCreated(Sender: TObject;
|
||||
const browser: ICefBrowser);
|
||||
begin
|
||||
Status := tsIdle;
|
||||
DoOnInitialized;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.Browser_OnGetViewRect(Sender: TObject;
|
||||
const browser: ICefBrowser; var rect: TCefRect);
|
||||
begin
|
||||
rect.x := 0;
|
||||
rect.y := 0;
|
||||
rect.width := FBrowserSize.cx;
|
||||
rect.height := FBrowserSize.cy;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.Browser_OnGetScreenInfo(Sender: TObject;
|
||||
const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out Result: Boolean);
|
||||
var
|
||||
TempRect : TCEFRect;
|
||||
begin
|
||||
TempRect.x := 0;
|
||||
TempRect.y := 0;
|
||||
TempRect.width := FBrowserSize.cx;
|
||||
TempRect.height := FBrowserSize.cy;
|
||||
|
||||
screenInfo.device_scale_factor := 1;
|
||||
screenInfo.depth := 0;
|
||||
screenInfo.depth_per_component := 0;
|
||||
screenInfo.is_monochrome := Ord(False);
|
||||
screenInfo.rect := TempRect;
|
||||
screenInfo.available_rect := TempRect;
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.Browser_OnBeforePopup(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
|
||||
Result := (targetDisposition in [CEF_WOD_NEW_FOREGROUND_TAB,
|
||||
CEF_WOD_NEW_BACKGROUND_TAB,
|
||||
CEF_WOD_NEW_POPUP,
|
||||
CEF_WOD_NEW_WINDOW]);
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.Browser_OnBeforeClose(Sender: TObject; const browser: ICefBrowser);
|
||||
begin
|
||||
Status := tsDestroyed;
|
||||
EnqueueMessage(WORKERTHREADMSG_QUIT);
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.Browser_OnLoadError(Sender: TObject;
|
||||
const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer;
|
||||
const errorText, failedUrl: ustring);
|
||||
begin
|
||||
if not(Terminated) and (frame <> nil) and frame.IsValid and frame.IsMain then
|
||||
try
|
||||
FBrowserCS.Acquire;
|
||||
FErrorCode := errorCode;
|
||||
FErrorText := errorText;
|
||||
FFailedUrl := failedUrl;
|
||||
finally
|
||||
FBrowserCS.Release;
|
||||
EnqueueMessage(WORKERTHREADMSG_DOONERROR);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.Browser_OnLoadingStateChange(Sender: TObject;
|
||||
const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
|
||||
var
|
||||
TempParams : ICefDictionaryValue;
|
||||
begin
|
||||
if isLoading then
|
||||
Status := tsLoading
|
||||
else
|
||||
begin
|
||||
Status := tsIdle;
|
||||
TempParams := TCefDictionaryValueRef.New;
|
||||
TempParams.SetString('format', 'png');
|
||||
FMessageID := FBrowser.ExecuteDevToolsMethod(0, 'Page.captureScreenshot', TempParams);
|
||||
TempParams := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.Browser_OnDevToolsMethodResult(Sender: TObject;
|
||||
const browser: ICefBrowser; message_id: Integer; success: Boolean;
|
||||
const result: ICefValue);
|
||||
var
|
||||
TempRsltDict : ICefDictionaryValue;
|
||||
TempString : ustring;
|
||||
TempBin : ICefBinaryValue;
|
||||
TempStream : TFileStream;
|
||||
TempSuccess : boolean;
|
||||
begin
|
||||
if not(success) or (FMessageID <> message_id) or not(assigned(result)) then exit;
|
||||
|
||||
TempSuccess := False;
|
||||
TempStream := nil;
|
||||
TempRsltDict := result.GetDictionary;
|
||||
|
||||
if assigned(TempRsltDict) then
|
||||
try
|
||||
if TCEFJson.ReadString(TempRsltDict, 'data', TempString) then
|
||||
try
|
||||
TempBin := CefBase64Decode(TempString);
|
||||
|
||||
if assigned(TempBin) and (TempBin.Size > 0) then
|
||||
try
|
||||
try
|
||||
TempStream := TFileStream.Create(FileName, fmCreate);
|
||||
TempStream.WriteBuffer(TempBin.GetRawData^, TempBin.Size);
|
||||
TempSuccess := True;
|
||||
except
|
||||
on e : exception do
|
||||
if CustomExceptionHandler('TCEFBrowserThread.Browser_OnDevToolsMethodResult', e) then raise;
|
||||
end;
|
||||
finally
|
||||
if assigned(TempStream) then
|
||||
FreeAndNil(TempStream);
|
||||
end;
|
||||
finally
|
||||
TempBin := nil;
|
||||
end;
|
||||
finally
|
||||
TempRsltDict := nil;
|
||||
if TempSuccess then DoOnSnapshotAvailable;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.Browser_OnOpenUrlFromTab(Sender: TObject;
|
||||
const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring;
|
||||
targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean;
|
||||
out Result: Boolean);
|
||||
begin
|
||||
Result := (targetDisposition in [CEF_WOD_NEW_FOREGROUND_TAB,
|
||||
CEF_WOD_NEW_BACKGROUND_TAB,
|
||||
CEF_WOD_NEW_POPUP,
|
||||
CEF_WOD_NEW_WINDOW]);
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.ProcessValue(const aInfo : TMsgInfo);
|
||||
begin
|
||||
case aInfo.Msg of
|
||||
WORKERTHREADMSG_LOADURL : DoLoadURL(aInfo.StrParam);
|
||||
WORKERTHREADMSG_DOONERROR : DoOnError;
|
||||
WORKERTHREADMSG_CLOSEBROWSER : CloseBrowser;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCEFBrowserThread.CreateBrowser : boolean;
|
||||
begin
|
||||
Result := assigned(FBrowser) and FBrowser.CreateBrowser;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.DoLoadURL(const aURL : string);
|
||||
begin
|
||||
if not(Terminated) and Initialized and assigned(FBrowser) then
|
||||
FBrowser.LoadURL(aURL);
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.CloseBrowser;
|
||||
begin
|
||||
if Initialized then
|
||||
begin
|
||||
if assigned(FBrowser) then
|
||||
begin
|
||||
Status := tsClosing;
|
||||
FBrowser.CloseBrowser(True);
|
||||
end;
|
||||
end
|
||||
else
|
||||
if not(Closing) then
|
||||
EnqueueMessage(WORKERTHREADMSG_QUIT);
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.InitError;
|
||||
begin
|
||||
Status := tsInitError;
|
||||
ErrorText := 'There was an error initializing the CEF browser.';
|
||||
DoOnError;
|
||||
end;
|
||||
|
||||
procedure TCEFBrowserThread.Execute;
|
||||
begin
|
||||
if CreateBrowser then
|
||||
inherited Execute
|
||||
else
|
||||
InitError;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -0,0 +1,37 @@
|
||||
unit ucustommessage;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
TMsgInfo = record
|
||||
Msg : integer;
|
||||
StrParam : string;
|
||||
IntParam : integer;
|
||||
end;
|
||||
|
||||
TCustomMessage = class
|
||||
protected
|
||||
FValue : TMsgInfo;
|
||||
|
||||
public
|
||||
constructor Create(const aValue : TMsgInfo);
|
||||
|
||||
property Value : TMsgInfo read FValue;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TCustomMessage.Create(const aValue : TMsgInfo);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FValue := aValue;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -0,0 +1,182 @@
|
||||
unit uencapsulatedbrowser;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SyncObjs, SysUtils,
|
||||
uCEFTypes, ucefbrowserthread;
|
||||
|
||||
type
|
||||
TEncapsulatedBrowser = class
|
||||
protected
|
||||
FThread : TCEFBrowserThread;
|
||||
FWidth : integer;
|
||||
FHeight : integer;
|
||||
FDelayMs : integer;
|
||||
FScale : single;
|
||||
FSnapshotPath : string;
|
||||
FErrorText : string;
|
||||
|
||||
procedure Thread_OnError(Sender: TObject);
|
||||
procedure Thread_OnSnapshotAvailable(Sender: TObject);
|
||||
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure LoadURL(const aURL : string);
|
||||
|
||||
property Width : integer read FWidth write FWidth;
|
||||
property Height : integer read FHeight write FHeight;
|
||||
property SnapshotPath : string read FSnapshotPath write FSnapshotPath;
|
||||
property ErrorText : string read FErrorText;
|
||||
end;
|
||||
|
||||
procedure CreateGlobalCEFApp;
|
||||
function WaitForMainAppEvent : boolean;
|
||||
procedure WriteResult;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uCEFApplication;
|
||||
|
||||
var
|
||||
MainAppEvent : TSimpleEvent;
|
||||
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.ShowMessageDlg := False; // This demo shouldn't show any window, just console messages.
|
||||
GlobalCEFApp.BrowserSubprocessPath := 'consolebrowser_sp'; // 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;
|
||||
GlobalCEFApp.SetCurrentDir := True;
|
||||
GlobalCEFApp.DisableZygote := True;
|
||||
GlobalCEFApp.StartMainProcess;
|
||||
end;
|
||||
|
||||
constructor TEncapsulatedBrowser.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FThread := nil;
|
||||
FWidth := 1024;
|
||||
FHeight := 768;
|
||||
FSnapshotPath := 'snapshot.png';
|
||||
FErrorText := '';
|
||||
end;
|
||||
|
||||
destructor TEncapsulatedBrowser.Destroy;
|
||||
begin
|
||||
if (FThread <> nil) then
|
||||
begin
|
||||
FThread.TerminateBrowserThread;
|
||||
FThread.WaitFor;
|
||||
FreeAndNil(FThread);
|
||||
end;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TEncapsulatedBrowser.LoadURL(const aURL : string);
|
||||
begin
|
||||
if (FThread = nil) then
|
||||
begin
|
||||
FThread := TCEFBrowserThread.Create(FWidth, FHeight, aURL, FSnapshotPath);
|
||||
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 assigned(MainAppEvent) then
|
||||
MainAppEvent.SetEvent;
|
||||
end;
|
||||
|
||||
initialization
|
||||
MainAppEvent := TSimpleEvent.Create;
|
||||
|
||||
finalization
|
||||
MainAppEvent.Free;
|
||||
if (EncapsulatedBrowser <> nil) then FreeAndNil(EncapsulatedBrowser);
|
||||
|
||||
end.
|
||||
210
demos/Lazarus_Linux_Console/ConsoleBrowser/uworkerthread.pas
Normal file
210
demos/Lazarus_Linux_Console/ConsoleBrowser/uworkerthread.pas
Normal file
@ -0,0 +1,210 @@
|
||||
unit uworkerthread;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, SyncObjs, Contnrs,
|
||||
ucustommessage;
|
||||
|
||||
const
|
||||
WORKERTHREADMSG_QUIT = 1;
|
||||
|
||||
type
|
||||
TWorkerThread = class(TThread)
|
||||
protected
|
||||
FCritSect : TCriticalSection;
|
||||
FEvent : TEvent;
|
||||
FWaiting : boolean;
|
||||
FStop : boolean;
|
||||
FMsgQueue : TObjectQueue;
|
||||
|
||||
function Lock : boolean;
|
||||
procedure Unlock;
|
||||
function CanContinue : boolean;
|
||||
procedure ReadAllPendingMessages;
|
||||
procedure ProcessValue(const aInfo : TMsgInfo); virtual;
|
||||
function ReadPendingMessage(var aMsgInfo : TMsgInfo) : boolean;
|
||||
procedure StopThread;
|
||||
procedure DestroyQueue;
|
||||
procedure EnqueueMessage(const aMsgInfo : TMsgInfo); overload;
|
||||
procedure EnqueueMessage(aMsg: integer; aIntParam : integer = 0; const aStrParam : string = ''); overload;
|
||||
|
||||
procedure Execute; override;
|
||||
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure AfterConstruction; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
constructor TWorkerThread.Create;
|
||||
begin
|
||||
FCritSect := nil;
|
||||
FWaiting := False;
|
||||
FStop := False;
|
||||
FEvent := nil;
|
||||
FMsgQueue := nil;
|
||||
|
||||
inherited Create(True);
|
||||
|
||||
FreeOnTerminate := False;
|
||||
end;
|
||||
|
||||
destructor TWorkerThread.Destroy;
|
||||
begin
|
||||
if (FEvent <> nil) then FreeAndNil(FEvent);
|
||||
if (FCritSect <> nil) then FreeAndNil(FCritSect);
|
||||
|
||||
DestroyQueue;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TWorkerThread.DestroyQueue;
|
||||
begin
|
||||
if (FMsgQueue <> nil) then
|
||||
begin
|
||||
while (FMsgQueue.Count > 0) do
|
||||
FMsgQueue.Pop.Free;
|
||||
|
||||
FreeAndNil(FMsgQueue);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWorkerThread.AfterConstruction;
|
||||
begin
|
||||
inherited AfterConstruction;
|
||||
|
||||
FEvent := TEvent.Create(nil, False, False, '');
|
||||
FCritSect := TCriticalSection.Create;
|
||||
FMsgQueue := TObjectQueue.Create;
|
||||
end;
|
||||
|
||||
function TWorkerThread.Lock : boolean;
|
||||
begin
|
||||
if (FCritSect <> nil) then
|
||||
begin
|
||||
FCritSect.Acquire;
|
||||
Result := True;
|
||||
end
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TWorkerThread.Unlock;
|
||||
begin
|
||||
if (FCritSect <> nil) then FCritSect.Release;
|
||||
end;
|
||||
|
||||
procedure TWorkerThread.StopThread;
|
||||
begin
|
||||
if Lock then
|
||||
begin
|
||||
FStop := True;
|
||||
Unlock;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWorkerThread.EnqueueMessage(aMsg, aIntParam : integer; const aStrParam : string);
|
||||
var
|
||||
TempMsgInfo : TMsgInfo;
|
||||
begin
|
||||
TempMsgInfo.Msg := aMsg;
|
||||
TempMsgInfo.StrParam := aStrParam;
|
||||
TempMsgInfo.IntParam := aIntParam;
|
||||
EnqueueMessage(TempMsgInfo);
|
||||
end;
|
||||
|
||||
procedure TWorkerThread.EnqueueMessage(const aMsgInfo : TMsgInfo);
|
||||
begin
|
||||
if Lock then
|
||||
try
|
||||
if (FMsgQueue <> nil) then
|
||||
FMsgQueue.Push(TCustomMessage.Create(aMsgInfo));
|
||||
|
||||
if FWaiting then
|
||||
begin
|
||||
FWaiting := False;
|
||||
FEvent.SetEvent;
|
||||
end;
|
||||
finally
|
||||
Unlock;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TWorkerThread.ReadPendingMessage(var aMsgInfo : TMsgInfo) : boolean;
|
||||
var
|
||||
TempMessage : TCustomMessage;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if Lock then
|
||||
try
|
||||
FWaiting := False;
|
||||
|
||||
if (FMsgQueue <> nil) and (FMsgQueue.Count > 0) then
|
||||
begin
|
||||
TempMessage := TCustomMessage(FMsgQueue.Pop);
|
||||
aMsgInfo := TempMessage.Value;
|
||||
Result := True;
|
||||
TempMessage.Free;
|
||||
end;
|
||||
finally
|
||||
Unlock;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWorkerThread.ReadAllPendingMessages;
|
||||
var
|
||||
TempInfo : TMsgInfo;
|
||||
begin
|
||||
while ReadPendingMessage(TempInfo) do
|
||||
case TempInfo.Msg of
|
||||
WORKERTHREADMSG_QUIT :
|
||||
begin
|
||||
StopThread;
|
||||
exit;
|
||||
end;
|
||||
|
||||
else ProcessValue(TempInfo);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWorkerThread.ProcessValue(const aInfo : TMsgInfo);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
function TWorkerThread.CanContinue : boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if Lock then
|
||||
try
|
||||
if not(Terminated) and not(FStop) then
|
||||
begin
|
||||
Result := True;
|
||||
FWaiting := True;
|
||||
FEvent.ResetEvent;
|
||||
end;
|
||||
finally
|
||||
Unlock;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWorkerThread.Execute;
|
||||
begin
|
||||
while CanContinue do
|
||||
begin
|
||||
FEvent.WaitFor(INFINITE);
|
||||
ReadAllPendingMessages;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
"UpdateLazPackages" : [
|
||||
{
|
||||
"ForceNotify" : true,
|
||||
"InternalVersion" : 573,
|
||||
"InternalVersion" : 574,
|
||||
"Name" : "cef4delphi_lazarus.lpk",
|
||||
"Version" : "122.1.12"
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user