pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-10-30 23:07:52 +02:00
Code Issues Actions 1 Releases Activity

Added MobileBrowser demo for Lazarus on Windows and Linux

Browse Source 
Fixed issues using the message_id parameter incorrectly when calling ExecuteDevToolsMethod in the MiniBrowser and MobileBrowser demos.
This commit is contained in:
salvadordf
2022-04-02 16:32:39 +02:00
parent 432de846e1
commit b4a02e89af
19 changed files with 3336 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
demos/Delphi_VCL/MiniBrowser/MiniBrowser.dproj
View File

@@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{4BC9C886-B196-4B7F-931A-6134EB9A8DA6}</ProjectGuid>
<ProjectVersion>19.3</ProjectVersion>
<ProjectVersion>19.4</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>MiniBrowser.dpr</MainSource>
<Base>True</Base>
@@ -181,13 +181,13 @@
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="MiniBrowser.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployFile LocalName="..\..\..\bin\MiniBrowser.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>MiniBrowser.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="MiniBrowser.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
@@ -1313,17 +1313,17 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
</Deployment>
<Platforms>
<Platform value="Win32">True</Platform>

54
demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas
View File

@@ -91,6 +91,9 @@ const
MINIBROWSER_CONTEXTMENU_MUTEAUDIO = MENU_ID_USER_FIRST + 13;
MINIBROWSER_CONTEXTMENU_UNMUTEAUDIO = MENU_ID_USER_FIRST + 14;
DEVTOOLS_SCREENSHOT_MSGID = 1;
DEVTOOLS_MHTML_MSGID = 2;
type
TMiniBrowserFrm = class(TForm)
NavControlPnl: TPanel;
@@ -215,9 +218,7 @@ type
procedure SaveasMHTML1Click(Sender: TObject);
protected
FDevToolsMsgID : integer;
FScreenshotMsgID : integer;
FMHTMLMsgID : integer;
FPendingMsgID : integer;
FDevToolsMsgValue : ustring;
FShutdownReason : string;
FHasShutdownReason : boolean;
@@ -1252,8 +1253,7 @@ begin
FNavigation := TStringList.Create;
FSelectCertCallback := nil;
FCertificates := nil;
FDevToolsMsgID := 0;
FPendingMsgID := 0;
// Windows may show this text message while shutting down the operating system
FShutdownReason := 'MiniBrowser closing...';
@@ -1368,9 +1368,8 @@ end;
procedure TMiniBrowserFrm.akescreenshot1Click(Sender: TObject);
begin
inc(FDevToolsMsgID);
FScreenshotMsgID := FDevToolsMsgID;
Chromium1.ExecuteDevToolsMethod(FScreenshotMsgID, 'Page.captureScreenshot', nil);
FPendingMsgID := DEVTOOLS_SCREENSHOT_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Page.captureScreenshot', nil);
end;
procedure TMiniBrowserFrm.Chromium1DevToolsMethodResult( Sender : TObject;
@@ -1430,7 +1429,7 @@ begin
end;
end;
PostMessage(Handle, MINIBROWSER_DTDATA_AVLBL, TempResult, message_id);
PostMessage(Handle, MINIBROWSER_DTDATA_AVLBL, TempResult, 0);
end;
procedure TMiniBrowserFrm.DevToolsDataAvailableMsg(var aMessage : TMessage);
@@ -1445,23 +1444,25 @@ begin
begin
TempData := nil;
if (aMessage.LParam = FScreenshotMsgID) then
begin
SaveDialog1.DefaultExt := 'png';
SaveDialog1.Filter := 'PNG files (*.png)|*.PNG';
{$IFDEF DELPHI21_UP}
// TO-DO: TNetEncoding was a new feature in Delphi XE7. Replace
// TNetEncoding.Base64.DecodeStringToBytes with Soap.EncdDecd.DecodeBase64 for older Delphi versions
TempData := TNetEncoding.Base64.DecodeStringToBytes(FDevToolsMsgValue);
{$ENDIF}
end
else
if (aMessage.LParam = FMHTMLMsgID) then
case FPendingMsgID of
DEVTOOLS_SCREENSHOT_MSGID :
begin
SaveDialog1.DefaultExt := 'png';
SaveDialog1.Filter := 'PNG files (*.png)|*.PNG';
{$IFDEF DELPHI21_UP}
// TO-DO: TNetEncoding was a new feature in Delphi XE7. Replace
// TNetEncoding.Base64.DecodeStringToBytes with Soap.EncdDecd.DecodeBase64 for older Delphi versions
TempData := TNetEncoding.Base64.DecodeStringToBytes(FDevToolsMsgValue);
{$ENDIF}
end;
DEVTOOLS_MHTML_MSGID :
begin
SaveDialog1.DefaultExt := 'mhtml';
SaveDialog1.Filter := 'MHTML files (*.mhtml)|*.MHTML';
TempData := BytesOf(FDevToolsMsgValue);
end
end;
else
begin
SaveDialog1.DefaultExt := '';
@@ -1472,8 +1473,10 @@ begin
TempData := TNetEncoding.Base64.DecodeStringToBytes(FDevToolsMsgValue);
{$ENDIF}
end;
end;
TempLen := length(TempData);
FPendingMsgID := 0;
TempLen := length(TempData);
if (TempLen > 0) then
begin
@@ -1722,11 +1725,10 @@ var
TempParams : ICefDictionaryValue;
begin
try
inc(FDevToolsMsgID);
FMHTMLMsgID := FDevToolsMsgID;
TempParams := TCefDictionaryValueRef.New;
TempParams.SetString('format', 'mhtml');
Chromium1.ExecuteDevToolsMethod(FMHTMLMsgID, 'Page.captureSnapshot', TempParams);
FPendingMsgID := DEVTOOLS_MHTML_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Page.captureSnapshot', TempParams);
finally
TempParams := nil;
end;

18
demos/Delphi_VCL/MobileBrowser/MobileBrowser.dproj
View File

@@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{55E00327-9D98-4DA3-A4E1-844942A01C6B}</ProjectGuid>
<ProjectVersion>19.3</ProjectVersion>
<ProjectVersion>19.4</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>MobileBrowser.dpr</MainSource>
<Base>True</Base>
@@ -164,13 +164,13 @@
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="Win32\Debug\SimpleBrowser.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployFile LocalName="..\..\bin\MobileBrowser.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>MobileBrowser.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\Debug\SimpleBrowser.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
@@ -1296,17 +1296,17 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
</Deployment>
<Platforms>
<Platform value="Win32">True</Platform>

24
demos/Delphi_VCL/MobileBrowser/uMobileBrowser.pas
View File

@@ -110,6 +110,8 @@ type
FCanClose : boolean; // Set to True in TChromium.OnBeforeClose
FClosing : boolean; // Set to True in the CloseQuery event.
FPendingMsgID : integer;
// 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;
@@ -171,8 +173,9 @@ end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FCanClose := False;
FClosing := False;
FCanClose := False;
FClosing := False;
FPendingMsgID := 0;
Chromium1.DefaultURL := AddressEdt.Text;
end;
@@ -189,7 +192,8 @@ end;
procedure TForm1.CanEmulateBtnClick(Sender: TObject);
begin
Chromium1.ExecuteDevToolsMethod(DEVTOOLS_CANEMULATE_MSGID, 'Emulation.canEmulate', nil);
FPendingMsgID := DEVTOOLS_CANEMULATE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.canEmulate', nil);
end;
procedure TForm1.Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
@@ -228,7 +232,7 @@ procedure TForm1.Chromium1DevToolsMethodResult(Sender: TObject;
const browser: ICefBrowser; message_id: Integer; success: Boolean;
const result: ICefValue);
begin
case message_id of
case FPendingMsgID of
DEVTOOLS_SETUSERAGENTOVERRIDE_MSGID : HandleSetUserAgentResult(success, result);
DEVTOOLS_SETTOUCHEMULATIONENABLED_MSGID : HandleSetTouchEmulationEnabledResult(success, result);
DEVTOOLS_CANEMULATE_MSGID : HandleCanEmulateResult(success, result);
@@ -248,7 +252,8 @@ end;
procedure TForm1.ClearDeviceMetricsOverrideBtnClick(Sender: TObject);
begin
Chromium1.ExecuteDevToolsMethod(DEVTOOLS_CLEARDEVICEMETRICSOVERRIDE_MSGID, 'Emulation.clearDeviceMetricsOverride', nil);
FPendingMsgID := DEVTOOLS_CLEARDEVICEMETRICSOVERRIDE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.clearDeviceMetricsOverride', nil);
end;
procedure TForm1.EmulateTouchChkClick(Sender: TObject);
@@ -262,7 +267,8 @@ begin
if EmulateTouchChk.Checked then
TempParams.SetInt('maxTouchPoints', 2);
Chromium1.ExecuteDevToolsMethod(DEVTOOLS_SETTOUCHEMULATIONENABLED_MSGID, 'Emulation.setTouchEmulationEnabled', TempParams);
FPendingMsgID := DEVTOOLS_SETTOUCHEMULATIONENABLED_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.setTouchEmulationEnabled', TempParams);
finally
TempParams := nil;
end;
@@ -314,7 +320,8 @@ begin
TempDict.SetInt('angle', AngleEdt.Value);
TempParams.SetDictionary('screenOrientation', TempDict);
Chromium1.ExecuteDevToolsMethod(DEVTOOLS_SETDEVICEMETRICSOVERRIDE_MSGID, 'Emulation.setDeviceMetricsOverride', TempParams);
FPendingMsgID := DEVTOOLS_SETDEVICEMETRICSOVERRIDE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.setDeviceMetricsOverride', TempParams);
finally
TempDict := nil;
TempParams := nil;
@@ -329,7 +336,8 @@ begin
TempParams := TCefDictionaryValueRef.New;
TempParams.SetString('userAgent', UserAgentCb.Text);
Chromium1.ExecuteDevToolsMethod(DEVTOOLS_SETUSERAGENTOVERRIDE_MSGID, 'Emulation.setUserAgentOverride', TempParams);
FPendingMsgID := DEVTOOLS_SETUSERAGENTOVERRIDE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.setUserAgentOverride', TempParams);
finally
TempParams := nil;
end;

2
demos/Lazarus_Linux/MobileBrowser/00-Delete.bat Normal file
View File

@@ -0,0 +1,2 @@
rmdir /S /Q lib
rmdir /S /Q backup

97
demos/Lazarus_Linux/MobileBrowser/MobileBrowser.lpi Normal file
View File

@@ -0,0 +1,97 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="MobileBrowser"/>
<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>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="MobileBrowser.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="uMobileBrowser.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
<Unit>
<Filename Value="..\..\..\source\uCEFApplication.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="..\..\..\bin\MobileBrowser"/>
</Target>
<SearchPaths>
<IncludeFiles Value="..\..\..\source;$(ProjOutDir)"/>
<OtherUnitFiles Value="..\..\..\source"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<SyntaxMode Value="Delphi"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CustomOptions Value="-dUseCThreads"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

72
demos/Lazarus_Linux/MobileBrowser/MobileBrowser.lpr Normal file
View File

@@ -0,0 +1,72 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2018 Salvador Díaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
program MobileBrowser;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, uCEFApplication, uCEFConstants,
uMobileBrowser in 'uMobileBrowser.pas' {Form1};
{.$R *.res}
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
// The LCL Widgetset must be initialized after the CEF initialization and
// only in the browser process.
CustomWidgetSetInitialization;
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
CustomWidgetSetFinalization;
end;
DestroyGlobalCEFApp;
end.

507
demos/Lazarus_Linux/MobileBrowser/cef.inc Normal file
View File

@@ -0,0 +1,507 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright � 2017 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
// The complete list of compiler versions is here :
// http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Compiler_Versions
{$DEFINE DELPHI_VERSION_UNKNOW}
// Delphi 5
{$IFDEF VER130}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$ENDIF}
// Delphi 6
{$IFDEF VER140}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$ENDIF}
// Delphi 7
{$IFDEF VER150}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$ENDIF}
// Delphi 8
{$IFDEF VER160}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$ENDIF}
// Delphi 2005
{$IFDEF VER170}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$ENDIF}
{$IFDEF VER180}
{$UNDEF DELPHI_VERSION_UNKNOW}
// Delphi 2007
{$IFDEF VER185}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
// Delphi 2006
{$ELSE}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$ENDIF}
{$ENDIF}
// Delphi 2009
{$IFDEF VER200}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$ENDIF}
//Delphi 2010
{$IFDEF VER210}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$ENDIF}
// Delphi XE
{$IFDEF VER220}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$ENDIF}
// Delphi XE2 (First FireMonkey and 64bit compiler)
{$IFDEF VER230}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$ENDIF}
// Delphi XE3
{$IFDEF VER240}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$ENDIF}
// Delphi XE4
{$IFDEF VER250}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$ENDIF}
// Delphi XE5
{$IFDEF VER260}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$ENDIF}
// Delphi XE6
{$IFDEF VER270}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$ENDIF}
// Delphi XE7
{$IFDEF VER280}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$ENDIF}
// Delphi XE8
{$IFDEF VER290}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$ENDIF VER290}
// Rad Studio 10 - Delphi Seattle
{$IFDEF VER300}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$ENDIF}
// Rad Studio 10.1 - Delphi Berlin
{$IFDEF VER310}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$ENDIF}
// Rad Studio 10.2 - Delphi Tokyo
{$IFDEF VER320}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$ENDIF}
// Rad Studio 10.3 - Delphi Rio
{$IFDEF VER330}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$DEFINE DELPHI26_UP}
{$ENDIF}
// Rad Studio 10.4 - Delphi Sydney
{$IFDEF VER340}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$DEFINE DELPHI26_UP}
{$DEFINE DELPHI27_UP}
{$ENDIF}
// Rad Studio 11.0 - Delphi Alexandria
{$IFDEF VER350}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$DEFINE DELPHI26_UP}
{$DEFINE DELPHI27_UP}
{$DEFINE DELPHI28_UP}
{$ENDIF}
{$IFDEF FPC}
{$DEFINE SUPPORTS_INLINE}
{$IF DEFINED(FPC_FULLVERSION) AND (FPC_FULLVERSION >= 30200)}
{$DEFINE FPC_VER_320}
{$IFEND}
{$ELSE}
{$IFDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$DEFINE DELPHI26_UP}
{$DEFINE DELPHI27_UP}
{$DEFINE DELPHI28_UP}
{$ENDIF}
{$ENDIF}
{$IFDEF DELPHI9_UP}
{$DEFINE SUPPORTS_INLINE}
{$ENDIF}
{$IF DEFINED(CPUX32) OR
DEFINED(CPU32) OR
DEFINED(CPU32BITS) OR
DEFINED(CPUARM32) OR
DEFINED(WIN32) OR
DEFINED(IOS32) OR
DEFINED(MACOS32) OR
DEFINED(LINUX32) OR
DEFINED(POSIX32) OR
DEFINED(ANDROID32)}
{$DEFINE TARGET_32BITS}
{$ELSE}
{$IF DEFINED(CPUX64) OR
DEFINED(CPU64) OR
DEFINED(CPU64BITS) OR
DEFINED(CPUARM64) OR
DEFINED(WIN64) OR
DEFINED(IOS64) OR
DEFINED(MACOS64) OR
DEFINED(LINUX64) OR
DEFINED(POSIX64) OR
DEFINED(ANDROID64)}
{$DEFINE TARGET_64BITS}
{$IFEND}
{$IFEND}
// Delphi uses MACOS for the new MacOSX and DARWIN is not defined
// FPC uses DARWIN for the new MacOSX and MACOS is defined for the classic Macintosh OS (System 7)
// We define MACOSX to avoid conflicts in both situations
{$IFDEF FPC}
{$IFDEF DARWIN}
{$DEFINE MACOSX}
{$ENDIF}
{$ELSE}
{$IFDEF MACOS}
{$DEFINE MACOSX}
{$ENDIF}
{$ENDIF}

48
demos/Lazarus_Linux/MobileBrowser/interfaces.pas Normal file
View File

@@ -0,0 +1,48 @@
unit Interfaces;
{$mode objfpc}{$H+}
interface
{$IFDEF UNIX}{$IFNDEF DisableCWString}uses cwstring;{$ENDIF}{$ENDIF}
procedure CustomWidgetSetInitialization;
procedure CustomWidgetSetFinalization;
implementation
uses
{$IFNDEF EnableLibOverlay}
gtk2DisableLibOverlay,
{$ENDIF}
Gtk2Int, Forms, xlib;
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
CreateWidgetset(TGtk2WidgetSet);
// 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.

419
demos/Lazarus_Linux/MobileBrowser/uMobileBrowser.lfm Normal file
View File

@@ -0,0 +1,419 @@
object Form1: TForm1
Left = 482
Height = 624
Top = 348
Width = 1038
Caption = 'Initializing browser. Please wait...'
ClientHeight = 624
ClientWidth = 1038
Color = clBtnFace
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
OnActivate = FormActivate
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '2.2.0.4'
object Splitter1: TSplitter
Left = 739
Height = 624
Top = 0
Width = 5
Align = alRight
MinSize = 220
ResizeAnchor = akRight
end
object Panel1: TPanel
Left = 744
Height = 624
Top = 0
Width = 294
Align = alRight
BevelOuter = bvNone
ClientHeight = 624
ClientWidth = 294
TabOrder = 0
object LogMem: TMemo
Left = 0
Height = 258
Top = 366
Width = 294
Align = alClient
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 0
end
object Panel3: TPanel
Left = 0
Height = 57
Top = 0
Width = 294
Align = alTop
BevelOuter = bvNone
ClientHeight = 57
ClientWidth = 294
TabOrder = 1
object CanEmulateBtn: TButton
Left = 0
Height = 25
Top = 0
Width = 294
Align = alTop
Caption = 'Can emulate'
OnClick = CanEmulateBtnClick
TabOrder = 0
end
object ClearDeviceMetricsOverrideBtn: TButton
Left = 0
Height = 25
Top = 32
Width = 294
Align = alBottom
Caption = 'Clear device metrics override'
OnClick = ClearDeviceMetricsOverrideBtnClick
TabOrder = 1
end
end
object Panel4: TPanel
Left = 0
Height = 104
Top = 57
Width = 294
Align = alTop
BevelOuter = bvNone
ClientHeight = 104
ClientWidth = 294
TabOrder = 2
object GroupBox1: TGroupBox
Left = 0
Height = 75
Top = 0
Width = 294
Align = alTop
Caption = ' User agent '
ClientHeight = 60
ClientWidth = 292
TabOrder = 0
object UserAgentCb: TComboBox
Left = 0
Height = 27
Top = 0
Width = 292
Align = alTop
ItemHeight = 0
ItemIndex = 0
Items.Strings = (
'Mozilla/5.0 (Linux; Android 11; M2102K1G) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/91.0.4472.101 Mobile Safari/537.36'
'Mozilla/5.0 (iPhone; CPU iPhone OS 10_3_1 like Mac OS X) AppleWebKit/603.1.30 (KHTML, like Gecko) Version/10.0 Mobile/14E304 Safari/602.1'
'Mozilla/5.0 (Linux; U; Android 4.4.2; en-us; SCH-I535 Build/KOT49H) AppleWebKit/534.30 (KHTML, like Gecko) Version/4.0 Mobile Safari/534.30'
'Mozilla/5.0 (Linux; Android 7.0; SM-G930V Build/NRD90M) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/59.0.3071.125 Mobile Safari/537.36'
'Mozilla/5.0 (Linux; Android 7.0; SM-A310F Build/NRD90M) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/55.0.2883.91 Mobile Safari/537.36 OPR/42.7.2246.114996'
'Opera/9.80 (Android 4.1.2; Linux; Opera Mobi/ADR-1305251841) Presto/2.11.355 Version/12.10'
'Opera/9.80 (J2ME/MIDP; Opera Mini/5.1.21214/28.2725; U; ru) Presto/2.8.119 Version/11.10'
'Mozilla/5.0 (iPhone; CPU iPhone OS 7_1_2 like Mac OS X) AppleWebKit/537.51.2 (KHTML, like Gecko) OPiOS/10.2.0.93022 Mobile/11D257 Safari/9537.53'
'Mozilla/5.0 (Android 7.0; Mobile; rv:54.0) Gecko/54.0 Firefox/54.0'
'Mozilla/5.0 (iPhone; CPU iPhone OS 10_3_2 like Mac OS X) AppleWebKit/603.2.4 (KHTML, like Gecko) FxiOS/7.5b3349 Mobile/14F89 Safari/603.2.4'
'Mozilla/5.0 (Linux; U; Android 7.0; en-US; SM-G935F Build/NRD90M) AppleWebKit/534.30 (KHTML, like Gecko) Version/4.0 UCBrowser/11.3.8.976 U3/0.8.0 Mobile Safari/534.30'
'Mozilla/5.0 (Linux; Android 6.0.1; SM-G920V Build/MMB29K) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/52.0.2743.98 Mobile Safari/537.36'
'Mozilla/5.0 (Linux; Android 5.1.1; SM-N750K Build/LMY47X; ko-kr) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/42.0.2311.135 Mobile Safari/537.36 Puffin/6.0.8.15804AP'
'Mozilla/5.0 (Linux; Android 5.1.1; SM-N750K Build/LMY47X; ko-kr) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/42.0.2311.135 Mobile Safari/537.36 Puffin/6.0.8.15804AP'
'Mozilla/5.0 (Linux; Android 7.0; SAMSUNG SM-G955U Build/NRD90M) AppleWebKit/537.36 (KHTML, like Gecko) SamsungBrowser/5.4 Chrome/51.0.2704.106 Mobile Safari/537.36'
'Mozilla/5.0 (Linux; Android 6.0; Lenovo K50a40 Build/MRA58K) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/57.0.2987.137 YaBrowser/17.4.1.352.00 Mobile Safari/537.36'
'Mozilla/5.0 (Linux; U; Android 7.0; en-us; MI 5 Build/NRD90M) AppleWebKit/537.36 (KHTML, like Gecko) Version/4.0 Chrome/53.0.2785.146 Mobile Safari/537.36 XiaoMi/MiuiBrowser/9.0.3'
'Mozilla/5.0 (compatible; MSIE 10.0; Windows Phone 8.0; Trident/6.0; IEMobile/10.0; ARM; Touch; Microsoft; Lumia 950)'
'Mozilla/5.0 (Windows Phone 10.0; Android 6.0.1; Microsoft; Lumia 950) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/52.0.2743.116 Mobile Safari/537.36 Edge/15.14977'
'Mozilla/5.0 (BB10; Kbd) AppleWebKit/537.35+ (KHTML, like Gecko) Version/10.3.3.2205 Mobile Safari/537.35+'
)
TabOrder = 0
Text = 'Mozilla/5.0 (Linux; Android 11; M2102K1G) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/91.0.4472.101 Mobile Safari/537.36'
end
object OverrideUserAgentBtn: TButton
Left = 0
Height = 25
Top = 35
Width = 292
Align = alBottom
Caption = 'Override user agent'
OnClick = OverrideUserAgentBtnClick
TabOrder = 1
end
end
object EmulateTouchChk: TCheckBox
Left = 0
Height = 23
Top = 81
Width = 294
Align = alBottom
Caption = 'Emulate Touch'
OnClick = EmulateTouchChkClick
TabOrder = 1
end
end
object Panel5: TPanel
Left = 0
Height = 205
Top = 161
Width = 294
Align = alTop
BevelOuter = bvNone
ClientHeight = 205
ClientWidth = 294
TabOrder = 3
object GroupBox2: TGroupBox
Left = 0
Height = 205
Top = 0
Width = 294
Align = alClient
Caption = ' Emulate device metrics '
ClientHeight = 190
ClientWidth = 292
TabOrder = 0
object Panel6: TPanel
Left = 0
Height = 27
Top = 27
Width = 292
Align = alTop
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 292
TabOrder = 0
object Label1: TLabel
Left = 0
Height = 27
Top = 0
Width = 75
Align = alLeft
AutoSize = False
Caption = 'Height'
Layout = tlCenter
end
object HeightEdt: TSpinEdit
Left = 75
Height = 27
Top = 0
Width = 217
Align = alClient
MaxValue = 10000000
TabOrder = 0
end
end
object Panel7: TPanel
Left = 0
Height = 27
Top = 0
Width = 292
Align = alTop
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 292
TabOrder = 1
object Label2: TLabel
Left = 0
Height = 27
Top = 0
Width = 75
Align = alLeft
AutoSize = False
Caption = 'Width'
Layout = tlCenter
end
object WidthEdt: TSpinEdit
Left = 75
Height = 27
Top = 0
Width = 217
Align = alClient
MaxValue = 10000000
TabOrder = 0
end
end
object OverrideDeviceMetricsBtn: TButton
Left = 0
Height = 25
Top = 165
Width = 292
Align = alBottom
Caption = 'Override device metrics'
OnClick = OverrideDeviceMetricsBtnClick
TabOrder = 2
end
object Panel8: TPanel
Left = 0
Height = 27
Top = 54
Width = 292
Align = alTop
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 292
TabOrder = 3
object Label3: TLabel
Left = 0
Height = 27
Top = 0
Width = 75
Align = alLeft
AutoSize = False
Caption = 'Scale'
Layout = tlCenter
end
object ScaleEdt: TMaskEdit
Left = 75
Height = 27
Top = 0
Width = 217
Align = alClient
MaxLength = 4
TabOrder = 0
EditMask = '#.##;1;0'
Text = '1. '
SpaceChar = '0'
end
end
object Panel9: TPanel
Left = 0
Height = 27
Top = 81
Width = 292
Align = alTop
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 292
TabOrder = 4
object Label4: TLabel
Left = 0
Height = 27
Top = 0
Width = 75
Align = alLeft
AutoSize = False
Caption = 'Orientation'
Layout = tlCenter
end
object OrientationCb: TComboBox
Left = 75
Height = 27
Top = 0
Width = 217
Align = alClient
ItemHeight = 0
ItemIndex = 0
Items.Strings = (
'Portrait Primary'
'Portrait Secondary'
'Landscape Primary'
'Landscape Secondary'
)
Style = csDropDownList
TabOrder = 0
Text = 'Portrait Primary'
end
end
object Panel10: TPanel
Left = 0
Height = 27
Top = 108
Width = 292
Align = alTop
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 292
TabOrder = 5
object Label5: TLabel
Left = 0
Height = 27
Top = 0
Width = 75
Align = alLeft
AutoSize = False
Caption = 'Angle'
Layout = tlCenter
end
object AngleEdt: TSpinEdit
Left = 75
Height = 27
Top = 0
Width = 217
Align = alClient
MaxValue = 360
TabOrder = 0
end
end
end
end
end
object Panel2: TPanel
Left = 0
Height = 624
Top = 0
Width = 739
Align = alClient
BevelOuter = bvNone
ClientHeight = 624
ClientWidth = 739
TabOrder = 1
object AddressPnl: TPanel
Left = 0
Height = 23
Top = 0
Width = 739
Align = alTop
BevelOuter = bvNone
ClientHeight = 23
ClientWidth = 739
Enabled = False
TabOrder = 0
object AddressEdt: TEdit
Left = 0
Height = 23
Top = 0
Width = 708
Align = alClient
TabOrder = 0
Text = 'http://www.google.com'
end
object GoBtn: TButton
Left = 708
Height = 23
Top = 0
Width = 31
Align = alRight
Caption = 'Go'
OnClick = GoBtnClick
TabOrder = 1
end
end
object CEFLinkedWindowParent1: TCEFLinkedWindowParent
Left = 0
Height = 601
Top = 23
Width = 739
Align = alClient
TabOrder = 1
OnEnter = CEFLinkedWindowParent1Enter
OnExit = CEFLinkedWindowParent1Exit
Chromium = Chromium1
end
end
object Timer1: TTimer
Enabled = False
Interval = 300
OnTimer = Timer1Timer
Left = 56
Top = 88
end
object Chromium1: TChromium
OnGotFocus = Chromium1GotFocus
OnBeforePopup = Chromium1BeforePopup
OnAfterCreated = Chromium1AfterCreated
OnBeforeClose = Chromium1BeforeClose
OnClose = Chromium1Close
OnOpenUrlFromTab = Chromium1OpenUrlFromTab
OnDevToolsMethodResult = Chromium1DevToolsMethodResult
Left = 56
Top = 152
end
end

534
demos/Lazarus_Linux/MobileBrowser/uMobileBrowser.pas Normal file
View File

@@ -0,0 +1,534 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2022 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
unit uMobileBrowser;
{$I cef.inc}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
LMessages, MaskEdit, Spin, uCEFChromium, uCEFWindowParent, uCEFInterfaces,
uCEFConstants, uCEFTypes, uCEFJson, uCEFWinControl, uCEFSentinel,
uCEFChromiumCore, uCEFDictionaryValue, uCEFLinkedWindowParent, uCEFChromiumEvents;
type
{ TForm1 }
TForm1 = class(TForm)
CEFLinkedWindowParent1: TCEFLinkedWindowParent;
Timer1: TTimer;
Chromium1: TChromium;
Panel1: TPanel;
Panel2: TPanel;
AddressPnl: TPanel;
AddressEdt: TEdit;
GoBtn: TButton;
Splitter1: TSplitter;
LogMem: TMemo;
Panel3: TPanel;
CanEmulateBtn: TButton;
ClearDeviceMetricsOverrideBtn: TButton;
Panel4: TPanel;
GroupBox1: TGroupBox;
UserAgentCb: TComboBox;
OverrideUserAgentBtn: TButton;
EmulateTouchChk: TCheckBox;
Panel5: TPanel;
GroupBox2: TGroupBox;
Panel6: TPanel;
Label1: TLabel;
HeightEdt: TSpinEdit;
Panel7: TPanel;
Label2: TLabel;
WidthEdt: TSpinEdit;
OverrideDeviceMetricsBtn: TButton;
Panel8: TPanel;
Label3: TLabel;
ScaleEdt: TMaskEdit;
Panel9: TPanel;
Label4: TLabel;
OrientationCb: TComboBox;
Panel10: TPanel;
Label5: TLabel;
AngleEdt: TSpinEdit;
procedure Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
procedure Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser);
procedure Chromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction: TCefCloseBrowserAction);
procedure Chromium1BeforePopup(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 Chromium1GotFocus(Sender: TObject; const browser: ICefBrowser);
procedure Chromium1OpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; out Result: Boolean);
procedure Chromium1DevToolsMethodResult(Sender: TObject; const browser: ICefBrowser; message_id: Integer; success: Boolean; const result: ICefValue);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure GoBtnClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure CEFLinkedWindowParent1Enter(Sender: TObject);
procedure CEFLinkedWindowParent1Exit(Sender: TObject);
procedure CanEmulateBtnClick(Sender: TObject);
procedure OverrideUserAgentBtnClick(Sender: TObject);
procedure EmulateTouchChkClick(Sender: TObject);
procedure ClearDeviceMetricsOverrideBtnClick(Sender: TObject);
procedure OverrideDeviceMetricsBtnClick(Sender: TObject);
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.
FPendingMsgID : integer;
// You have to handle this two messages to call NotifyMoveOrResizeStarted or some page elements will be misaligned.
procedure WMMove(var Message: TLMMove); message LM_MOVE;
procedure WMSize(var Message: TLMSize); message LM_SIZE;
procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
procedure SendCompMessage(aMsg : cardinal);
procedure BrowserCreatedMsg(Data: PtrInt);
procedure BrowserCloseFormMsg(Data: PtrInt);
procedure BrowserSetFocusMsg(Data: PtrInt);
procedure HandleSetUserAgentResult(aSuccess : boolean; const aResult: ICefValue);
procedure HandleSetTouchEmulationEnabledResult(aSuccess : boolean; const aResult: ICefValue);
procedure HandleCanEmulateResult(aSuccess : boolean; const aResult: ICefValue);
procedure HandleClearDeviceMetricsOverrideResult(aSuccess : boolean; const aResult: ICefValue);
procedure HandleSetDeviceMetricsOverrideResult(aSuccess : boolean; const aResult: ICefValue);
procedure HandleSetUserAgentResultMsg(Data: PtrInt);
procedure HandleSetTouchEmulationEnabledResultMsg(Data: PtrInt);
procedure HandleCanEmulateResultMsg(Data: PtrInt);
procedure HandleClearDeviceMetricsOverrideResultMsg(Data: PtrInt);
procedure HandleSetDeviceMetricsOverrideResultMsg(Data: PtrInt);
public
{ Public declarations }
end;
var
Form1: TForm1;
procedure CreateGlobalCEFApp;
implementation
{$R *.lfm}
uses
uCEFApplication, uCEFMiscFunctions;
// This demo allows you to emulate a mobile browser using the "Emulation" namespace of the DevTools.
// It's necesary to reload the browser after using the controls in the right panel.
// This demo uses a TChromium and a TCEFWindowParent
// Destruction steps
// =================
// 1. FormCloseQuery sets CanClose to FALSE calls TChromium.CloseBrowser which triggers the TChromium.OnClose event.
// 2. TChromium.OnClose sends a CEFBROWSER_DESTROY message to destroy CEFWindowParent1 in the main thread, which triggers the TChromium.OnBeforeClose event.
// 3. TChromium.OnBeforeClose sets FCanClose := True and sends WM_CLOSE to the form.
const
CEF_SETFOCUS = 1;
DEVTOOLS_SETUSERAGENTOVERRIDE_MSGID = 1;
DEVTOOLS_SETTOUCHEMULATIONENABLED_MSGID = 2;
DEVTOOLS_CANEMULATE_MSGID = 3;
DEVTOOLS_CLEARDEVICEMETRICSOVERRIDE_MSGID = 4;
DEVTOOLS_SETDEVICEMETRICSOVERRIDE_MSGID = 5;
CANEMULATE_RESULT_FAIL = 0;
CANEMULATE_RESULT_SUCCESS_SUPPORTED = 1;
CANEMULATE_RESULT_SUCCESS_UNSUPPORTED = 2;
procedure CreateGlobalCEFApp;
begin
GlobalCEFApp := TCefApplication.Create;
{
GlobalCEFApp.LogFile := 'cef.log';
GlobalCEFApp.LogSeverity := LOGSEVERITY_VERBOSE;
}
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FCanClose := False;
FClosing := False;
FPendingMsgID := 0;
Chromium1.DefaultURL := UTF8Decode(AddressEdt.Text);
end;
procedure TForm1.GoBtnClick(Sender: TObject);
begin
Chromium1.LoadURL(UTF8Decode(AddressEdt.Text));
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(Chromium1.CreateBrowser(CEFLinkedWindowParent1.Handle, CEFLinkedWindowParent1.BoundsRect)) and
not(Chromium1.Initialized) then
Timer1.Enabled := True;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
CanClose := FCanClose;
if not(FClosing) then
begin
FClosing := True;
Visible := False;
Chromium1.CloseBrowser(True);
end;
end;
procedure TForm1.Chromium1BeforePopup(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
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, 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 [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
// 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.
// Linux needs a visible form to create a browser so we need to use the
// TForm.OnActivate event instead of the TForm.OnShow event
if not(Chromium1.Initialized) and
not(Chromium1.CreateBrowser(CEFLinkedWindowParent1.Handle, CEFLinkedWindowParent1.BoundsRect)) then
Timer1.Enabled := True;
end;
procedure TForm1.Chromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction: TCefCloseBrowserAction);
begin
// continue closing the browser
aAction := cbaClose;
end;
procedure TForm1.Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser);
begin
// We must wait until all browsers trigger the TChromium.OnBeforeClose event
// in order to close the application safely or we will have shutdown issues.
FCanClose := True;
SendCompMessage(CEF_BEFORECLOSE);
end;
procedure TForm1.Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
begin
// Now the browser is fully initialized we can initialize the UI.
SendCompMessage(CEF_AFTERCREATED);
end;
// This is a workaround for the CEF issue #2026
// https://bitbucket.org/chromiumembedded/cef/issues/2026/multiple-major-keyboard-focus-issues-on
// We use CEFLinkedWindowParent1.OnEnter, CEFLinkedWindowParent1.OnExit and
// TChromium.OnGotFocus to avoid most of the focus issues.
// CEFLinkedWindowParent1.TabStop must be TRUE.
procedure TForm1.CEFLinkedWindowParent1Exit(Sender: TObject);
begin
if not(csDesigning in ComponentState) then
Chromium1.SendCaptureLostEvent;
end;
procedure TForm1.CEFLinkedWindowParent1Enter(Sender: TObject);
begin
if not(csDesigning in ComponentState) and
Chromium1.Initialized and
not(Chromium1.FrameIsFocused) then
Chromium1.SetFocus(True);
end;
procedure TForm1.Chromium1GotFocus(Sender: TObject; const browser: ICefBrowser);
begin
SendCompMessage(CEF_SETFOCUS);
end;
procedure TForm1.BrowserCreatedMsg(Data: PtrInt);
begin
Caption := 'Mobile Browser';
AddressPnl.Enabled := True;
end;
procedure TForm1.BrowserCloseFormMsg(Data: PtrInt);
begin
Close;
end;
procedure TForm1.BrowserSetFocusMsg(Data: PtrInt);
begin
CEFLinkedWindowParent1.SetFocus;
end;
procedure TForm1.SendCompMessage(aMsg : cardinal);
begin
case aMsg of
CEF_AFTERCREATED : Application.QueueAsyncCall(BrowserCreatedMsg, 0);
CEF_BEFORECLOSE : Application.QueueAsyncCall(BrowserCloseFormMsg, 0);
CEF_SETFOCUS : Application.QueueAsyncCall(BrowserSetFocusMsg, 0);
end;
end;
procedure TForm1.WMMove(var Message: TLMMove);
begin
inherited;
Chromium1.NotifyMoveOrResizeStarted;
end;
procedure TForm1.WMSize(var Message: TLMSize);
begin
inherited;
Chromium1.NotifyMoveOrResizeStarted;
end;
procedure TForm1.WMWindowPosChanged(var Message: TLMWindowPosChanged);
begin
inherited;
Chromium1.NotifyMoveOrResizeStarted;
end;
procedure TForm1.CanEmulateBtnClick(Sender: TObject);
begin
FPendingMsgID := DEVTOOLS_CANEMULATE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.canEmulate', nil);
end;
procedure TForm1.Chromium1DevToolsMethodResult(Sender: TObject;
const browser: ICefBrowser; message_id: Integer; success: Boolean;
const result: ICefValue);
begin
case FPendingMsgID of
DEVTOOLS_SETUSERAGENTOVERRIDE_MSGID : HandleSetUserAgentResult(success, result);
DEVTOOLS_SETTOUCHEMULATIONENABLED_MSGID : HandleSetTouchEmulationEnabledResult(success, result);
DEVTOOLS_CANEMULATE_MSGID : HandleCanEmulateResult(success, result);
DEVTOOLS_CLEARDEVICEMETRICSOVERRIDE_MSGID : HandleClearDeviceMetricsOverrideResult(success, result);
DEVTOOLS_SETDEVICEMETRICSOVERRIDE_MSGID : HandleSetDeviceMetricsOverrideResult(success, result);
end;
end;
procedure TForm1.ClearDeviceMetricsOverrideBtnClick(Sender: TObject);
begin
FPendingMsgID := DEVTOOLS_CLEARDEVICEMETRICSOVERRIDE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.clearDeviceMetricsOverride', nil);
end;
procedure TForm1.EmulateTouchChkClick(Sender: TObject);
var
TempParams : ICefDictionaryValue;
begin
try
TempParams := TCefDictionaryValueRef.New;
TempParams.SetBool('enabled', EmulateTouchChk.Checked);
if EmulateTouchChk.Checked then
TempParams.SetInt('maxTouchPoints', 2);
FPendingMsgID := DEVTOOLS_SETTOUCHEMULATIONENABLED_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.setTouchEmulationEnabled', TempParams);
finally
TempParams := nil;
end;
end;
procedure TForm1.OverrideDeviceMetricsBtnClick(Sender: TObject);
var
TempParams, TempDict : ICefDictionaryValue;
TempFormatSettings : TFormatSettings;
TempOrientation : string;
begin
try
TempParams := TCefDictionaryValueRef.New;
TempParams.SetInt('width', WidthEdt.Value);
TempParams.SetInt('height', HeightEdt.Value);
TempFormatSettings.DecimalSeparator := '.';
TempParams.SetDouble('deviceScaleFactor', StrToFloat(ScaleEdt.Text, TempFormatSettings));
TempParams.SetBool('mobile', True);
case OrientationCb.ItemIndex of
0 : TempOrientation := 'portraitPrimary';
1 : TempOrientation := 'portraitSecondary';
2 : TempOrientation := 'landscapePrimary';
else TempOrientation := 'landscapeSecondary';
end;
TempDict := TCefDictionaryValueRef.New;
TempDict.SetString('type', TempOrientation);
TempDict.SetInt('angle', AngleEdt.Value);
TempParams.SetDictionary('screenOrientation', TempDict);
FPendingMsgID := DEVTOOLS_SETDEVICEMETRICSOVERRIDE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.setDeviceMetricsOverride', TempParams);
finally
TempDict := nil;
TempParams := nil;
end;
end;
procedure TForm1.OverrideUserAgentBtnClick(Sender: TObject);
var
TempParams : ICefDictionaryValue;
begin
try
TempParams := TCefDictionaryValueRef.New;
TempParams.SetString('userAgent', UserAgentCb.Text);
FPendingMsgID := DEVTOOLS_SETUSERAGENTOVERRIDE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.setUserAgentOverride', TempParams);
finally
TempParams := nil;
end;
end;
procedure TForm1.HandleSetUserAgentResultMsg(Data: PtrInt);
begin
if (Data <> 0) then
LogMem.Lines.Add('Successful SetUserAgentOverride')
else
LogMem.Lines.Add('Unsuccessful SetUserAgentOverride');
end;
procedure TForm1.HandleSetTouchEmulationEnabledResultMsg(Data: PtrInt);
begin
if (Data <> 0) then
LogMem.Lines.Add('Successful SetTouchEmulationEnabled')
else
LogMem.Lines.Add('Unsuccessful SetTouchEmulationEnabled');
end;
procedure TForm1.HandleCanEmulateResultMsg(Data: PtrInt);
begin
case Data of
CANEMULATE_RESULT_FAIL :
LogMem.Lines.Add('Unsuccessful CanEmulate');
CANEMULATE_RESULT_SUCCESS_UNSUPPORTED :
LogMem.Lines.Add('Successful CanEmulate. Emulation is not supported.');
CANEMULATE_RESULT_SUCCESS_SUPPORTED :
LogMem.Lines.Add('Successful CanEmulate. Emulation is supported.');
end;
end;
procedure TForm1.HandleClearDeviceMetricsOverrideResultMsg(Data: PtrInt);
begin
if (Data <> 0) then
LogMem.Lines.Add('Successful ClearDeviceMetricsOverride')
else
LogMem.Lines.Add('Unsuccessful ClearDeviceMetricsOverride');
end;
procedure TForm1.HandleSetDeviceMetricsOverrideResultMsg(Data: PtrInt);
begin
if (Data <> 0) then
LogMem.Lines.Add('Successful SetDeviceMetricsOverride')
else
LogMem.Lines.Add('Unsuccessful SetDeviceMetricsOverride');
end;
procedure TForm1.HandleSetUserAgentResult(aSuccess : boolean; const aResult: ICefValue);
begin
Application.QueueAsyncCall(HandleSetUserAgentResultMsg, ord(aSuccess and (aResult <> nil)));
end;
procedure TForm1.HandleSetTouchEmulationEnabledResult(aSuccess : boolean; const aResult: ICefValue);
begin
Application.QueueAsyncCall(HandleSetTouchEmulationEnabledResultMsg, ord(aSuccess and (aResult <> nil)));
end;
procedure TForm1.HandleCanEmulateResult(aSuccess : boolean; const aResult: ICefValue);
var
TempRsltDict : ICefDictionaryValue;
TempResult : boolean;
TempData : PtrInt;
begin
if aSuccess and (aResult <> nil) then
begin
TempRsltDict := aResult.GetDictionary;
if TCEFJson.ReadBoolean(TempRsltDict, 'result', TempResult) and TempResult then
TempData := CANEMULATE_RESULT_SUCCESS_SUPPORTED
else
TempData := CANEMULATE_RESULT_SUCCESS_UNSUPPORTED;
end
else
TempData := CANEMULATE_RESULT_FAIL;
Application.QueueAsyncCall(HandleCanEmulateResultMsg, TempData);
end;
procedure TForm1.HandleClearDeviceMetricsOverrideResult(aSuccess : boolean; const aResult: ICefValue);
begin
Application.QueueAsyncCall(HandleClearDeviceMetricsOverrideResultMsg, ord(aSuccess and (aResult <> nil)));
end;
procedure TForm1.HandleSetDeviceMetricsOverrideResult(aSuccess : boolean; const aResult: ICefValue);
begin
Application.QueueAsyncCall(HandleSetDeviceMetricsOverrideResultMsg, ord(aSuccess and (aResult <> nil)));
end;
end.

23
demos/Lazarus_Windows/MiniBrowser/uMiniBrowser.pas
View File

@@ -78,7 +78,10 @@ const
MINIBROWSER_CONTEXTMENU_TAKESNAPSHOT = MENU_ID_USER_FIRST + 11;
MINIBROWSER_CONTEXTMENU_GETNAVIGATION = MENU_ID_USER_FIRST + 12;
MINIBROWSER_CONTEXTMENU_MUTEAUDIO = MENU_ID_USER_FIRST + 13;
MINIBROWSER_CONTEXTMENU_UNMUTEAUDIO = MENU_ID_USER_FIRST + 14;
MINIBROWSER_CONTEXTMENU_UNMUTEAUDIO = MENU_ID_USER_FIRST + 14;
DEVTOOLS_SCREENSHOT_MSGID = 1;
DEVTOOLS_MHTML_MSGID = 2;
type
@@ -249,8 +252,7 @@ type
FCanClose : boolean; // Set to True in TChromium.OnBeforeClose
FClosing : boolean; // Set to True in the CloseQuery event.
FDevToolsMsgID : integer;
FMHTMLMsgID : integer;
FPendingMsgID : integer;
FDevToolsMsgValue : ustring;
procedure AddURL(const aURL : string);
@@ -409,11 +411,10 @@ var
TempParams : ICefDictionaryValue;
begin
try
inc(FDevToolsMsgID);
FMHTMLMsgID := FDevToolsMsgID;
TempParams := TCefDictionaryValueRef.New;
TempParams.SetString('format', 'mhtml');
Chromium1.ExecuteDevToolsMethod(FMHTMLMsgID, 'Page.captureSnapshot', TempParams);
TempParams.SetString('format', 'mhtml');
FPendingMsgID := DEVTOOLS_MHTML_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Page.captureSnapshot', TempParams);
finally
TempParams := nil;
end;
@@ -1059,8 +1060,7 @@ begin
FResponse := TStringList.Create;
FRequest := TStringList.Create;
FNavigation := TStringList.Create;
FDevToolsMsgID := 0;
FPendingMsgID := 0;
// Windows may show this text message while shutting down the operating system
FShutdownReason := 'MiniBrowser closing...';
@@ -1162,7 +1162,7 @@ begin
end;
end;
PostMessage(Handle, MINIBROWSER_DTDATA_AVLBL, TempResult, message_id);
PostMessage(Handle, MINIBROWSER_DTDATA_AVLBL, TempResult, 0);
end;
procedure TMiniBrowserFrm.CEFWindowParent1DragDrop(Sender, Source: TObject; X,
@@ -1200,8 +1200,9 @@ var
begin
if (aMessage.WParam <> 0) then
begin
if (length(FDevToolsMsgValue) > 0) and (aMessage.LParam = FMHTMLMsgID) then
if (length(FDevToolsMsgValue) > 0) and (FPendingMsgID = DEVTOOLS_MHTML_MSGID) then
begin
FPendingMsgID := 0;
SaveDialog1.DefaultExt := 'mhtml';
SaveDialog1.Filter := 'MHTML files (*.mhtml)|*.MHTML';
TempData := BytesOf(FDevToolsMsgValue);

2
demos/Lazarus_Windows/MobileBrowser/00-Delete.bat Normal file
View File

@@ -0,0 +1,2 @@
rmdir /S /Q lib
rmdir /S /Q backup

94
demos/Lazarus_Windows/MobileBrowser/MobileBrowser.lpi Normal file
View File

@@ -0,0 +1,94 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="MobileBrowser"/>
<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>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="MobileBrowser.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="uMobileBrowser.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
<Unit>
<Filename Value="..\..\..\source\uCEFApplication.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="..\..\..\bin\MobileBrowser"/>
</Target>
<SearchPaths>
<IncludeFiles Value="..\..\..\source;$(ProjOutDir)"/>
<OtherUnitFiles Value="..\..\..\source"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<SyntaxMode Value="Delphi"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

85
demos/Lazarus_Windows/MobileBrowser/MobileBrowser.lpr Normal file
View File

@@ -0,0 +1,85 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2018 Salvador Díaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
program MobileBrowser;
{$MODE Delphi}
{$I cef.inc}
uses
Forms, Interfaces,
Windows,
uCEFApplication, uCEFConstants,
uMobileBrowser in 'uMobileBrowser.pas' {Form1};
{.$R *.res}
// CEF3 needs to set the LARGEADDRESSAWARE flag which allows 32-bit processes to use up to 3GB of RAM.
// If you don't add this flag the rederer process will crash when you try to load large images.
{$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE}
begin
GlobalCEFApp := TCefApplication.Create;
// In case you want to use custom directories for the CEF3 binaries, cache and user data.
// If you don't set a cache directory the browser will use in-memory cache.
{
GlobalCEFApp.FrameworkDirPath := 'c:\cef';
GlobalCEFApp.ResourcesDirPath := 'c:\cef';
GlobalCEFApp.LocalesDirPath := 'c:\cef\locales';
GlobalCEFApp.EnableGPU := True; // Enable hardware acceleration
GlobalCEFApp.cache := 'c:\cef\cache';
GlobalCEFApp.UserDataPath := 'c:\cef\User Data';
}
// 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;
GlobalCEFApp.Free;
GlobalCEFApp := nil;
end.

507
demos/Lazarus_Windows/MobileBrowser/cef.inc Normal file
View File

@@ -0,0 +1,507 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright � 2017 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
// The complete list of compiler versions is here :
// http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Compiler_Versions
{$DEFINE DELPHI_VERSION_UNKNOW}
// Delphi 5
{$IFDEF VER130}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$ENDIF}
// Delphi 6
{$IFDEF VER140}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$ENDIF}
// Delphi 7
{$IFDEF VER150}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$ENDIF}
// Delphi 8
{$IFDEF VER160}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$ENDIF}
// Delphi 2005
{$IFDEF VER170}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$ENDIF}
{$IFDEF VER180}
{$UNDEF DELPHI_VERSION_UNKNOW}
// Delphi 2007
{$IFDEF VER185}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
// Delphi 2006
{$ELSE}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$ENDIF}
{$ENDIF}
// Delphi 2009
{$IFDEF VER200}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$ENDIF}
//Delphi 2010
{$IFDEF VER210}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$ENDIF}
// Delphi XE
{$IFDEF VER220}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$ENDIF}
// Delphi XE2 (First FireMonkey and 64bit compiler)
{$IFDEF VER230}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$ENDIF}
// Delphi XE3
{$IFDEF VER240}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$ENDIF}
// Delphi XE4
{$IFDEF VER250}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$ENDIF}
// Delphi XE5
{$IFDEF VER260}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$ENDIF}
// Delphi XE6
{$IFDEF VER270}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$ENDIF}
// Delphi XE7
{$IFDEF VER280}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$ENDIF}
// Delphi XE8
{$IFDEF VER290}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$ENDIF VER290}
// Rad Studio 10 - Delphi Seattle
{$IFDEF VER300}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$ENDIF}
// Rad Studio 10.1 - Delphi Berlin
{$IFDEF VER310}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$ENDIF}
// Rad Studio 10.2 - Delphi Tokyo
{$IFDEF VER320}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$ENDIF}
// Rad Studio 10.3 - Delphi Rio
{$IFDEF VER330}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$DEFINE DELPHI26_UP}
{$ENDIF}
// Rad Studio 10.4 - Delphi Sydney
{$IFDEF VER340}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$DEFINE DELPHI26_UP}
{$DEFINE DELPHI27_UP}
{$ENDIF}
// Rad Studio 11.0 - Delphi Alexandria
{$IFDEF VER350}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$DEFINE DELPHI26_UP}
{$DEFINE DELPHI27_UP}
{$DEFINE DELPHI28_UP}
{$ENDIF}
{$IFDEF FPC}
{$DEFINE SUPPORTS_INLINE}
{$IF DEFINED(FPC_FULLVERSION) AND (FPC_FULLVERSION >= 30200)}
{$DEFINE FPC_VER_320}
{$IFEND}
{$ELSE}
{$IFDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$DEFINE DELPHI26_UP}
{$DEFINE DELPHI27_UP}
{$DEFINE DELPHI28_UP}
{$ENDIF}
{$ENDIF}
{$IFDEF DELPHI9_UP}
{$DEFINE SUPPORTS_INLINE}
{$ENDIF}
{$IF DEFINED(CPUX32) OR
DEFINED(CPU32) OR
DEFINED(CPU32BITS) OR
DEFINED(CPUARM32) OR
DEFINED(WIN32) OR
DEFINED(IOS32) OR
DEFINED(MACOS32) OR
DEFINED(LINUX32) OR
DEFINED(POSIX32) OR
DEFINED(ANDROID32)}
{$DEFINE TARGET_32BITS}
{$ELSE}
{$IF DEFINED(CPUX64) OR
DEFINED(CPU64) OR
DEFINED(CPU64BITS) OR
DEFINED(CPUARM64) OR
DEFINED(WIN64) OR
DEFINED(IOS64) OR
DEFINED(MACOS64) OR
DEFINED(LINUX64) OR
DEFINED(POSIX64) OR
DEFINED(ANDROID64)}
{$DEFINE TARGET_64BITS}
{$IFEND}
{$IFEND}
// Delphi uses MACOS for the new MacOSX and DARWIN is not defined
// FPC uses DARWIN for the new MacOSX and MACOS is defined for the classic Macintosh OS (System 7)
// We define MACOSX to avoid conflicts in both situations
{$IFDEF FPC}
{$IFDEF DARWIN}
{$DEFINE MACOSX}
{$ENDIF}
{$ELSE}
{$IFDEF MACOS}
{$DEFINE MACOSX}
{$ENDIF}
{$ENDIF}

415
demos/Lazarus_Windows/MobileBrowser/uMobileBrowser.lfm Normal file
View File

@@ -0,0 +1,415 @@
object Form1: TForm1
Left = 407
Height = 624
Top = 137
Width = 1038
Caption = 'Initializing browser. Please wait...'
ClientHeight = 624
ClientWidth = 1038
Color = clBtnFace
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '2.2.0.4'
object Splitter1: TSplitter
Left = 739
Height = 624
Top = 0
Width = 5
Align = alRight
MinSize = 220
ResizeAnchor = akRight
end
object Panel1: TPanel
Left = 744
Height = 624
Top = 0
Width = 294
Align = alRight
BevelOuter = bvNone
ClientHeight = 624
ClientWidth = 294
TabOrder = 0
object LogMem: TMemo
Left = 0
Height = 264
Top = 360
Width = 294
Align = alClient
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 0
end
object Panel3: TPanel
Left = 0
Height = 58
Top = 0
Width = 294
Align = alTop
BevelOuter = bvNone
ClientHeight = 58
ClientWidth = 294
TabOrder = 1
object CanEmulateBtn: TButton
Left = 0
Height = 25
Top = 0
Width = 294
Align = alTop
Caption = 'Can emulate'
OnClick = CanEmulateBtnClick
TabOrder = 0
end
object ClearDeviceMetricsOverrideBtn: TButton
Left = 0
Height = 25
Top = 33
Width = 294
Align = alBottom
Caption = 'Clear device metrics override'
OnClick = ClearDeviceMetricsOverrideBtnClick
TabOrder = 1
end
end
object Panel4: TPanel
Left = 0
Height = 97
Top = 58
Width = 294
Align = alTop
BevelOuter = bvNone
ClientHeight = 97
ClientWidth = 294
TabOrder = 2
object GroupBox1: TGroupBox
Left = 0
Height = 73
Top = 0
Width = 294
Align = alTop
Caption = ' User agent '
ClientHeight = 55
ClientWidth = 290
TabOrder = 0
object UserAgentCb: TComboBox
Left = 0
Height = 21
Top = 0
Width = 290
Align = alTop
ItemHeight = 13
ItemIndex = 0
Items.Strings = (
'Mozilla/5.0 (Linux; Android 11; M2102K1G) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/91.0.4472.101 Mobile Safari/537.36'
'Mozilla/5.0 (iPhone; CPU iPhone OS 10_3_1 like Mac OS X) AppleWebKit/603.1.30 (KHTML, like Gecko) Version/10.0 Mobile/14E304 Safari/602.1'
'Mozilla/5.0 (Linux; U; Android 4.4.2; en-us; SCH-I535 Build/KOT49H) AppleWebKit/534.30 (KHTML, like Gecko) Version/4.0 Mobile Safari/534.30'
'Mozilla/5.0 (Linux; Android 7.0; SM-G930V Build/NRD90M) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/59.0.3071.125 Mobile Safari/537.36'
'Mozilla/5.0 (Linux; Android 7.0; SM-A310F Build/NRD90M) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/55.0.2883.91 Mobile Safari/537.36 OPR/42.7.2246.114996'
'Opera/9.80 (Android 4.1.2; Linux; Opera Mobi/ADR-1305251841) Presto/2.11.355 Version/12.10'
'Opera/9.80 (J2ME/MIDP; Opera Mini/5.1.21214/28.2725; U; ru) Presto/2.8.119 Version/11.10'
'Mozilla/5.0 (iPhone; CPU iPhone OS 7_1_2 like Mac OS X) AppleWebKit/537.51.2 (KHTML, like Gecko) OPiOS/10.2.0.93022 Mobile/11D257 Safari/9537.53'
'Mozilla/5.0 (Android 7.0; Mobile; rv:54.0) Gecko/54.0 Firefox/54.0'
'Mozilla/5.0 (iPhone; CPU iPhone OS 10_3_2 like Mac OS X) AppleWebKit/603.2.4 (KHTML, like Gecko) FxiOS/7.5b3349 Mobile/14F89 Safari/603.2.4'
'Mozilla/5.0 (Linux; U; Android 7.0; en-US; SM-G935F Build/NRD90M) AppleWebKit/534.30 (KHTML, like Gecko) Version/4.0 UCBrowser/11.3.8.976 U3/0.8.0 Mobile Safari/534.30'
'Mozilla/5.0 (Linux; Android 6.0.1; SM-G920V Build/MMB29K) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/52.0.2743.98 Mobile Safari/537.36'
'Mozilla/5.0 (Linux; Android 5.1.1; SM-N750K Build/LMY47X; ko-kr) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/42.0.2311.135 Mobile Safari/537.36 Puffin/6.0.8.15804AP'
'Mozilla/5.0 (Linux; Android 5.1.1; SM-N750K Build/LMY47X; ko-kr) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/42.0.2311.135 Mobile Safari/537.36 Puffin/6.0.8.15804AP'
'Mozilla/5.0 (Linux; Android 7.0; SAMSUNG SM-G955U Build/NRD90M) AppleWebKit/537.36 (KHTML, like Gecko) SamsungBrowser/5.4 Chrome/51.0.2704.106 Mobile Safari/537.36'
'Mozilla/5.0 (Linux; Android 6.0; Lenovo K50a40 Build/MRA58K) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/57.0.2987.137 YaBrowser/17.4.1.352.00 Mobile Safari/537.36'
'Mozilla/5.0 (Linux; U; Android 7.0; en-us; MI 5 Build/NRD90M) AppleWebKit/537.36 (KHTML, like Gecko) Version/4.0 Chrome/53.0.2785.146 Mobile Safari/537.36 XiaoMi/MiuiBrowser/9.0.3'
'Mozilla/5.0 (compatible; MSIE 10.0; Windows Phone 8.0; Trident/6.0; IEMobile/10.0; ARM; Touch; Microsoft; Lumia 950)'
'Mozilla/5.0 (Windows Phone 10.0; Android 6.0.1; Microsoft; Lumia 950) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/52.0.2743.116 Mobile Safari/537.36 Edge/15.14977'
'Mozilla/5.0 (BB10; Kbd) AppleWebKit/537.35+ (KHTML, like Gecko) Version/10.3.3.2205 Mobile Safari/537.35+'
)
TabOrder = 0
Text = 'Mozilla/5.0 (Linux; Android 11; M2102K1G) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/91.0.4472.101 Mobile Safari/537.36'
end
object OverrideUserAgentBtn: TButton
Left = 0
Height = 25
Top = 30
Width = 290
Align = alBottom
Caption = 'Override user agent'
OnClick = OverrideUserAgentBtnClick
TabOrder = 1
end
end
object EmulateTouchChk: TCheckBox
Left = 0
Height = 19
Top = 78
Width = 294
Align = alBottom
Caption = 'Emulate Touch'
OnClick = EmulateTouchChkClick
TabOrder = 1
end
end
object Panel5: TPanel
Left = 0
Height = 205
Top = 155
Width = 294
Align = alTop
BevelOuter = bvNone
ClientHeight = 205
ClientWidth = 294
TabOrder = 3
object GroupBox2: TGroupBox
Left = 0
Height = 205
Top = 0
Width = 294
Align = alClient
Caption = ' Emulate device metrics '
ClientHeight = 187
ClientWidth = 290
TabOrder = 0
object Panel6: TPanel
Left = 0
Height = 27
Top = 27
Width = 290
Align = alTop
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 290
TabOrder = 0
object Label1: TLabel
Left = 0
Height = 27
Top = 0
Width = 75
Align = alLeft
AutoSize = False
Caption = 'Height'
Layout = tlCenter
end
object HeightEdt: TSpinEdit
Left = 75
Height = 27
Top = 0
Width = 215
Align = alClient
MaxValue = 10000000
TabOrder = 0
end
end
object Panel7: TPanel
Left = 0
Height = 27
Top = 0
Width = 290
Align = alTop
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 290
TabOrder = 1
object Label2: TLabel
Left = 0
Height = 27
Top = 0
Width = 75
Align = alLeft
AutoSize = False
Caption = 'Width'
Layout = tlCenter
end
object WidthEdt: TSpinEdit
Left = 75
Height = 27
Top = 0
Width = 215
Align = alClient
MaxValue = 10000000
TabOrder = 0
end
end
object OverrideDeviceMetricsBtn: TButton
Left = 0
Height = 25
Top = 162
Width = 290
Align = alBottom
Caption = 'Override device metrics'
OnClick = OverrideDeviceMetricsBtnClick
TabOrder = 2
end
object Panel8: TPanel
Left = 0
Height = 27
Top = 54
Width = 290
Align = alTop
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 290
TabOrder = 3
object Label3: TLabel
Left = 0
Height = 27
Top = 0
Width = 75
Align = alLeft
AutoSize = False
Caption = 'Scale'
Layout = tlCenter
end
object ScaleEdt: TMaskEdit
Left = 75
Height = 27
Top = 0
Width = 215
Align = alClient
MaxLength = 4
TabOrder = 0
EditMask = '#.##;1;0'
Text = '1. '
SpaceChar = '0'
end
end
object Panel9: TPanel
Left = 0
Height = 27
Top = 81
Width = 290
Align = alTop
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 290
TabOrder = 4
object Label4: TLabel
Left = 0
Height = 27
Top = 0
Width = 75
Align = alLeft
AutoSize = False
Caption = 'Orientation'
Layout = tlCenter
end
object OrientationCb: TComboBox
Left = 75
Height = 21
Top = 0
Width = 215
Align = alClient
ItemHeight = 13
ItemIndex = 0
Items.Strings = (
'Portrait Primary'
'Portrait Secondary'
'Landscape Primary'
'Landscape Secondary'
)
Style = csDropDownList
TabOrder = 0
Text = 'Portrait Primary'
end
end
object Panel10: TPanel
Left = 0
Height = 27
Top = 108
Width = 290
Align = alTop
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 290
TabOrder = 5
object Label5: TLabel
Left = 0
Height = 27
Top = 0
Width = 75
Align = alLeft
AutoSize = False
Caption = 'Angle'
Layout = tlCenter
end
object AngleEdt: TSpinEdit
Left = 75
Height = 27
Top = 0
Width = 215
Align = alClient
MaxValue = 360
TabOrder = 0
end
end
end
end
end
object Panel2: TPanel
Left = 0
Height = 624
Top = 0
Width = 739
Align = alClient
BevelOuter = bvNone
ClientHeight = 624
ClientWidth = 739
TabOrder = 1
object AddressPnl: TPanel
Left = 0
Height = 20
Top = 0
Width = 739
Align = alTop
BevelOuter = bvNone
ClientHeight = 20
ClientWidth = 739
Enabled = False
TabOrder = 0
object AddressEdt: TEdit
Left = 0
Height = 20
Top = 0
Width = 708
Align = alClient
TabOrder = 0
Text = 'http://www.google.com'
end
object GoBtn: TButton
Left = 708
Height = 20
Top = 0
Width = 31
Align = alRight
Caption = 'Go'
OnClick = GoBtnClick
TabOrder = 1
end
end
object CEFWindowParent1: TCEFWindowParent
Left = 0
Height = 604
Top = 20
Width = 739
Align = alClient
TabOrder = 1
end
end
object Timer1: TTimer
Enabled = False
Interval = 300
OnTimer = Timer1Timer
Left = 56
Top = 88
end
object Chromium1: TChromium
OnBeforePopup = Chromium1BeforePopup
OnAfterCreated = Chromium1AfterCreated
OnBeforeClose = Chromium1BeforeClose
OnClose = Chromium1Close
OnOpenUrlFromTab = Chromium1OpenUrlFromTab
OnDevToolsMethodResult = Chromium1DevToolsMethodResult
Left = 56
Top = 152
end
end

479
demos/Lazarus_Windows/MobileBrowser/uMobileBrowser.pas Normal file
View File

@@ -0,0 +1,479 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2022 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
unit uMobileBrowser;
{$MODE Delphi}
{$I cef.inc}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls, MaskEdit, Spin,
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFConstants, uCEFTypes,
uCEFJson, uCEFWinControl, uCEFSentinel, uCEFChromiumCore, uCEFDictionaryValue;
type
TForm1 = class(TForm)
Timer1: TTimer;
Chromium1: TChromium;
Panel1: TPanel;
Panel2: TPanel;
AddressPnl: TPanel;
AddressEdt: TEdit;
GoBtn: TButton;
CEFWindowParent1: TCEFWindowParent;
Splitter1: TSplitter;
LogMem: TMemo;
Panel3: TPanel;
CanEmulateBtn: TButton;
ClearDeviceMetricsOverrideBtn: TButton;
Panel4: TPanel;
GroupBox1: TGroupBox;
UserAgentCb: TComboBox;
OverrideUserAgentBtn: TButton;
EmulateTouchChk: TCheckBox;
Panel5: TPanel;
GroupBox2: TGroupBox;
Panel6: TPanel;
Label1: TLabel;
HeightEdt: TSpinEdit;
Panel7: TPanel;
Label2: TLabel;
WidthEdt: TSpinEdit;
OverrideDeviceMetricsBtn: TButton;
Panel8: TPanel;
Label3: TLabel;
ScaleEdt: TMaskEdit;
Panel9: TPanel;
Label4: TLabel;
OrientationCb: TComboBox;
Panel10: TPanel;
Label5: TLabel;
AngleEdt: TSpinEdit;
procedure GoBtnClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure CanEmulateBtnClick(Sender: TObject);
procedure OverrideUserAgentBtnClick(Sender: TObject);
procedure EmulateTouchChkClick(Sender: TObject);
procedure ClearDeviceMetricsOverrideBtnClick(Sender: TObject);
procedure OverrideDeviceMetricsBtnClick(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 Chromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
procedure Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser);
procedure Chromium1BeforePopup(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, Result: Boolean);
procedure Chromium1OpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; out Result: Boolean);
procedure Chromium1DevToolsMethodResult(Sender: TObject; const browser: ICefBrowser; message_id: Integer; success: Boolean; const result: ICefValue);
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.
FPendingMsgID : integer;
// 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;
procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED;
procedure BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY;
procedure HandleSetUserAgentResult(aSuccess : boolean; const aResult: ICefValue);
procedure HandleSetTouchEmulationEnabledResult(aSuccess : boolean; const aResult: ICefValue);
procedure HandleCanEmulateResult(aSuccess : boolean; const aResult: ICefValue);
procedure HandleClearDeviceMetricsOverrideResult(aSuccess : boolean; const aResult: ICefValue);
procedure HandleSetDeviceMetricsOverrideResult(aSuccess : boolean; const aResult: ICefValue);
procedure HandleSetUserAgentResultMsg(Data: PtrInt);
procedure HandleSetTouchEmulationEnabledResultMsg(Data: PtrInt);
procedure HandleCanEmulateResultMsg(Data: PtrInt);
procedure HandleClearDeviceMetricsOverrideResultMsg(Data: PtrInt);
procedure HandleSetDeviceMetricsOverrideResultMsg(Data: PtrInt);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
uses
uCEFApplication, uCEFMiscFunctions;
// This demo allows you to emulate a mobile browser using the "Emulation" namespace of the DevTools.
// It's necesary to reload the browser after using the controls in the right panel.
// This demo uses a TChromium and a TCEFWindowParent
// Destruction steps
// =================
// 1. FormCloseQuery sets CanClose to FALSE calls TChromium.CloseBrowser which triggers the TChromium.OnClose event.
// 2. TChromium.OnClose sends a CEFBROWSER_DESTROY message to destroy CEFWindowParent1 in the main thread, which triggers the TChromium.OnBeforeClose event.
// 3. TChromium.OnBeforeClose sets FCanClose := True and sends WM_CLOSE to the form.
const
DEVTOOLS_SETUSERAGENTOVERRIDE_MSGID = 1;
DEVTOOLS_SETTOUCHEMULATIONENABLED_MSGID = 2;
DEVTOOLS_CANEMULATE_MSGID = 3;
DEVTOOLS_CLEARDEVICEMETRICSOVERRIDE_MSGID = 4;
DEVTOOLS_SETDEVICEMETRICSOVERRIDE_MSGID = 5;
CANEMULATE_RESULT_FAIL = 0;
CANEMULATE_RESULT_SUCCESS_SUPPORTED = 1;
CANEMULATE_RESULT_SUCCESS_UNSUPPORTED = 2;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := FCanClose;
if not(FClosing) then
begin
FClosing := True;
Visible := False;
Chromium1.CloseBrowser(True);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FCanClose := False;
FClosing := False;
FPendingMsgID := 0;
Chromium1.DefaultURL := UTF8Decode(AddressEdt.Text);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
// 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.CanEmulateBtnClick(Sender: TObject);
begin
FPendingMsgID := DEVTOOLS_CANEMULATE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.canEmulate', nil);
end;
procedure TForm1.Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
begin
// Now the browser is fully initialized we can send a message to the main form to load the initial web page.
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.Chromium1BeforePopup(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, Result: Boolean);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TForm1.Chromium1Close(Sender: TObject;
const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
begin
PostMessage(Handle, CEF_DESTROY, 0, 0);
aAction := cbaDelay;
end;
procedure TForm1.Chromium1DevToolsMethodResult(Sender: TObject;
const browser: ICefBrowser; message_id: Integer; success: Boolean;
const result: ICefValue);
begin
case FPendingMsgID of
DEVTOOLS_SETUSERAGENTOVERRIDE_MSGID : HandleSetUserAgentResult(success, result);
DEVTOOLS_SETTOUCHEMULATIONENABLED_MSGID : HandleSetTouchEmulationEnabledResult(success, result);
DEVTOOLS_CANEMULATE_MSGID : HandleCanEmulateResult(success, result);
DEVTOOLS_CLEARDEVICEMETRICSOVERRIDE_MSGID : HandleClearDeviceMetricsOverrideResult(success, result);
DEVTOOLS_SETDEVICEMETRICSOVERRIDE_MSGID : HandleSetDeviceMetricsOverrideResult(success, result);
end;
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 [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TForm1.ClearDeviceMetricsOverrideBtnClick(Sender: TObject);
begin
FPendingMsgID := DEVTOOLS_CLEARDEVICEMETRICSOVERRIDE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.clearDeviceMetricsOverride', nil);
end;
procedure TForm1.EmulateTouchChkClick(Sender: TObject);
var
TempParams : ICefDictionaryValue;
begin
try
TempParams := TCefDictionaryValueRef.New;
TempParams.SetBool('enabled', EmulateTouchChk.Checked);
if EmulateTouchChk.Checked then
TempParams.SetInt('maxTouchPoints', 2);
FPendingMsgID := DEVTOOLS_SETTOUCHEMULATIONENABLED_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.setTouchEmulationEnabled', TempParams);
finally
TempParams := nil;
end;
end;
procedure TForm1.BrowserCreatedMsg(var aMessage : TMessage);
begin
Caption := 'Mobile Browser';
AddressPnl.Enabled := True;
end;
procedure TForm1.BrowserDestroyMsg(var aMessage : TMessage);
begin
CEFWindowParent1.Free;
end;
procedure TForm1.GoBtnClick(Sender: TObject);
begin
// This will load the URL in the edit box
Chromium1.LoadURL(UTF8Decode(AddressEdt.Text));
end;
procedure TForm1.OverrideDeviceMetricsBtnClick(Sender: TObject);
var
TempParams, TempDict : ICefDictionaryValue;
TempFormatSettings : TFormatSettings;
TempOrientation : string;
begin
try
TempParams := TCefDictionaryValueRef.New;
TempParams.SetInt('width', WidthEdt.Value);
TempParams.SetInt('height', HeightEdt.Value);
TempFormatSettings.DecimalSeparator := '.';
TempParams.SetDouble('deviceScaleFactor', StrToFloat(ScaleEdt.Text, TempFormatSettings));
TempParams.SetBool('mobile', True);
case OrientationCb.ItemIndex of
0 : TempOrientation := 'portraitPrimary';
1 : TempOrientation := 'portraitSecondary';
2 : TempOrientation := 'landscapePrimary';
else TempOrientation := 'landscapeSecondary';
end;
TempDict := TCefDictionaryValueRef.New;
TempDict.SetString('type', TempOrientation);
TempDict.SetInt('angle', AngleEdt.Value);
TempParams.SetDictionary('screenOrientation', TempDict);
FPendingMsgID := DEVTOOLS_SETDEVICEMETRICSOVERRIDE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.setDeviceMetricsOverride', TempParams);
finally
TempDict := nil;
TempParams := nil;
end;
end;
procedure TForm1.OverrideUserAgentBtnClick(Sender: TObject);
var
TempParams : ICefDictionaryValue;
begin
try
TempParams := TCefDictionaryValueRef.New;
TempParams.SetString('userAgent', UserAgentCb.Text);
FPendingMsgID := DEVTOOLS_SETUSERAGENTOVERRIDE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.setUserAgentOverride', TempParams);
finally
TempParams := nil;
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.HandleSetUserAgentResultMsg(Data: PtrInt);
begin
if (Data <> 0) then
LogMem.Lines.Add('Successful SetUserAgentOverride')
else
LogMem.Lines.Add('Unsuccessful SetUserAgentOverride');
end;
procedure TForm1.HandleSetTouchEmulationEnabledResultMsg(Data: PtrInt);
begin
if (Data <> 0) then
LogMem.Lines.Add('Successful SetTouchEmulationEnabled')
else
LogMem.Lines.Add('Unsuccessful SetTouchEmulationEnabled');
end;
procedure TForm1.HandleCanEmulateResultMsg(Data: PtrInt);
begin
case Data of
CANEMULATE_RESULT_FAIL :
LogMem.Lines.Add('Unsuccessful CanEmulate');
CANEMULATE_RESULT_SUCCESS_UNSUPPORTED :
LogMem.Lines.Add('Successful CanEmulate. Emulation is not supported.');
CANEMULATE_RESULT_SUCCESS_SUPPORTED :
LogMem.Lines.Add('Successful CanEmulate. Emulation is supported.');
end;
end;
procedure TForm1.HandleClearDeviceMetricsOverrideResultMsg(Data: PtrInt);
begin
if (Data <> 0) then
LogMem.Lines.Add('Successful ClearDeviceMetricsOverride')
else
LogMem.Lines.Add('Unsuccessful ClearDeviceMetricsOverride');
end;
procedure TForm1.HandleSetDeviceMetricsOverrideResultMsg(Data: PtrInt);
begin
if (Data <> 0) then
LogMem.Lines.Add('Successful SetDeviceMetricsOverride')
else
LogMem.Lines.Add('Unsuccessful SetDeviceMetricsOverride');
end;
procedure TForm1.HandleSetUserAgentResult(aSuccess : boolean; const aResult: ICefValue);
begin
Application.QueueAsyncCall(HandleSetUserAgentResultMsg, ord(aSuccess and (aResult <> nil)));
end;
procedure TForm1.HandleSetTouchEmulationEnabledResult(aSuccess : boolean; const aResult: ICefValue);
begin
Application.QueueAsyncCall(HandleSetTouchEmulationEnabledResultMsg, ord(aSuccess and (aResult <> nil)));
end;
procedure TForm1.HandleCanEmulateResult(aSuccess : boolean; const aResult: ICefValue);
var
TempRsltDict : ICefDictionaryValue;
TempResult : boolean;
TempData : PtrInt;
begin
if aSuccess and (aResult <> nil) then
begin
TempRsltDict := aResult.GetDictionary;
if TCEFJson.ReadBoolean(TempRsltDict, 'result', TempResult) and TempResult then
TempData := CANEMULATE_RESULT_SUCCESS_SUPPORTED
else
TempData := CANEMULATE_RESULT_SUCCESS_UNSUPPORTED;
end
else
TempData := CANEMULATE_RESULT_FAIL;
Application.QueueAsyncCall(HandleCanEmulateResultMsg, TempData);
end;
procedure TForm1.HandleClearDeviceMetricsOverrideResult(aSuccess : boolean; const aResult: ICefValue);
begin
Application.QueueAsyncCall(HandleClearDeviceMetricsOverrideResultMsg, ord(aSuccess and (aResult <> nil)));
end;
procedure TForm1.HandleSetDeviceMetricsOverrideResult(aSuccess : boolean; const aResult: ICefValue);
begin
Application.QueueAsyncCall(HandleSetDeviceMetricsOverrideResultMsg, ord(aSuccess and (aResult <> nil)));
end;
end.

2
update_CEF4Delphi.json
View File

@@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 376,
"InternalVersion" : 377,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "99.2.15.0"
}