Skip to content

Commit

Permalink
Added custom JavaScript dialogs to FMXExternalPumpBrowser2 for Linux
Browse files Browse the repository at this point in the history 
Removed unused TOpenDialog from FMXExternalPumpBrowser for MacOS
Replaced the address box with a TComboEdit in FMXExternalPumpBrowser for Windows
  • Loading branch information
@salvadordf
salvadordf committed Jun 5, 2021
1 parent 43ab8ef commit 1efd6c9
Show file tree
Hide file tree
Showing 6 changed files with 154 additions and 46 deletions.
35 changes: 24 additions & 11 deletions demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uFMXExternalPumpBrowser2.fmx
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -127,6 +139,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
OnBeforeContextMenu = chrmosrBeforeContextMenu
OnTooltip = chrmosrTooltip
OnCursorChange = chrmosrCursorChange
OnJsdialog = chrmosrJsdialog
OnBeforePopup = chrmosrBeforePopup
OnAfterCreated = chrmosrAfterCreated
OnBeforeClose = chrmosrBeforeClose
Expand Down
105 changes: 96 additions & 9 deletions demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uFMXExternalPumpBrowser2.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,12 +44,19 @@ interface
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;
Expand All @@ -59,6 +66,7 @@ TFMXExternalPumpBrowserFrm = class(TForm)
SnapshotBtn: TButton;
StatusBar1: TStatusBar;
StatusLbl: TLabel;
AddressCb: TComboEdit;

procedure GoBtnClick(Sender: TObject);
procedure GoBtnEnter(Sender: TObject);
Expand Down Expand Up @@ -93,6 +101,7 @@ TFMXExternalPumpBrowserFrm = class(TForm)
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);
Expand All @@ -109,6 +118,7 @@ TFMXExternalPumpBrowserFrm = class(TForm)
FCanClose : boolean;
FClosing : boolean;
FResizeCS : TCriticalSection;
FJSDialogInfo : TJSDialogInfo;
{$IFDEF DELPHI17_UP}
FMouseWheelService : IFMXMouseService;
{$ENDIF}
Expand All @@ -118,6 +128,8 @@ TFMXExternalPumpBrowserFrm = class(TForm)
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;
Expand Down Expand Up @@ -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;

Expand Down Expand Up @@ -232,9 +244,11 @@ procedure TFMXExternalPumpBrowserFrm.FormCloseQuery(Sender: TObject; var CanClos

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;
Expand All @@ -250,7 +264,13 @@ procedure TFMXExternalPumpBrowserFrm.FormCreate(Sender: TObject);
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
Expand All @@ -261,7 +281,9 @@ procedure TFMXExternalPumpBrowserFrm.FormCreate(Sender: TObject);
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);
Expand All @@ -288,7 +310,7 @@ procedure TFMXExternalPumpBrowserFrm.LoadURL;
FPendingResize := False;
FResizeCS.Release;

chrmosr.LoadURL(AddressEdt.Text);
chrmosr.LoadURL(AddressCb.Text);
end;

procedure TFMXExternalPumpBrowserFrm.GoBtnEnter(Sender: TObject);
Expand Down Expand Up @@ -572,6 +594,71 @@ procedure TFMXExternalPumpBrowserFrm.chrmosrGetViewRect( Sender : TObject;
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;
Expand Down
10 changes: 3 additions & 7 deletions demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.fmx
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
1 change: 0 additions & 1 deletion demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,6 @@ TFMXExternalPumpBrowserFrm = class(TForm)
PopupMenu1: TPopupMenu;
BackMenuItem: TMenuItem;
ForwardMenuItem: TMenuItem;
OpenDialog1: TOpenDialog;

procedure GoBtnClick(Sender: TObject);
procedure GoBtnEnter(Sender: TObject);
Expand Down
40 changes: 26 additions & 14 deletions demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.fmx
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
Loading

0 comments on commit 1efd6c9

Please sign in to comment.