pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-11-23 21:34:53 +02:00
Code Issues Actions 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;