diff --git a/demos/Delphi_VCL/KioskBrowser/00-DeleteDCUs.bat b/demos/Delphi_VCL/KioskBrowser/00-DeleteDCUs.bat new file mode 100644 index 00000000..a04481aa --- /dev/null +++ b/demos/Delphi_VCL/KioskBrowser/00-DeleteDCUs.bat @@ -0,0 +1,17 @@ +del /s /q *.dcu +del /s /q *.exe +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 diff --git a/demos/Delphi_VCL/KioskBrowser/KioskBrowser.dpr b/demos/Delphi_VCL/KioskBrowser/KioskBrowser.dpr new file mode 100644 index 00000000..bfceb9ad --- /dev/null +++ b/demos/Delphi_VCL/KioskBrowser/KioskBrowser.dpr @@ -0,0 +1,40 @@ +program KioskBrowser; + +{$I ..\..\..\source\cef.inc} + +uses + {$IFDEF DELPHI16_UP} + Vcl.Forms, + {$ELSE} + Forms, + {$ENDIF } + uCEFApplication, + uKioskBrowser in 'uKioskBrowser.pas' {Form1}; + +{$R *.res} + +{$IFDEF WIN32} +const + IMAGE_FILE_LARGE_ADDRESS_AWARE = $0020; + // CEF needs to set the LARGEADDRESSAWARE ($20) flag which allows 32-bit processes to use up to 3GB of RAM. + {$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE} +{$ENDIF} + +begin + CreateGlobalCEFApp; + + // You *MUST* call GlobalCEFApp.StartMainProcess in a if..then clause + // with the Application initialization inside the begin..end. + // Read this https://www.briskbard.com/index.php?lang=en&pageid=cef + if GlobalCEFApp.StartMainProcess then + begin + Application.Initialize; + {$IFDEF DELPHI11_UP} + Application.MainFormOnTaskbar := True; + {$ENDIF} + Application.CreateForm(TForm1, Form1); + Application.Run; + end; + + DestroyGlobalCEFApp; +end. diff --git a/demos/Delphi_VCL/KioskBrowser/KioskBrowser.dproj b/demos/Delphi_VCL/KioskBrowser/KioskBrowser.dproj new file mode 100644 index 00000000..101ab51d --- /dev/null +++ b/demos/Delphi_VCL/KioskBrowser/KioskBrowser.dproj @@ -0,0 +1,1132 @@ + + + {55E00327-9D98-4DA3-A4E1-844942A01C6B} + 20.3 + VCL + KioskBrowser.dpr + True + Debug + Win32 + 3 + Application + KioskBrowser + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 3082 + KioskBrowser + $(BDS)\bin\delphi_PROJECTICON.ico + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + .\$(Platform)\$(Config) + false + false + false + false + false + ..\..\..\bin + ..\..\..\source;$(DCC_UnitSearchPath) + + + DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;frxe23;vclFireDAC;emsclientfiredac;DataSnapFireDAC;svnui;tethering;Componentes;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;Intraweb;DBXOracleDriver;inetdb;Componentes_Int;CEF4Delphi;FmxTeeUI;FireDACIBDriver;fmx;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyProtocols230;vclx;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;frxTee23;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;vcl;DBXSybaseASEDriver;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;Componentes_UI;TeeDB;FireDAC;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;Componentes_Misc;ibxpress;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;Componentes_RTF;DBXInformixDriver;bindcompvcl;frxDB23;Componentes_vCard;TeeUI;IndyCore230;vclribbon;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;IndySystem230;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;frx23;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + true + $(BDS)\bin\default_app.manifest + 1033 + CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;emsclientfiredac;DataSnapFireDAC;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;Intraweb;DBXOracleDriver;inetdb;FmxTeeUI;FireDACIBDriver;fmx;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyProtocols230;vclx;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;vcl;DBXSybaseASEDriver;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;FireDAC;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;bindcompvcl;TeeUI;IndyCore230;vclribbon;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;IndySystem230;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;fmxase;$(DCC_UsePackage) + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + true + 1033 + true + false + Debug + CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) + PerMonitor + + + true + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitor + + + true + PerMonitorV2 + + + + MainSource + + +
Form1
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Application + + + + KioskBrowser.dpr + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\values-v35 + 1 + + + res\values-v35 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + + True + True + + + 12 + + + + + diff --git a/demos/Delphi_VCL/KioskBrowser/KioskBrowser.res b/demos/Delphi_VCL/KioskBrowser/KioskBrowser.res new file mode 100644 index 00000000..98864779 Binary files /dev/null and b/demos/Delphi_VCL/KioskBrowser/KioskBrowser.res differ diff --git a/demos/Delphi_VCL/KioskBrowser/uKioskBrowser.dfm b/demos/Delphi_VCL/KioskBrowser/uKioskBrowser.dfm new file mode 100644 index 00000000..e93cd7fa --- /dev/null +++ b/demos/Delphi_VCL/KioskBrowser/uKioskBrowser.dfm @@ -0,0 +1,61 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + BorderStyle = bsSingle + Caption = 'qwerty' + ClientHeight = 624 + ClientWidth = 1038 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poDefault + Visible = True + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnShow = FormShow + TextHeight = 13 + object CEFWindowParent1: TCEFWindowParent + Left = 0 + Top = 0 + Width = 1038 + Height = 444 + Align = alClient + TabStop = True + TabOrder = 0 + end + object TouchKeyboard1: TTouchKeyboard + Left = 0 + Top = 444 + Width = 1038 + Height = 180 + Align = alBottom + GradientEnd = clSilver + GradientStart = clGray + Layout = 'Standard' + Visible = False + end + object Timer1: TTimer + Enabled = False + Interval = 300 + OnTimer = Timer1Timer + Left = 56 + Top = 88 + end + object Chromium1: TChromium + OnCanFocus = Chromium1CanFocus + OnProcessMessageReceived = Chromium1ProcessMessageReceived + OnBeforeContextMenu = Chromium1BeforeContextMenu + OnContextMenuCommand = Chromium1ContextMenuCommand + OnPreKeyEvent = Chromium1PreKeyEvent + OnKeyEvent = Chromium1KeyEvent + OnBeforePopup = Chromium1BeforePopup + OnAfterCreated = Chromium1AfterCreated + OnBeforeClose = Chromium1BeforeClose + OnOpenUrlFromTab = Chromium1OpenUrlFromTab + Left = 56 + Top = 152 + end +end diff --git a/demos/Delphi_VCL/KioskBrowser/uKioskBrowser.pas b/demos/Delphi_VCL/KioskBrowser/uKioskBrowser.pas new file mode 100644 index 00000000..0a86baa6 --- /dev/null +++ b/demos/Delphi_VCL/KioskBrowser/uKioskBrowser.pas @@ -0,0 +1,442 @@ +unit uKioskBrowser; + +{$I ..\..\..\source\cef.inc} + +interface + +uses + {$IFDEF DELPHI16_UP} + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, + {$ELSE} + Windows, Messages, SysUtils, Variants, Classes, Graphics, + Controls, Forms, Dialogs, StdCtrls, ExtCtrls, + {$ENDIF} + uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFConstants, uCEFTypes, + uCEFWinControl, uCEFChromiumCore, Vcl.Touch.Keyboard; + +const + HOMEPAGE_URL = 'https://www.google.com'; + + SHOWKEYBOARD_PROCMSG = 'showkeyboard'; + HIDEKEYBOARD_PROCMSG = 'hidekeyboard'; + + CEF_SHOWKEYBOARD = WM_APP + $B01; + CEF_HIDEKEYBOARD = WM_APP + $B02; + + KIOSKBROWSER_CONTEXTMENU_EXIT = MENU_ID_USER_FIRST + 1; + KIOSKBROWSER_CONTEXTMENU_HIDEKEYBOARD = MENU_ID_USER_FIRST + 2; + KIOSKBROWSER_CONTEXTMENU_SHOWKEYBOARD = MENU_ID_USER_FIRST + 3; + +type + TForm1 = class(TForm) + Timer1: TTimer; + Chromium1: TChromium; + CEFWindowParent1: TCEFWindowParent; + TouchKeyboard1: TTouchKeyboard; + + procedure Timer1Timer(Sender: TObject); + + procedure FormShow(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + + procedure Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser); + procedure Chromium1CanFocus(Sender: TObject); + procedure Chromium1ContextMenuCommand(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; commandId: Integer; eventFlags: TCefEventFlags; out Result: Boolean); + procedure Chromium1BeforeContextMenu(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel); + procedure Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser); + procedure Chromium1BeforePopup(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; popup_id: Integer; 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, Result: Boolean); + procedure Chromium1KeyEvent(Sender: TObject; const browser: ICefBrowser; const event: PCefKeyEvent; osEvent: TCefEventHandle; out Result: Boolean); + procedure Chromium1OpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; out Result: Boolean); + procedure Chromium1PreKeyEvent(Sender: TObject; const browser: ICefBrowser; const event: PCefKeyEvent; osEvent: TCefEventHandle; out isKeyboardShortcut, Result: Boolean); + procedure Chromium1ProcessMessageReceived(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; sourceProcess: TCefProcessId; const message: ICefProcessMessage; out Result: Boolean); + + protected + // Variables to control when can we destroy the form safely + FCanClose : boolean; // Set to True in TChromium.OnBeforeClose + FClosing : boolean; // Set to True in the CloseQuery event. + + procedure HandleKeyUp(const aMsg : TMsg; var aHandled : boolean); + procedure HandleKeyDown(const aMsg : TMsg; var aHandled : boolean); + + procedure ShowKeyboardMsg(var aMessage : TMessage); message CEF_SHOWKEYBOARD; + procedure HideKeyboardMsg(var aMessage : TMessage); message CEF_HIDEKEYBOARD; + procedure FocusEnabledMsg(var aMessage : TMessage); message CEF_FOCUSENABLED; + procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED; + + // You have to handle this two messages to call NotifyMoveOrResizeStarted or some page elements will be misaligned. + procedure WMMove(var aMessage : TWMMove); message WM_MOVE; + procedure WMMoving(var aMessage : TMessage); message WM_MOVING; + + // You also have to handle these two messages to set GlobalCEFApp.OsmodalLoop + procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP; + procedure WMExitMenuLoop(var aMessage: TMessage); message WM_EXITMENULOOP; + public + { Public declarations } + end; + +var + Form1: TForm1; + +procedure CreateGlobalCEFApp; + +implementation + +{$R *.dfm} + +uses + uCEFApplication, uCefMiscFunctions, uCEFProcessMessage; + +// This is a simplified Kiosk browser using a virtual keyboard. +// The default URL is defined in the HOMEPAGE_URL constant. + +// To close this app press the ESC key or select the 'Exit' option in the context menu. + +// This demo uses a TChromium and a TCEFWindowParent + +// Destruction steps +// ================= +// 1. FormCloseQuery sets CanClose to FALSE, destroys CEFWindowParent1 and calls TChromium.CloseBrowser which triggers the TChromium.OnBeforeClose event. +// 2. TChromium.OnBeforeClose sets FCanClose := True and sends WM_CLOSE to the form. + +function NodeIsTextArea(const aNode : ICefDomNode) : boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +begin + Result := (CompareText(aNode.ElementTagName, 'textarea') = 0); +end; + +function NodeIsInput(const aNode : ICefDomNode) : boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +begin + Result := (CompareText(aNode.ElementTagName, 'input') = 0); +end; + +function InputNeedsKeyboard(const aNode : ICefDomNode) : boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +var + TempType : string; +begin + if not(aNode.HasElementAttribute('type')) then + Result := True + else + begin + TempType := aNode.GetElementAttribute('type'); + Result := (CompareText(TempType, 'date') = 0) or + (CompareText(TempType, 'datetime-local') = 0) or + (CompareText(TempType, 'email') = 0) or + (CompareText(TempType, 'month') = 0) or + (CompareText(TempType, 'number') = 0) or + (CompareText(TempType, 'password') = 0) or + (CompareText(TempType, 'search') = 0) or + (CompareText(TempType, 'tel') = 0) or + (CompareText(TempType, 'text') = 0) or + (CompareText(TempType, 'time') = 0) or + (CompareText(TempType, 'url') = 0) or + (CompareText(TempType, 'week') = 0); + end; +end; + +function NodeNeedsKeyboard(const aNode : ICefDomNode) : boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +begin + Result := NodeIsTextArea(aNode) or + (NodeIsInput(aNode) and InputNeedsKeyboard(aNode)); +end; + +procedure GlobalCEFApp_OnFocusedNodeChanged(const browser: ICefBrowser; const frame: ICefFrame; const node: ICefDomNode); +var + TempMsg : ICefProcessMessage; +begin + if assigned(frame) and frame.IsValid then + begin + // This procedure is called in the Render process and checks if the focused node is an + // INPUT or TEXTAREA to show or hide the virtual keyboard. + // It sends a process message to the browser process to handle the virtual keyboard. + if (node <> nil) and NodeNeedsKeyboard(node) then + TempMsg := TCefProcessMessageRef.New(SHOWKEYBOARD_PROCMSG) + else + TempMsg := TCefProcessMessageRef.New(HIDEKEYBOARD_PROCMSG); + + frame.SendProcessMessage(PID_BROWSER, TempMsg); + end; +end; + +procedure CreateGlobalCEFApp; +begin + GlobalCEFApp := TCefApplication.Create; + GlobalCEFApp.RootCache := 'RootCache'; + GlobalCEFApp.EnablePrintPreview := True; + GlobalCEFApp.TouchEvents := STATE_ENABLED; + GlobalCEFApp.EnableGPU := True; + {$IFDEF DEBUG} + GlobalCEFApp.LogFile := 'debug.log'; + GlobalCEFApp.LogSeverity := LOGSEVERITY_INFO; + {$ENDIF} + GlobalCEFApp.OnFocusedNodeChanged := GlobalCEFApp_OnFocusedNodeChanged; +end; + +procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + CanClose := FCanClose; + + if not(FClosing) then + begin + FClosing := True; + Visible := False; + Chromium1.CloseBrowser(True); + TThread.ForceQueue(nil, + procedure + begin + CEFWindowParent1.Free; + end); + end; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + // We use a normal form while debugging. + {$IFNDEF DEBUG} + BorderIcons := []; + BorderStyle := bsNone; + BorderWidth := 0; + Caption := ''; + {$ENDIF} + FCanClose := False; + FClosing := False; + Chromium1.DefaultURL := HOMEPAGE_URL; +end; + +procedure TForm1.FormShow(Sender: TObject); +begin + // We use a normal form while debugging. + {$IFNDEF DEBUG} + self.Position := wsMaximized; + {$ENDIF} + + // You *MUST* call CreateBrowser to create and initialize the browser. + // This will trigger the AfterCreated event when the browser is fully + // initialized and ready to receive commands. + + // GlobalCEFApp.GlobalContextInitialized has to be TRUE before creating any browser + // If it's not initialized yet, we use a simple timer to create the browser later. + if not(Chromium1.CreateBrowser(CEFWindowParent1)) then Timer1.Enabled := True; +end; + +procedure TForm1.Chromium1AfterCreated(Sender: TObject; + const browser: ICefBrowser); +begin + PostMessage(Handle, CEF_AFTERCREATED, 0, 0); +end; + +procedure TForm1.Chromium1BeforeClose(Sender: TObject; + const browser: ICefBrowser); +begin + FCanClose := True; + PostMessage(Handle, WM_CLOSE, 0, 0); +end; + +procedure TForm1.Chromium1BeforeContextMenu(Sender: TObject; + const browser: ICefBrowser; const frame: ICefFrame; + const params: ICefContextMenuParams; const model: ICefMenuModel); +begin + model.AddSeparator; + + if TouchKeyboard1.Visible then + model.AddItem(KIOSKBROWSER_CONTEXTMENU_HIDEKEYBOARD, 'Hide virtual keyboard') + else + model.AddItem(KIOSKBROWSER_CONTEXTMENU_SHOWKEYBOARD, 'Show virtual keyboard'); + + model.AddSeparator; + model.AddItem(KIOSKBROWSER_CONTEXTMENU_EXIT, 'Exit'); +end; + +procedure TForm1.Chromium1CanFocus(Sender: TObject); +begin + // The browser required some time to create associated internal objects + // before being able to accept the focus. Now we can set the focus on the + // TBufferPanel control + PostMessage(Handle, CEF_FOCUSENABLED, 0, 0); +end; + +procedure TForm1.Chromium1ContextMenuCommand(Sender: TObject; + const browser: ICefBrowser; const frame: ICefFrame; + const params: ICefContextMenuParams; commandId: Integer; + eventFlags: TCefEventFlags; out Result: Boolean); +begin + Result := False; + + case commandId of + KIOSKBROWSER_CONTEXTMENU_EXIT : PostMessage(Handle, WM_CLOSE, 0, 0); + KIOSKBROWSER_CONTEXTMENU_HIDEKEYBOARD : PostMessage(Handle, CEF_HIDEKEYBOARD, 0, 0); + KIOSKBROWSER_CONTEXTMENU_SHOWKEYBOARD : PostMessage(Handle, CEF_SHOWKEYBOARD, 0, 0); + end; +end; + +procedure TForm1.Chromium1KeyEvent(Sender: TObject; const browser: ICefBrowser; + const event: PCefKeyEvent; osEvent: TCefEventHandle; out Result: Boolean); +var + TempMsg : TMsg; +begin + Result := False; + + if (event <> nil) and (osEvent <> nil) then + case osEvent.Message of + WM_KEYUP : + begin + TempMsg := osEvent^; + + HandleKeyUp(TempMsg, Result); + end; + + WM_KEYDOWN : + begin + TempMsg := osEvent^; + + HandleKeyDown(TempMsg, Result); + end; + end; +end; + +procedure TForm1.Chromium1BeforePopup(Sender: TObject; + const browser: ICefBrowser; const frame: ICefFrame; popup_id: Integer; + 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, Result: Boolean); +begin + // For simplicity, this demo blocks all popup windows and new tabs + Result := (targetDisposition in [CEF_WOD_NEW_FOREGROUND_TAB, CEF_WOD_NEW_BACKGROUND_TAB, CEF_WOD_NEW_POPUP, CEF_WOD_NEW_WINDOW]); +end; + +procedure TForm1.Chromium1OpenUrlFromTab(Sender: TObject; + const browser: ICefBrowser; const frame: ICefFrame; + const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; + userGesture: Boolean; out Result: Boolean); +begin + // For simplicity, this demo blocks all popup windows and new tabs + Result := (targetDisposition in [CEF_WOD_NEW_FOREGROUND_TAB, CEF_WOD_NEW_BACKGROUND_TAB, CEF_WOD_NEW_POPUP, CEF_WOD_NEW_WINDOW]); +end; + +procedure TForm1.Chromium1PreKeyEvent(Sender: TObject; + const browser: ICefBrowser; const event: PCefKeyEvent; + osEvent: TCefEventHandle; out isKeyboardShortcut, Result: Boolean); +begin + Result := False; + + if (event <> nil) and + (event.kind in [KEYEVENT_KEYDOWN, KEYEVENT_KEYUP]) and + (event.windows_key_code = VK_ESCAPE) then + isKeyboardShortcut := True; +end; + +procedure TForm1.Chromium1ProcessMessageReceived(Sender: TObject; + const browser: ICefBrowser; const frame: ICefFrame; + sourceProcess: TCefProcessId; const message: ICefProcessMessage; + out Result: Boolean); +begin + // This function receives the process message from the render process to show or hide the virtual keyboard. + // This event is not executed in the main thread so it has to send a custom windows message to the form + // to handle the keyboard in the main thread. + + if (message.Name = SHOWKEYBOARD_PROCMSG) then + begin + PostMessage(Handle, CEF_SHOWKEYBOARD, 0 ,0); + Result := True; + end + else + if (message.Name = HIDEKEYBOARD_PROCMSG) then + begin + PostMessage(Handle, CEF_HIDEKEYBOARD, 0 ,0); + Result := True; + end; +end; + +procedure TForm1.Timer1Timer(Sender: TObject); +begin + Timer1.Enabled := False; + if not(Chromium1.CreateBrowser(CEFWindowParent1)) and not(Chromium1.Initialized) then + Timer1.Enabled := True; +end; + +procedure TForm1.WMMove(var aMessage : TWMMove); +begin + inherited; + + if (Chromium1 <> nil) then + Chromium1.NotifyMoveOrResizeStarted; +end; + +procedure TForm1.WMMoving(var aMessage : TMessage); +begin + inherited; + + if (Chromium1 <> nil) then + Chromium1.NotifyMoveOrResizeStarted; +end; + +procedure TForm1.WMEnterMenuLoop(var aMessage: TMessage); +begin + inherited; + + if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then + GlobalCEFApp.OsmodalLoop := True; +end; + +procedure TForm1.WMExitMenuLoop(var aMessage: TMessage); +begin + inherited; + + if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then + GlobalCEFApp.OsmodalLoop := False; +end; + +procedure TForm1.ShowKeyboardMsg(var aMessage : TMessage); +begin + TouchKeyboard1.Visible := True; +end; + +procedure TForm1.HideKeyboardMsg(var aMessage : TMessage); +begin + TouchKeyboard1.Visible := False; +end; + +procedure TForm1.FocusEnabledMsg(var aMessage : TMessage); +begin + Chromium1.SetFocus(True); +end; + +procedure TForm1.BrowserCreatedMsg(var aMessage : TMessage); +begin + CEFWindowParent1.UpdateSize; +end; + +procedure TForm1.HandleKeyUp(const aMsg : TMsg; var aHandled : boolean); +var + TempMessage : TMessage; + TempKeyMsg : TWMKey; +begin + TempMessage.Msg := aMsg.message; + TempMessage.wParam := aMsg.wParam; + TempMessage.lParam := aMsg.lParam; + TempKeyMsg := TWMKey(TempMessage); + + if (TempKeyMsg.CharCode = VK_ESCAPE) then + begin + aHandled := True; + + PostMessage(Handle, WM_CLOSE, 0, 0); + end; +end; + +procedure TForm1.HandleKeyDown(const aMsg : TMsg; var aHandled : boolean); +var + TempMessage : TMessage; + TempKeyMsg : TWMKey; +begin + TempMessage.Msg := aMsg.message; + TempMessage.wParam := aMsg.wParam; + TempMessage.lParam := aMsg.lParam; + TempKeyMsg := TWMKey(TempMessage); + + if (TempKeyMsg.CharCode = VK_ESCAPE) then aHandled := True; +end; + +end. diff --git a/update_CEF4Delphi.json b/update_CEF4Delphi.json index 8e9bb783..c6507d70 100644 --- a/update_CEF4Delphi.json +++ b/update_CEF4Delphi.json @@ -2,7 +2,7 @@ "UpdateLazPackages" : [ { "ForceNotify" : true, - "InternalVersion" : 758, + "InternalVersion" : 759, "Name" : "cef4delphi_lazarus.lpk", "Version" : "138.0.33" }