Added WebpageSnapshot demo for UniGUI

demos/Delphi_UniGUI/WebpageSnapshot/00-DeleteDCUs.bat

@@ -0,0 +1,18 @@
+del /s /q *.dcu
+del /s /q *.exe
+del /s /q *.res
+del /s /q *.rsm
+del /s /q *.log
+del /s /q *.dsk
+del /s /q *.identcache
+del /s /q *.stat
+del /s /q *.local
+del /s /q *.~*
+rmdir Win32\Debug
+rmdir Win32\Release
+rmdir Win32
+rmdir Win64\Debug
+rmdir Win64\Release
+rmdir Win64
+rmdir __history
+rmdir __recovery

demos/Delphi_UniGUI/WebpageSnapshot/Main.dfm

@@ -0,0 +1,166 @@
+object MainForm: TMainForm
+  Left = 0
+  Top = 0
+  ClientHeight = 645
+  ClientWidth = 800
+  Caption = 'Webpage Snapshot UniGUI'
+  OnShow = UniFormShow
+  BorderStyle = bsSingle
+  OldCreateOrder = False
+  OnClose = UniFormClose
+  BorderIcons = [biSystemMenu]
+  MonitoredKeys.Keys = <>
+  OnCreate = UniFormCreate
+  TextHeight = 15
+  object UniPanel1: TUniPanel
+    Left = 0
+    Top = 0
+    Width = 800
+    Height = 23
+    Hint = ''
+    Align = alTop
+    TabOrder = 0
+    BorderStyle = ubsNone
+    Caption = ''
+    object AddressCb: TUniComboBox
+      Left = 0
+      Top = 0
+      Width = 725
+      Height = 23
+      Hint = ''
+      Text = 'https://www.google.com'
+      Items.Strings = (
+        'https://www.google.com'
+
+          'https://www.whatismybrowser.com/detect/what-http-headers-is-my-b' +
+          'rowser-sending'
+        'https://www.w3schools.com/js/tryit.asp?filename=tryjs_win_close'
+        'https://www.w3schools.com/js/tryit.asp?filename=tryjs_alert'
+        'https://www.w3schools.com/js/tryit.asp?filename=tryjs_loc_assign'
+
+          'https://www.w3schools.com/jsref/tryit.asp?filename=tryjsref_styl' +
+          'e_backgroundcolor'
+
+          'https://www.w3schools.com/Tags/tryit.asp?filename=tryhtml_iframe' +
+          '_name'
+
+          'https://www.w3schools.com/tags/tryit.asp?filename=tryhtml5_input' +
+          '_type_file'
+
+          'https://www.w3schools.com/jsref/tryit.asp?filename=tryjsref_stat' +
+          'e_throw_error'
+        'https://www.htmlquick.com/es/reference/tags/input-file.html'
+
+          'https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input/' +
+          'file'
+
+          'https://developer.mozilla.org/en-US/docs/Web/API/HTMLInputElemen' +
+          't/webkitdirectory'
+        'https://www.w3schools.com/html/html5_video.asp'
+        'http://html5test.com/'
+
+          'https://webrtc.github.io/samples/src/content/devices/input-outpu' +
+          't/'
+        'https://test.webrtc.org/'
+        'https://www.browserleaks.com/webrtc'
+        'https://shaka-player-demo.appspot.com/demo/'
+        'http://webglsamples.org/'
+        'https://get.webgl.org/'
+        'https://www.briskbard.com'
+        'https://www.youtube.com'
+        'https://html5demos.com/drag/'
+        'https://frames-per-second.appspot.com/'
+
+          'https://www.sede.fnmt.gob.es/certificados/persona-fisica/verific' +
+          'ar-estado'
+        'https://www.kirupa.com/html5/accessing_your_webcam_in_html5.htm'
+        'https://www.xdumaine.com/enumerateDevices/test/'
+
+          'https://dagrs.berkeley.edu/sites/default/files/2020-01/sample.pd' +
+          'f'
+        'https://codepen.io/udaymanvar/pen/MWaePBY'
+
+          'https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/acc' +
+          'ept'
+        'chrome://version/'
+        'chrome://net-internals/'
+        'chrome://tracing/'
+        'chrome://appcache-internals/'
+        'chrome://blob-internals/'
+        'chrome://view-http-cache/'
+        'chrome://credits/'
+        'chrome://histograms/'
+        'chrome://media-internals/'
+        'chrome://kill'
+        'chrome://crash'
+        'chrome://hang'
+        'chrome://shorthang'
+        'chrome://gpuclean'
+        'chrome://gpucrash'
+        'chrome://gpuhang'
+        'chrome://extensions-support'
+        'chrome://process-internals')
+      ItemIndex = 0
+      Align = alClient
+      TabOrder = 1
+      IconItems = <>
+    end
+    object GoBtn: TUniButton
+      Left = 725
+      Top = 0
+      Width = 75
+      Height = 23
+      Hint = ''
+      Caption = 'Go'
+      Align = alRight
+      TabOrder = 2
+      OnClick = GoBtnClick
+    end
+  end
+  object UniStatusBar1: TUniStatusBar
+    Left = 0
+    Top = 623
+    Width = 800
+    Hint = ''
+    Panels = <
+      item
+        Width = 600
+      end>
+    SizeGrip = False
+    Align = alBottom
+    ParentColor = False
+  end
+  object UniMemo1: TUniMemo
+    Left = 0
+    Top = 534
+    Width = 800
+    Height = 89
+    Hint = ''
+    Align = alBottom
+    ReadOnly = True
+    TabOrder = 2
+  end
+  object UniCanvas1: TUniCanvas
+    Left = 0
+    Top = 23
+    Width = 800
+    Height = 511
+    Hint = ''
+    Align = alClient
+    ExplicitLeft = 200
+    ExplicitTop = 104
+    ExplicitWidth = 320
+    ExplicitHeight = 320
+  end
+  object UniTimer1: TUniTimer
+    Interval = 100
+    ClientEvent.Strings = (
+      'function(sender)'
+      '{'
+      ' '
+      '}')
+    OnTimer = UniTimer1Timer
+    Left = 496
+    Top = 376
+  end
+end

demos/Delphi_UniGUI/WebpageSnapshot/Main.pas

@@ -0,0 +1,138 @@
+unit Main;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics,
+  Controls, Forms, uniGUITypes, uniGUIAbstractClasses,
+  uniGUIClasses, uniGUIRegClasses, uniGUIForm, uniImage, uniButton,
+  uniMultiItem, uniComboBox, uniGUIBaseClasses, uniPanel,
+  uCEFBrowserThread, uniStatusBar, uniMemo, uniTimer, uniCanvas;
+
+type
+  TMainForm = class(TUniForm)
+    UniPanel1: TUniPanel;
+    AddressCb: TUniComboBox;
+    GoBtn: TUniButton;
+    UniStatusBar1: TUniStatusBar;
+    UniMemo1: TUniMemo;
+    UniCanvas1: TUniCanvas;
+    UniTimer1: TUniTimer;
+    procedure UniFormCreate(Sender: TObject);
+    procedure UniFormClose(Sender: TObject; var Action: TCloseAction);
+    procedure GoBtnClick(Sender: TObject);
+    procedure UniFormShow(Sender: TObject);
+    procedure UniTimer1Timer(Sender: TObject);
+  private
+    FThread : TCEFBrowserThread;
+    FMustRefresh : boolean;
+
+    procedure Thread_OnError(Sender: TObject);
+    procedure Thread_OnSnapshotAvailable(Sender: TObject);
+    procedure Thread_OnHTMLAvailable(Sender: TObject);
+  public
+    { Public declarations }
+  end;
+
+function MainForm: TMainForm;
+
+implementation
+
+{$R *.dfm}
+
+uses
+  uniGUIVars, MainModule, uniGUIApplication,
+  uCEFApplication;
+
+function MainForm: TMainForm;
+begin
+  Result := TMainForm(UniMainModule.GetFormInstance(TMainForm));
+end;
+
+procedure TMainForm.GoBtnClick(Sender: TObject);
+begin
+  UniStatusBar1.Panels[0].Text := 'Loading...';
+  screen.cursor := crAppStart;
+  FMustRefresh := False;
+
+  if (FThread = nil) then
+    begin
+      FThread                     := TCEFBrowserThread.Create(AddressCb.Text, UniCanvas1.Width, UniCanvas1.Height);
+      FThread.OnError             := Thread_OnError;
+      FThread.OnSnapshotAvailable := Thread_OnSnapshotAvailable;
+      FThread.OnHTMLAvailable     := Thread_OnHTMLAvailable;
+      FThread.SyncEvents          := True;
+      FThread.Start;
+    end
+   else
+    FThread.LoadUrl(AddressCb.Text);
+end;
+
+procedure TMainForm.UniFormClose(Sender: TObject; var Action: TCloseAction);
+begin
+  if (FThread <> nil) then
+    begin
+      if FThread.TerminateBrowserThread then
+        FThread.WaitFor;
+
+      FreeAndNil(FThread);
+    end;
+end;
+
+procedure TMainForm.UniFormCreate(Sender: TObject);
+begin
+  FThread := nil;
+end;
+
+procedure TMainForm.UniFormShow(Sender: TObject);
+begin
+  if GlobalCEFApp.GlobalContextInitialized then
+    UniMemo1.Lines.Add('GlobalCEFApp Initialized')
+   else
+    UniMemo1.Lines.Add('Error: ' + GlobalCEFApp.LastErrorMessage);
+
+  UniMemo1.Refresh;
+end;
+
+procedure TMainForm.UniTimer1Timer(Sender: TObject);
+begin
+  if FMustRefresh then
+    begin
+      FMustRefresh := False;
+      Repaint;
+    end;
+end;
+
+procedure TMainForm.Thread_OnError(Sender: TObject);
+begin
+  UniStatusBar1.Panels[0].Text := 'Error ' + inttostr(FThread.ErrorCode) + ' : ' + FThread.ErrorText + ' - ' + FThread.FailedUrl;
+  screen.cursor := crDefault;
+end;
+
+procedure TMainForm.Thread_OnSnapshotAvailable(Sender: TObject);
+var
+  TempBitmap : TBitmap;
+begin
+  TempBitmap    := nil;
+  screen.cursor := crDefault;
+
+  if FThread.CopySnapshot(TempBitmap) then
+    begin
+      UniCanvas1.Bitmap.Assign(TempBitmap);
+      UniStatusBar1.Panels[0].Text := 'Snapshot copied successfully';
+      TempBitmap.Free;
+    end
+   else
+    UniStatusBar1.Panels[0].Text := 'There was an error copying the snapshot';
+end;
+
+procedure TMainForm.Thread_OnHTMLAvailable(Sender: TObject);
+begin
+  UniMemo1.Lines.Add(FThread.HTMLcopy);
+  FMustRefresh := True;
+end;
+
+initialization
+  RegisterAppFormClass(TMainForm);
+
+end.

demos/Delphi_UniGUI/WebpageSnapshot/MainModule.dfm

@@ -0,0 +1,5 @@
+object UniMainModule: TUniMainModule
+  MonitoredKeys.Keys = <>
+  Height = 480
+  Width = 640
+end

demos/Delphi_UniGUI/WebpageSnapshot/MainModule.pas

@@ -0,0 +1,32 @@
+unit MainModule;
+
+interface
+
+uses
+  uniGUIMainModule, SysUtils, Classes;
+
+type
+  TUniMainModule = class(TUniGUIMainModule)
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+function UniMainModule: TUniMainModule;
+
+implementation
+
+{$R *.dfm}
+
+uses
+  UniGUIVars, ServerModule, uniGUIApplication;
+
+function UniMainModule: TUniMainModule;
+begin
+  Result := TUniMainModule(UniApplication.UniMainModule)
+end;
+
+initialization
+  RegisterMainModuleClass(TUniMainModule);
+end.

demos/Delphi_UniGUI/WebpageSnapshot/ServerModule.dfm

@@ -0,0 +1,18 @@
+object UniServerModule: TUniServerModule
+  TempFolder = 'temp\'
+  Title = 'New Application'
+  SuppressErrors = []
+  Bindings = <>
+  SSL.SSLOptions.RootCertFile = 'root.pem'
+  SSL.SSLOptions.CertFile = 'cert.pem'
+  SSL.SSLOptions.KeyFile = 'key.pem'
+  SSL.SSLOptions.Method = sslvSSLv23
+  SSL.SSLOptions.SSLVersions = [sslvTLSv1_1, sslvTLSv1_2]
+  SSL.SSLOptions.Mode = sslmUnassigned
+  SSL.SSLOptions.VerifyMode = []
+  SSL.SSLOptions.VerifyDepth = 0
+  ConnectionFailureRecovery.ErrorMessage = 'Connection Error'
+  ConnectionFailureRecovery.RetryMessage = 'Retrying...'
+  Height = 480
+  Width = 640
+end