From 543af9be9094f22182f89e9826d77de1b7b8428d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Salvador=20D=C3=ADaz=20Fau?= Date: Sun, 2 Jun 2024 18:27:25 +0200 Subject: [PATCH] Added the Lazarus_Linux_Console\LibraryBrowser demo --- .../LibraryBrowser/00-Delete.bat | 2 + .../LibraryBrowser/custombrowser.lpi | 85 ++++ .../LibraryBrowser/custombrowser.lpr | 36 ++ .../LibraryBrowser/interfaces.pas | 68 +++ .../LibraryBrowser/librarybrowser.lpi | 87 ++++ .../LibraryBrowser/librarybrowser.lpr | 49 ++ .../LibraryBrowser/librarybrowser_sp.lpi | 66 +++ .../LibraryBrowser/librarybrowser_sp.lpr | 21 + .../LibraryBrowser/ucefbrowserthread.pas | 463 ++++++++++++++++++ .../LibraryBrowser/ucustombrowserloader.pas | 120 +++++ .../LibraryBrowser/ucustommessage.pas | 37 ++ .../LibraryBrowser/uencapsulatedbrowser.pas | 163 ++++++ .../LibraryBrowser/uworkerthread.pas | 213 ++++++++ update_CEF4Delphi.json | 2 +- 14 files changed, 1411 insertions(+), 1 deletion(-) create mode 100644 demos/Lazarus_Linux_Console/LibraryBrowser/00-Delete.bat create mode 100644 demos/Lazarus_Linux_Console/LibraryBrowser/custombrowser.lpi create mode 100644 demos/Lazarus_Linux_Console/LibraryBrowser/custombrowser.lpr create mode 100644 demos/Lazarus_Linux_Console/LibraryBrowser/interfaces.pas create mode 100644 demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser.lpi create mode 100644 demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser.lpr create mode 100644 demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser_sp.lpi create mode 100644 demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser_sp.lpr create mode 100644 demos/Lazarus_Linux_Console/LibraryBrowser/ucefbrowserthread.pas create mode 100644 demos/Lazarus_Linux_Console/LibraryBrowser/ucustombrowserloader.pas create mode 100644 demos/Lazarus_Linux_Console/LibraryBrowser/ucustommessage.pas create mode 100644 demos/Lazarus_Linux_Console/LibraryBrowser/uencapsulatedbrowser.pas create mode 100644 demos/Lazarus_Linux_Console/LibraryBrowser/uworkerthread.pas diff --git a/demos/Lazarus_Linux_Console/LibraryBrowser/00-Delete.bat b/demos/Lazarus_Linux_Console/LibraryBrowser/00-Delete.bat new file mode 100644 index 00000000..0b5ba5c8 --- /dev/null +++ b/demos/Lazarus_Linux_Console/LibraryBrowser/00-Delete.bat @@ -0,0 +1,2 @@ +rmdir /S /Q lib +rmdir /S /Q backup diff --git a/demos/Lazarus_Linux_Console/LibraryBrowser/custombrowser.lpi b/demos/Lazarus_Linux_Console/LibraryBrowser/custombrowser.lpi new file mode 100644 index 00000000..d7ad6c0b --- /dev/null +++ b/demos/Lazarus_Linux_Console/LibraryBrowser/custombrowser.lpi @@ -0,0 +1,85 @@ + + + + + + + + + + + + + <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="custombrowser.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="ucefbrowserthread.pas"/> + <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> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="../../../bin/custombrowser"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <RelocatableUnit Value="True"/> + </CodeGeneration> + <Linking> + <Options> + <ExecutableType Value="Library"/> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions> + <Item> + <Name Value="EAbort"/> + </Item> + <Item> + <Name Value="ECodetoolError"/> + </Item> + <Item> + <Name Value="EFOpenError"/> + </Item> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/demos/Lazarus_Linux_Console/LibraryBrowser/custombrowser.lpr b/demos/Lazarus_Linux_Console/LibraryBrowser/custombrowser.lpr new file mode 100644 index 00000000..1363af22 --- /dev/null +++ b/demos/Lazarus_Linux_Console/LibraryBrowser/custombrowser.lpr @@ -0,0 +1,36 @@ +library custombrowser; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, cmem, + {$ENDIF} + Classes, + { you can add units after this } + uencapsulatedbrowser; + +procedure InitializeCEF4Delphi; cdecl; +begin + InitializeEncapsulatedBrowser; +end; + +procedure FinalizeCEF4Delphi; cdecl; +begin + FinalizeEncapsulatedBrowser; +end; + +procedure TakeSnapshot; cdecl; +begin + CaptureScreenshot('https://www.google.com'); +end; + +exports + InitializeCEF4Delphi, + FinalizeCEF4Delphi, + TakeSnapshot; + +begin + // +end. + diff --git a/demos/Lazarus_Linux_Console/LibraryBrowser/interfaces.pas b/demos/Lazarus_Linux_Console/LibraryBrowser/interfaces.pas new file mode 100644 index 00000000..f954f195 --- /dev/null +++ b/demos/Lazarus_Linux_Console/LibraryBrowser/interfaces.pas @@ -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. diff --git a/demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser.lpi b/demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser.lpi new file mode 100644 index 00000000..75930561 --- /dev/null +++ b/demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser.lpi @@ -0,0 +1,87 @@ +<?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="librarybrowser"/> + <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> + <Item> + <PackageName Value="LCL"/> + </Item> + <Item> + <PackageName Value="LCLBase"/> + </Item> + </RequiredPackages> + <Units> + <Unit> + <Filename Value="librarybrowser.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="interfaces.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="ucustombrowserloader.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="../../../bin/librarybrowser"/> + </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> diff --git a/demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser.lpr b/demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser.lpr new file mode 100644 index 00000000..5a83f69d --- /dev/null +++ b/demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser.lpr @@ -0,0 +1,49 @@ +program librarybrowser; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, cmem, + {$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, ucustombrowserloader; + + // This demo shows how to use a CEF browser in a Linux library. + + // CEF is initalized using a different executable for the subprocesses called + // "librarybrowser_sp". + + // The CEF browser uses the off-screen rendering mode and this demo only takes + // a snapshot when it finishes loading the default URL. + // It creates a "snapshot.png" file in the same directory or shows an error message + // in the console. + + // It's necessary to build librarybrowser_sp.lpr and custombrowser.lpr before + // executing this project. + +begin + try + try + // This demo uses TCustomBrowserLoader to load "libcustombrowser.so" + // dynamically + GlobalCustomBrowseLoader := TCustomBrowserLoader.Create; + + // The LCL Widgetset must be initialized after the CEF initialization + CustomWidgetSetInitialization; + + GlobalCustomBrowseLoader.TakeSnapshot; + except + on E: Exception do + Writeln(E.ClassName, ': ', E.Message); + end; + finally + CustomWidgetSetFinalization; + + if assigned(GlobalCustomBrowseLoader) then + FreeAndNil(GlobalCustomBrowseLoader); + end; +end. + diff --git a/demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser_sp.lpi b/demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser_sp.lpi new file mode 100644 index 00000000..b6b04eb7 --- /dev/null +++ b/demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser_sp.lpi @@ -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="librarybrowser_sp.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="../../../bin/librarybrowser_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> diff --git a/demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser_sp.lpr b/demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser_sp.lpr new file mode 100644 index 00000000..e3c03235 --- /dev/null +++ b/demos/Lazarus_Linux_Console/LibraryBrowser/librarybrowser_sp.lpr @@ -0,0 +1,21 @@ +program librarybrowser_sp; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, cmem, + {$ENDIF} + Classes, SysUtils, uCEFApplicationCore; + +begin + GlobalCEFApp := TCefApplicationCore.Create; + GlobalCEFApp.WindowlessRenderingEnabled := True; + GlobalCEFApp.ShowMessageDlg := False; + GlobalCEFApp.BlinkSettings := 'hideScrollbars'; + GlobalCEFApp.SetCurrentDir := True; + GlobalCEFApp.ChromeRuntime := True; + GlobalCEFApp.StartSubProcess; + DestroyGlobalCEFApp; +end. + diff --git a/demos/Lazarus_Linux_Console/LibraryBrowser/ucefbrowserthread.pas b/demos/Lazarus_Linux_Console/LibraryBrowser/ucefbrowserthread.pas new file mode 100644 index 00000000..4f82421a --- /dev/null +++ b/demos/Lazarus_Linux_Console/LibraryBrowser/ucefbrowserthread.pas @@ -0,0 +1,463 @@ +unit ucefbrowserthread; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, SyncObjs, + uCEFTypes, uCEFInterfaces, uCEFConstants, uCEFChromium, + uworkerthread, ucustommessage; + +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); + + class procedure CreateGlobalCEFApp; + class procedure DestroyGlobalCEFApp; + + 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, uCEFApplication, uCEFMiscFunctions; + +const + WORKERTHREADMSG_LOADURL = WORKERTHREADMSG_QUIT + 1; + WORKERTHREADMSG_DOONERROR = WORKERTHREADMSG_QUIT + 2; + WORKERTHREADMSG_CLOSEBROWSER = WORKERTHREADMSG_QUIT + 3; + +class procedure TCEFBrowserThread.CreateGlobalCEFApp; +begin + GlobalCEFApp := TCefApplication.Create; + GlobalCEFApp.WindowlessRenderingEnabled := True; + GlobalCEFApp.ShowMessageDlg := False; // This demo shouldn't show any window, just console messages. + GlobalCEFApp.BrowserSubprocessPath := 'librarybrowser_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.SetCurrentDir := True; + GlobalCEFApp.DisableZygote := True; + GlobalCEFApp.ChromeRuntime := True; + GlobalCEFApp.StartMainProcess; +end; + +class procedure TCEFBrowserThread.DestroyGlobalCEFApp; +begin + uCEFApplication.DestroyGlobalCEFApp; +end; + +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. diff --git a/demos/Lazarus_Linux_Console/LibraryBrowser/ucustombrowserloader.pas b/demos/Lazarus_Linux_Console/LibraryBrowser/ucustombrowserloader.pas new file mode 100644 index 00000000..7d860889 --- /dev/null +++ b/demos/Lazarus_Linux_Console/LibraryBrowser/ucustombrowserloader.pas @@ -0,0 +1,120 @@ +unit ucustombrowserloader; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils; + +const + LIBNAME = 'libcustombrowser.so'; + +type + TInitializeCEF4DelphiFunc = procedure; cdecl; + TFinalizeCEF4DelphiFunc = procedure; cdecl; + TTakeSnapshotFunc = procedure; cdecl; + + TCustomBrowserLoader = class + private + FInitializeCEF4Delphi : TInitializeCEF4DelphiFunc; + FFinalizeCEF4Delphi : TFinalizeCEF4DelphiFunc; + FTakeSnapshot : TTakeSnapshotFunc; + FLibHandle : TLibHandle; + FLibLoaded : boolean; + + function GetLibPath : string; + function LoadCEFLibrary: boolean; + procedure UnloadCEFLibrary; + procedure InitializeCEF4Delphi; + procedure FinalizeCEF4Delphi; + + public + constructor Create; + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + procedure TakeSnapshot; + end; + +var + GlobalCustomBrowseLoader : TCustomBrowserLoader = nil; + +implementation + +constructor TCustomBrowserLoader.Create; +begin + inherited Create; + + FInitializeCEF4Delphi := nil; + FFinalizeCEF4Delphi := nil; + FTakeSnapshot := nil; + FLibHandle := 0; + FLibLoaded := False; +end; + +procedure TCustomBrowserLoader.AfterConstruction; +begin + inherited AfterConstruction; + + if LoadCEFLibrary then + InitializeCEF4Delphi; +end; + +procedure TCustomBrowserLoader.BeforeDestruction; +begin + FinalizeCEF4Delphi; + UnloadCEFLibrary; + + inherited BeforeDestruction; +end; + +function TCustomBrowserLoader.LoadCEFLibrary: boolean; +begin + Result := False; + FLibHandle := LoadLibrary(GetLibPath()); + + if (FLibHandle <> 0) then + begin + Pointer(FInitializeCEF4Delphi) := GetProcAddress(FLibHandle, 'InitializeCEF4Delphi'); + Pointer(FFinalizeCEF4Delphi) := GetProcAddress(FLibHandle, 'FinalizeCEF4Delphi'); + Pointer(FTakeSnapshot) := GetProcAddress(FLibHandle, 'TakeSnapshot'); + + FLibLoaded := assigned(FInitializeCEF4Delphi) and + assigned(FFinalizeCEF4Delphi) and + assigned(FTakeSnapshot); + + Result := FLibLoaded; + end; +end; + +function TCustomBrowserLoader.GetLibPath : string; +begin + Result := IncludeTrailingPathDelimiter(ExtractFileDir(ParamStr(0))) + LIBNAME; +end; + +procedure TCustomBrowserLoader.UnloadCEFLibrary; +begin + if FLibLoaded then + FreeLibrary(FLibHandle); +end; + +procedure TCustomBrowserLoader.InitializeCEF4Delphi; +begin + if FLibLoaded then + FInitializeCEF4Delphi(); +end; + +procedure TCustomBrowserLoader.FinalizeCEF4Delphi; +begin + if FLibLoaded then + FFinalizeCEF4Delphi(); +end; + +procedure TCustomBrowserLoader.TakeSnapshot; +begin + if FLibLoaded then + FTakeSnapshot(); +end; + +end. + diff --git a/demos/Lazarus_Linux_Console/LibraryBrowser/ucustommessage.pas b/demos/Lazarus_Linux_Console/LibraryBrowser/ucustommessage.pas new file mode 100644 index 00000000..2a86dba5 --- /dev/null +++ b/demos/Lazarus_Linux_Console/LibraryBrowser/ucustommessage.pas @@ -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. + diff --git a/demos/Lazarus_Linux_Console/LibraryBrowser/uencapsulatedbrowser.pas b/demos/Lazarus_Linux_Console/LibraryBrowser/uencapsulatedbrowser.pas new file mode 100644 index 00000000..cc4d4900 --- /dev/null +++ b/demos/Lazarus_Linux_Console/LibraryBrowser/uencapsulatedbrowser.pas @@ -0,0 +1,163 @@ +unit uencapsulatedbrowser; + +{$mode objfpc}{$H+} + +interface + +uses + SyncObjs, SysUtils, + ucefbrowserthread; + +type + TEncapsulatedBrowser = class + protected + FThread : TCEFBrowserThread; + FWidth : integer; + FHeight : integer; + FDelayMs : integer; + FScale : single; + FSnapshotPath : string; + FErrorText : string; + FEvent : TSimpleEvent; + + procedure Thread_OnError(Sender: TObject); + procedure Thread_OnSnapshotAvailable(Sender: TObject); + + public + constructor Create; + destructor Destroy; override; + procedure AfterConstruction; + procedure LoadURL(const aURL : string); + function WaitForEvent : boolean; + procedure WriteResult; + + 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 InitializeEncapsulatedBrowser; +procedure FinalizeEncapsulatedBrowser; +procedure CaptureScreenshot(const aURL: string); + +implementation + +var + EncapsulatedBrowser : TEncapsulatedBrowser = nil; + +procedure InitializeEncapsulatedBrowser; +begin + TCEFBrowserThread.CreateGlobalCEFApp; +end; + +procedure FinalizeEncapsulatedBrowser; +begin + if (EncapsulatedBrowser <> nil) then + FreeAndNil(EncapsulatedBrowser); + + TCEFBrowserThread.DestroyGlobalCEFApp; +end; + +procedure CaptureScreenshot(const aURL: string); +begin + EncapsulatedBrowser := TEncapsulatedBrowser.Create; + EncapsulatedBrowser.LoadURL(aURL); + + if EncapsulatedBrowser.WaitForEvent then + EncapsulatedBrowser.WriteResult; +end; + +constructor TEncapsulatedBrowser.Create; +begin + inherited Create; + + FEvent := nil; + 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; + + if (FEvent <> nil) then + FreeAndNil(FEvent); + + inherited Destroy; +end; + +procedure TEncapsulatedBrowser.AfterConstruction; +begin + inherited AfterConstruction; + + FEvent := TSimpleEvent.Create; +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 FEvent. + + 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(FEvent) then + FEvent.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 FEvent. + if assigned(FEvent) then + FEvent.SetEvent; +end; + +function TEncapsulatedBrowser.WaitForEvent : boolean; +begin + Result := True; + + // Wait for 1 minute max. + if assigned(FEvent) and (FEvent.WaitFor(60000) = wrTimeout) then + begin + WriteLn('Timeout expired!'); + Result := False; + end; +end; + +procedure TEncapsulatedBrowser.WriteResult; +begin + if (length(FErrorText) > 0) then + WriteLn(FErrorText) + else + WriteLn('Snapshot saved successfully as ' + FSnapshotPath); +end; + +end. diff --git a/demos/Lazarus_Linux_Console/LibraryBrowser/uworkerthread.pas b/demos/Lazarus_Linux_Console/LibraryBrowser/uworkerthread.pas new file mode 100644 index 00000000..2ac83c3b --- /dev/null +++ b/demos/Lazarus_Linux_Console/LibraryBrowser/uworkerthread.pas @@ -0,0 +1,213 @@ +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 + TempInfo.Msg := 0; + TempInfo.StrParam := ''; + TempInfo.IntParam := 0; + + 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. + diff --git a/update_CEF4Delphi.json b/update_CEF4Delphi.json index c5ace75b..b4cab866 100644 --- a/update_CEF4Delphi.json +++ b/update_CEF4Delphi.json @@ -2,7 +2,7 @@ "UpdateLazPackages" : [ { "ForceNotify" : true, - "InternalVersion" : 603, + "InternalVersion" : 604, "Name" : "cef4delphi_lazarus.lpk", "Version" : "125.0.19" }