1
0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2024-11-24 08:02:15 +02:00

Added custom JavaScript dialogs to FMXExternalPumpBrowser2 for Linux

Removed unused TOpenDialog from FMXExternalPumpBrowser for MacOS
Replaced the address box with a TComboEdit in FMXExternalPumpBrowser for Windows
This commit is contained in:
Salvador Díaz Fau 2021-06-05 18:23:21 +02:00
parent 43ab8ef953
commit 1efd6c9a67
6 changed files with 154 additions and 46 deletions

View File

@ -27,16 +27,6 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
Size.PlatformDefault = False
TabOrder = 0
TabStop = False
object AddressEdt: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
Align = Client
TabOrder = 0
Text = 'https://www.google.com'
Size.Width = 709.000000000000000000
Size.Height = 23.000000000000000000
Size.PlatformDefault = False
OnEnter = AddressEdtEnter
end
object Layout1: TLayout
Align = Right
Padding.Left = 5.000000000000000000
@ -45,7 +35,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
Size.Width = 81.000000000000000000
Size.Height = 23.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
TabOrder = 0
TabStop = False
object GoBtn: TButton
Align = Left
@ -73,6 +63,28 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
OnEnter = SnapshotBtnEnter
end
end
object AddressCb: TComboEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
Align = Client
TabOrder = 1
ItemHeight = 19.000000000000000000
Items.Strings = (
'https://www.google.com'
'https://www.w3schools.com/jsref/tryit.asp?filename=tryjsref_onco' +
'ntextmenu'
'https://www.w3schools.com/tags/tryit.asp?filename=tryhtml5_input' +
'_type_file'
'https://www.w3schools.com/js/tryit.asp?filename=tryjs_alert'
'https://www.w3schools.com/js/tryit.asp?filename=tryjs_confirm'
'https://www.w3schools.com/tags/tryit.asp?filename=tryhtml_select')
ItemIndex = 0
Text = 'https://www.google.com'
Size.Width = 709.000000000000000000
Size.Height = 23.000000000000000000
Size.PlatformDefault = False
end
end
object Timer1: TTimer
Enabled = False
@ -127,6 +139,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
OnBeforeContextMenu = chrmosrBeforeContextMenu
OnTooltip = chrmosrTooltip
OnCursorChange = chrmosrCursorChange
OnJsdialog = chrmosrJsdialog
OnBeforePopup = chrmosrBeforePopup
OnAfterCreated = chrmosrAfterCreated
OnBeforeClose = chrmosrBeforeClose

View File

@ -44,12 +44,19 @@ uses
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Edit, FMX.StdCtrls,
FMX.Controls.Presentation, FMX.Graphics, FMX.Layouts, FMX.DialogService,
uCEFFMXChromium, uCEFFMXBufferPanel, uCEFFMXWorkScheduler,
uCEFInterfaces, uCEFTypes, uCEFConstants, uCEFChromiumCore;
uCEFInterfaces, uCEFTypes, uCEFConstants, uCEFChromiumCore, FMX.ComboEdit;
type
TJSDialogInfo = record
OriginUrl : ustring;
MessageText : ustring;
DefaultPromptText : ustring;
DialogType : TCefJsDialogType;
Callback : ICefJsDialogCallback;
end;
TFMXExternalPumpBrowserFrm = class(TForm)
AddressPnl: TPanel;
AddressEdt: TEdit;
chrmosr: TFMXChromium;
Timer1: TTimer;
SaveDialog1: TSaveDialog;
@ -59,6 +66,7 @@ type
SnapshotBtn: TButton;
StatusBar1: TStatusBar;
StatusLbl: TLabel;
AddressCb: TComboEdit;
procedure GoBtnClick(Sender: TObject);
procedure GoBtnEnter(Sender: TObject);
@ -93,6 +101,7 @@ type
procedure chrmosrLoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
procedure chrmosrLoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring);
procedure chrmosrBeforeContextMenu(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel);
procedure chrmosrJsdialog(Sender: TObject; const browser: ICefBrowser; const originUrl: ustring; dialogType: TCefJsDialogType; const messageText, defaultPromptText: ustring; const callback: ICefJsDialogCallback; out suppressMessage, Result: Boolean);
procedure Timer1Timer(Sender: TObject);
procedure AddressEdtEnter(Sender: TObject);
@ -109,6 +118,7 @@ type
FCanClose : boolean;
FClosing : boolean;
FResizeCS : TCriticalSection;
FJSDialogInfo : TJSDialogInfo;
{$IFDEF DELPHI17_UP}
FMouseWheelService : IFMXMouseService;
{$ENDIF}
@ -118,6 +128,8 @@ type
function getModifiers(Button: TMouseButton; Shift: TShiftState): TCefEventFlags; overload;
function GetButton(Button: TMouseButton): TCefMouseButtonType;
function GetMousePosition(var aPoint : TPointF) : boolean;
procedure ShowPendingJSDialog;
public
procedure DoResize;
procedure NotifyMoveOrResizeStarted;
@ -151,7 +163,7 @@ implementation
{$R *.fmx}
uses
System.SysUtils, System.Math, FMX.Platform, FMX.Platform.Linux,
System.SysUtils, System.Math, FMX.Platform, FMX.Platform.Linux, FMX.DialogService.Async,
uCEFMiscFunctions, uCEFApplication, uCEFLinuxTypes, uCEFLinuxConstants,
uCEFLinuxFunctions;
@ -232,9 +244,11 @@ begin
if not(FClosing) then
begin
FClosing := True;
Visible := False;
AddressPnl.Enabled := False;
FClosing := True;
Visible := False;
AddressPnl.Enabled := False;
FJSDialogInfo.Callback := nil;
chrmosr.CloseBrowser(True);
end;
end;
@ -250,7 +264,13 @@ begin
FClosing := False;
FResizeCS := TCriticalSection.Create;
chrmosr.DefaultURL := AddressEdt.Text;
FJSDialogInfo.OriginUrl := '';
FJSDialogInfo.MessageText := '';
FJSDialogInfo.DefaultPromptText := '';
FJSDialogInfo.DialogType := JSDIALOGTYPE_ALERT;
FJSDialogInfo.Callback := nil;
chrmosr.DefaultURL := AddressCb.Text;
{$IFDEF DELPHI17_UP}
if TPlatformServices.Current.SupportsPlatformService(IFMXMouseService) then
@ -261,7 +281,9 @@ end;
procedure TFMXExternalPumpBrowserFrm.FormDestroy(Sender: TObject);
begin
FResizeCS.Free;
if (FPopUpBitmap <> nil) then FreeAndNil(FPopUpBitmap);
if (FPopUpBitmap <> nil) then
FreeAndNil(FPopUpBitmap);
end;
procedure TFMXExternalPumpBrowserFrm.FormHide(Sender: TObject);
@ -288,7 +310,7 @@ begin
FPendingResize := False;
FResizeCS.Release;
chrmosr.LoadURL(AddressEdt.Text);
chrmosr.LoadURL(AddressCb.Text);
end;
procedure TFMXExternalPumpBrowserFrm.GoBtnEnter(Sender: TObject);
@ -572,6 +594,71 @@ begin
rect.height := round(Panel1.Height);
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrJsdialog( Sender : TObject;
const browser : ICefBrowser;
const originUrl : ustring;
dialogType : TCefJsDialogType;
const messageText : ustring;
const defaultPromptText : ustring;
const callback : ICefJsDialogCallback;
out suppressMessage : Boolean;
out Result : Boolean);
begin
FJSDialogInfo.OriginUrl := originUrl;
FJSDialogInfo.DialogType := dialogType;
FJSDialogInfo.MessageText := messageText;
FJSDialogInfo.DefaultPromptText := defaultPromptText;
FJSDialogInfo.Callback := callback;
Result := True;
suppressMessage := False;
TThread.ForceQueue(nil, ShowPendingJSDialog);
end;
procedure TFMXExternalPumpBrowserFrm.ShowPendingJSDialog;
var
TempCaption : string;
begin
if FClosing or (FJSDialogInfo.Callback = nil) then exit;
TempCaption := 'JavaScript message from : ' + FJSDialogInfo.OriginUrl;
case FJSDialogInfo.DialogType of
JSDIALOGTYPE_CONFIRM :
begin
TempCaption := TempCaption + CRLF + CRLF + FJSDialogInfo.MessageText;
TDialogServiceAsync.MessageDialog(TempCaption,
TMsgDlgType.mtConfirmation,
[TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo],
TMsgDlgBtn.mbYes,
0,
procedure(const AResult: TModalResult)
begin
FJSDialogInfo.Callback.cont(AResult in [mrOk, mrYes], '');
FJSDialogInfo.Callback := nil;
end);
end;
JSDIALOGTYPE_PROMPT :
TDialogServiceAsync.InputQuery(TempCaption,
[FJSDialogInfo.MessageText],
[FJSDialogInfo.DefaultPromptText],
procedure(const AResult: TModalResult; const AValues: array of string)
begin
FJSDialogInfo.Callback.cont(AResult in [mrOk, mrYes], AValues[0]);
FJSDialogInfo.Callback := nil;
end);
else // JSDIALOGTYPE_ALERT
begin
TempCaption := TempCaption + CRLF + CRLF + FJSDialogInfo.MessageText;
TDialogServiceAsync.ShowMessage(TempCaption);
FJSDialogInfo.Callback := nil;
end;
end;
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrLoadError( Sender : TObject;
const browser : ICefBrowser;
const frame : ICefFrame;

View File

@ -96,7 +96,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
Filter = 'Bitmap files (*.bmp)|*.BMP'
Title = 'Save snapshot'
Left = 40
Top = 241
Top = 185
end
object Panel1: TFMXBufferPanel
Align = Client
@ -120,7 +120,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
end
object MainMenu1: TMainMenu
Left = 40
Top = 297
Top = 241
object EditMenu: TMenuItem
Text = 'Edit'
object UndoMenuItem: TMenuItem
@ -173,7 +173,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
object PopupMenu1: TPopupMenu
OnPopup = PopupMenu1Popup
Left = 40
Top = 353
Top = 297
object BackMenuItem: TMenuItem
Text = 'Back'
OnClick = BackMenuItemClick
@ -183,10 +183,6 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
OnClick = ForwardMenuItemClick
end
end
object OpenDialog1: TOpenDialog
Left = 40
Top = 185
end
object chrmosr: TFMXChromium
OnBeforeContextMenu = chrmosrBeforeContextMenu
OnTooltip = chrmosrTooltip

View File

@ -90,7 +90,6 @@ type
PopupMenu1: TPopupMenu;
BackMenuItem: TMenuItem;
ForwardMenuItem: TMenuItem;
OpenDialog1: TOpenDialog;
procedure GoBtnClick(Sender: TObject);
procedure GoBtnEnter(Sender: TObject);

View File

@ -23,17 +23,8 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
Size.Width = 800.000000000000000000
Size.Height = 33.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
object AddressEdt: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
Align = Client
TabOrder = 0
Text = 'https://www.google.com'
Size.Width = 709.000000000000000000
Size.Height = 23.000000000000000000
Size.PlatformDefault = False
OnEnter = AddressEdtEnter
end
TabOrder = 0
TabStop = False
object Layout1: TLayout
Align = Right
Padding.Left = 5.000000000000000000
@ -42,7 +33,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
Size.Width = 81.000000000000000000
Size.Height = 23.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
TabOrder = 1
object GoBtn: TButton
Align = Left
Position.X = 5.000000000000000000
@ -69,6 +60,28 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
OnEnter = SnapshotBtnEnter
end
end
object AddressCb: TComboEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
Align = Client
TabOrder = 0
ItemHeight = 19.000000000000000000
Items.Strings = (
'https://www.google.com'
'https://www.w3schools.com/jsref/tryit.asp?filename=tryjsref_onco' +
'ntextmenu'
'https://www.w3schools.com/tags/tryit.asp?filename=tryhtml5_input' +
'_type_file'
'https://www.w3schools.com/js/tryit.asp?filename=tryjs_alert'
'https://www.w3schools.com/js/tryit.asp?filename=tryjs_confirm'
'https://www.w3schools.com/tags/tryit.asp?filename=tryhtml_select')
ItemIndex = 0
Text = 'https://www.google.com'
Size.Width = 709.000000000000000000
Size.Height = 23.000000000000000000
Size.PlatformDefault = False
end
end
object Timer1: TTimer
Enabled = False
@ -86,8 +99,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
end
object Panel1: TFMXBufferPanel
Align = Client
TabOrder = 0
Color = claTomato
TabOrder = 1
CanFocus = True
Size.Width = 800.000000000000000000
Size.Height = 600.000000000000000000

View File

@ -52,12 +52,12 @@ uses
FMX.Graphics,
{$ENDIF}
uCEFFMXChromium, uCEFFMXBufferPanel, uCEFFMXWorkScheduler,
uCEFInterfaces, uCEFTypes, uCEFConstants, uCEFChromiumCore, FMX.Layouts;
uCEFInterfaces, uCEFTypes, uCEFConstants, uCEFChromiumCore, FMX.Layouts,
FMX.ComboEdit;
type
TFMXExternalPumpBrowserFrm = class(TForm)
AddressPnl: TPanel;
AddressEdt: TEdit;
chrmosr: TFMXChromium;
Timer1: TTimer;
SaveDialog1: TSaveDialog;
@ -65,6 +65,7 @@ type
Layout1: TLayout;
GoBtn: TButton;
SnapshotBtn: TButton;
AddressCb: TComboEdit;
procedure GoBtnClick(Sender: TObject);
procedure GoBtnEnter(Sender: TObject);
@ -257,7 +258,7 @@ begin
FAtLeastWin8 := False;
{$ENDIF}
chrmosr.DefaultURL := AddressEdt.Text;
chrmosr.DefaultURL := AddressCb.Text;
InitializeLastClick;
@ -307,7 +308,7 @@ begin
FPendingResize := False;
FResizeCS.Release;
chrmosr.LoadURL(AddressEdt.Text);
chrmosr.LoadURL(AddressCb.Text);
end;
procedure TFMXExternalPumpBrowserFrm.GoBtnEnter(Sender: TObject);