You've already forked CEF4Delphi
mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2025-08-04 21:32:54 +02:00
Added TCEFTimerWorkScheduler
- Moved the GlobalCEFWorkScheduler creation after the GlobalCEFApp creation in all demos using it. - Replaced TCEFWorkScheduler by TCEFTimerWorkScheduler in FMX demos for Linux and MacOS. - Fixed context menu issue in FMXExternalPumpBrowser2 for Linux - Fixed stability issues in FMXExternalPumpBrowser for MacOS - Fixed 32bit build issues in TinyBrowser and ToolBoxBrowser2 demos. - Added uCEFMacOSInterfaces and uCEFMacOSCustomCocoaTimer.
This commit is contained in:
Salvador Díaz Fau
@ -45,7 +45,7 @@ uses
|
||||
{$ENDIF }
|
||||
FMX.Forms,
|
||||
uCEFApplication,
|
||||
uCEFFMXWorkScheduler,
|
||||
uCEFTimerWorkScheduler,
|
||||
uCEFMacOSFunctions,
|
||||
uFMXExternalPumpBrowser in 'uFMXExternalPumpBrowser.pas' {FMXExternalPumpBrowserFrm},
|
||||
uFMXApplicationService in 'uFMXApplicationService.pas';
|
||||
@ -77,9 +77,10 @@ begin
|
||||
// The form needs to be destroyed *BEFORE* stopping the scheduler.
|
||||
FMXExternalPumpBrowserFrm.Free;
|
||||
|
||||
GlobalFMXWorkScheduler.StopScheduler;
|
||||
if (GlobalCEFTimerWorkScheduler <> nil) then
|
||||
GlobalCEFTimerWorkScheduler.StopScheduler;
|
||||
end;
|
||||
|
||||
DestroyGlobalCEFApp;
|
||||
DestroyGlobalFMXWorkScheduler;
|
||||
DestroyGlobalCEFTimerWorkScheduler;
|
||||
end.
|
||||
|
||||
@ -44,57 +44,50 @@ unit uFMXApplicationService;
|
||||
interface
|
||||
|
||||
uses
|
||||
Macapi.Foundation, Macapi.CoreFoundation, Macapi.ObjectiveC, Macapi.Helpers,
|
||||
Macapi.CocoaTypes, Macapi.AppKit, FMX.Platform;
|
||||
System.TypInfo, Macapi.Foundation, Macapi.CoreFoundation, Macapi.ObjectiveC,
|
||||
Macapi.Helpers, Macapi.CocoaTypes, Macapi.AppKit, FMX.Platform,
|
||||
uCEFMacOSInterfaces;
|
||||
|
||||
type
|
||||
TFMXApplicationService = class;
|
||||
|
||||
ICrAppProtocol = interface(NSApplicationDelegate)
|
||||
['{2071D289-9A54-4AD7-BD83-E521ACD5C528}']
|
||||
function isHandlingSendEvent: boolean; cdecl;
|
||||
end;
|
||||
TFMXApplicationDelegateEx = class(TOCLocal, IFMXApplicationDelegate)
|
||||
protected
|
||||
FAppService : TFMXApplicationService;
|
||||
|
||||
ICrAppControlProtocol = interface(ICrAppProtocol)
|
||||
['{BCCDF64D-E8D7-4E0B-83BC-30F87145576C}']
|
||||
procedure setHandlingSendEvent(handlingSendEvent: boolean); cdecl;
|
||||
end;
|
||||
public
|
||||
constructor Create(const aAppService : TFMXApplicationService);
|
||||
function GetObjectiveCClass: PTypeInfo; override;
|
||||
|
||||
TCrAppProtocol = class(TOCLocal, ICrAppControlProtocol)
|
||||
private
|
||||
FAppService : TFMXApplicationService;
|
||||
// CrAppProtocol
|
||||
function isHandlingSendEvent: boolean; cdecl;
|
||||
|
||||
public
|
||||
constructor Create(const aAppService : TFMXApplicationService);
|
||||
// CrAppControlProtocol
|
||||
procedure setHandlingSendEvent(handlingSendEvent: boolean); cdecl;
|
||||
|
||||
// ICrAppProtocol
|
||||
function isHandlingSendEvent: boolean; cdecl;
|
||||
// IFMXApplicationDelegate
|
||||
procedure onMenuClicked(sender: NSMenuItem); cdecl;
|
||||
|
||||
// ICrAppControlProtocol
|
||||
procedure setHandlingSendEvent(handlingSendEvent: boolean); cdecl;
|
||||
|
||||
// NSApplicationDelegate
|
||||
function applicationShouldTerminate(Notification: NSNotification): NSInteger; cdecl;
|
||||
procedure applicationWillTerminate(Notification: NSNotification); cdecl;
|
||||
procedure applicationDidFinishLaunching(Notification: NSNotification); cdecl;
|
||||
procedure applicationDidHide(Notification: NSNotification); cdecl;
|
||||
procedure applicationDidUnhide(Notification: NSNotification); cdecl;
|
||||
function applicationDockMenu(sender: NSApplication): NSMenu; cdecl;
|
||||
// NSApplicationDelegate
|
||||
function applicationShouldTerminate(Notification: NSNotification): NSInteger; cdecl;
|
||||
procedure applicationWillTerminate(Notification: NSNotification); cdecl;
|
||||
procedure applicationDidFinishLaunching(Notification: NSNotification); cdecl;
|
||||
procedure applicationDidHide(Notification: NSNotification); cdecl;
|
||||
procedure applicationDidUnhide(Notification: NSNotification); cdecl;
|
||||
function applicationDockMenu(sender: NSApplication): NSMenu; cdecl;
|
||||
end;
|
||||
|
||||
TFMXApplicationService = class(TInterfacedObject, IFMXApplicationService)
|
||||
private
|
||||
FNewDelegate : ICrAppControlProtocol;
|
||||
FOldDelegate : NSApplicationDelegate;
|
||||
|
||||
protected
|
||||
class var OldFMXApplicationService: IFMXApplicationService;
|
||||
class var NewFMXApplicationService: IFMXApplicationService;
|
||||
FNewDelegate : IFMXApplicationDelegate;
|
||||
FOldDelegate : IFMXApplicationDelegate;
|
||||
|
||||
FHandlingSendEventOverride : boolean;
|
||||
|
||||
procedure ReplaceNSApplicationDelegate;
|
||||
procedure RestoreNSApplicationDelegate;
|
||||
|
||||
function GetHandlingSendEvent : boolean;
|
||||
function GetPrivateFieldAsBoolean(const aFieldName : string) : boolean;
|
||||
|
||||
public
|
||||
constructor Create;
|
||||
@ -112,6 +105,10 @@ type
|
||||
function Terminating: Boolean;
|
||||
function Running: Boolean;
|
||||
|
||||
// IFMXApplicationServiceEx
|
||||
function GetHandlingSendEvent : boolean;
|
||||
procedure SetHandlingSendEvent(aValue : boolean);
|
||||
|
||||
// NSApplicationDelegate
|
||||
function applicationShouldTerminate(Notification: NSNotification): NSInteger;
|
||||
procedure applicationWillTerminate(Notification: NSNotification);
|
||||
@ -120,39 +117,52 @@ type
|
||||
procedure applicationDidUnhide(Notification: NSNotification);
|
||||
function applicationDockMenu(sender: NSApplication): NSMenu;
|
||||
|
||||
// IFMXApplicationDelegate
|
||||
procedure onMenuClicked(sender: NSMenuItem);
|
||||
|
||||
class procedure AddPlatformService;
|
||||
|
||||
class var OldFMXApplicationService: IFMXApplicationService;
|
||||
class var NewFMXApplicationService: IFMXApplicationService;
|
||||
|
||||
property DefaultTitle : string read GetDefaultTitle;
|
||||
property Title : string read GetTitle write SetTitle;
|
||||
property AppVersion : string read GetVersionString;
|
||||
property HandlingSendEvent : boolean read GetHandlingSendEvent;
|
||||
property HandlingSendEvent : boolean read GetHandlingSendEvent write SetHandlingSendEvent;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.RTTI, FMX.Forms,
|
||||
uFMXExternalPumpBrowser, uCEFFMXWorkScheduler, uCEFApplication, uCEFConstants;
|
||||
System.RTTI, FMX.Forms, FMX.Helpers.Mac, System.Messaging,
|
||||
uFMXExternalPumpBrowser, uCEFFMXWorkScheduler, uCEFApplication, uCEFConstants,
|
||||
uCEFMacOSFunctions;
|
||||
|
||||
// TCrAppProtocol
|
||||
constructor TCrAppProtocol.Create(const aAppService : TFMXApplicationService);
|
||||
// TFMXApplicationDelegateEx
|
||||
constructor TFMXApplicationDelegateEx.Create(const aAppService : TFMXApplicationService);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FAppService := aAppService;
|
||||
end;
|
||||
|
||||
function TCrAppProtocol.isHandlingSendEvent: Boolean;
|
||||
function TFMXApplicationDelegateEx.GetObjectiveCClass: PTypeInfo;
|
||||
begin
|
||||
Result := TypeInfo(CrAppControlProtocol);
|
||||
end;
|
||||
|
||||
function TFMXApplicationDelegateEx.isHandlingSendEvent: Boolean;
|
||||
begin
|
||||
Result := (FAppService <> nil) and FAppService.HandlingSendEvent;
|
||||
end;
|
||||
|
||||
procedure TCrAppProtocol.setHandlingSendEvent(handlingSendEvent: boolean);
|
||||
procedure TFMXApplicationDelegateEx.setHandlingSendEvent(handlingSendEvent: boolean);
|
||||
begin
|
||||
//
|
||||
if (FAppService <> nil) then
|
||||
FAppService.HandlingSendEvent := handlingSendEvent;
|
||||
end;
|
||||
|
||||
function TCrAppProtocol.applicationShouldTerminate(Notification: NSNotification): NSInteger;
|
||||
function TFMXApplicationDelegateEx.applicationShouldTerminate(Notification: NSNotification): NSInteger;
|
||||
begin
|
||||
if assigned(FAppService) then
|
||||
Result := FAppService.applicationShouldTerminate(Notification)
|
||||
@ -160,31 +170,31 @@ begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
procedure TCrAppProtocol.applicationWillTerminate(Notification: NSNotification);
|
||||
procedure TFMXApplicationDelegateEx.applicationWillTerminate(Notification: NSNotification);
|
||||
begin
|
||||
if assigned(FAppService) then
|
||||
FAppService.applicationWillTerminate(Notification);
|
||||
end;
|
||||
|
||||
procedure TCrAppProtocol.applicationDidFinishLaunching(Notification: NSNotification);
|
||||
procedure TFMXApplicationDelegateEx.applicationDidFinishLaunching(Notification: NSNotification);
|
||||
begin
|
||||
if assigned(FAppService) then
|
||||
FAppService.applicationDidFinishLaunching(Notification);
|
||||
end;
|
||||
|
||||
procedure TCrAppProtocol.applicationDidHide(Notification: NSNotification);
|
||||
procedure TFMXApplicationDelegateEx.applicationDidHide(Notification: NSNotification);
|
||||
begin
|
||||
if assigned(FAppService) then
|
||||
FAppService.applicationDidHide(Notification);
|
||||
end;
|
||||
|
||||
procedure TCrAppProtocol.applicationDidUnhide(Notification: NSNotification);
|
||||
procedure TFMXApplicationDelegateEx.applicationDidUnhide(Notification: NSNotification);
|
||||
begin
|
||||
if assigned(FAppService) then
|
||||
FAppService.applicationDidUnhide(Notification);
|
||||
end;
|
||||
|
||||
function TCrAppProtocol.applicationDockMenu(sender: NSApplication): NSMenu;
|
||||
function TFMXApplicationDelegateEx.applicationDockMenu(sender: NSApplication): NSMenu;
|
||||
begin
|
||||
if assigned(FAppService) then
|
||||
Result := FAppService.applicationDockMenu(sender)
|
||||
@ -192,13 +202,21 @@ begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TFMXApplicationDelegateEx.onMenuClicked(sender: NSMenuItem);
|
||||
begin
|
||||
if assigned(FAppService) then
|
||||
FAppService.onMenuClicked(sender);
|
||||
end;
|
||||
|
||||
// TFMXApplicationService
|
||||
constructor TFMXApplicationService.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FNewDelegate := nil;
|
||||
FOldDelegate := nil;
|
||||
FNewDelegate := nil;
|
||||
FOldDelegate := nil;
|
||||
|
||||
FHandlingSendEventOverride := False;
|
||||
end;
|
||||
|
||||
procedure TFMXApplicationService.AfterConstruction;
|
||||
@ -213,10 +231,10 @@ var
|
||||
TempNSApplication : NSApplication;
|
||||
begin
|
||||
TempNSApplication := TNSApplication.Wrap(TNSApplication.OCClass.sharedApplication);
|
||||
FNewDelegate := ICrAppControlProtocol(TCrAppProtocol.Create(self));
|
||||
FOldDelegate := NSApplicationDelegate(TempNSApplication.delegate);
|
||||
FNewDelegate := IFMXApplicationDelegate(TFMXApplicationDelegateEx.Create(self));
|
||||
FOldDelegate := IFMXApplicationDelegate(TempNSApplication.delegate);
|
||||
|
||||
TempNSApplication.setDelegate(FNewDelegate);
|
||||
TempNSApplication.setDelegate(NSApplicationDelegate(FNewDelegate));
|
||||
end;
|
||||
|
||||
procedure TFMXApplicationService.RestoreNSApplicationDelegate;
|
||||
@ -231,21 +249,16 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFMXApplicationService.GetHandlingSendEvent : boolean;
|
||||
function TFMXApplicationService.GetPrivateFieldAsBoolean(const aFieldName : string) : boolean;
|
||||
var
|
||||
TempContext : TRttiContext;
|
||||
TempRttiType : TRttiType;
|
||||
TempField : TRttiField;
|
||||
TempService : TObject;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
// We need to know when NSApp.sendEvent is being called and TPlatformCocoa
|
||||
// has a private field with that information. In order to read that field we
|
||||
// have to use RTTI.
|
||||
// This function is based on this answer in stackoverflow :
|
||||
// https://stackoverflow.com/questions/28135592/showmodal-form-that-opens-nsopenpanel-is-force-closed-in-delphi-firemonkey-osx
|
||||
|
||||
Result := False;
|
||||
TempService := TObject(TPlatformServices.Current.GetPlatformService(IFMXWindowService));
|
||||
|
||||
if (TempService <> nil) then
|
||||
@ -254,13 +267,27 @@ begin
|
||||
|
||||
if (TempRttiType <> nil) then
|
||||
begin
|
||||
TempField := TempRttiType.GetField('FDisableClosePopups');
|
||||
TempField := TempRttiType.GetField(aFieldName);
|
||||
Result := (TempField <> nil) and
|
||||
TempField.GetValue(TempService).AsBoolean;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFMXApplicationService.SetHandlingSendEvent(aValue : boolean);
|
||||
begin
|
||||
FHandlingSendEventOverride := aValue;
|
||||
end;
|
||||
|
||||
function TFMXApplicationService.GetHandlingSendEvent : boolean;
|
||||
begin
|
||||
// We need to know when NSApp.sendEvent is being called and TPlatformCocoa
|
||||
// has a private field called FDisableClosePopups with that information.
|
||||
// In order to read that field we have to use RTTI.
|
||||
Result := FHandlingSendEventOverride or
|
||||
GetPrivateFieldAsBoolean('FDisableClosePopups');
|
||||
end;
|
||||
|
||||
class procedure TFMXApplicationService.AddPlatformService;
|
||||
begin
|
||||
if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationService, IInterface(OldFMXApplicationService)) then
|
||||
@ -366,6 +393,12 @@ begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TFMXApplicationService.onMenuClicked(sender: NSMenuItem);
|
||||
begin
|
||||
if assigned(FOldDelegate) then
|
||||
FOldDelegate.onMenuClicked(sender);
|
||||
end;
|
||||
|
||||
function TFMXApplicationService.HandleMessage: Boolean;
|
||||
begin
|
||||
Result := OldFMXApplicationService.HandleMessage;
|
||||
|
||||
@ -26,16 +26,6 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
|
||||
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
|
||||
object Layout1: TLayout
|
||||
Align = Right
|
||||
Padding.Left = 5.000000000000000000
|
||||
@ -44,7 +34,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
|
||||
@ -71,20 +61,42 @@ 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
|
||||
Interval = 300
|
||||
OnTimer = Timer1Timer
|
||||
Left = 40
|
||||
Top = 137
|
||||
Top = 129
|
||||
end
|
||||
object SaveDialog1: TSaveDialog
|
||||
DefaultExt = 'bmp'
|
||||
Filter = 'Bitmap files (*.bmp)|*.BMP'
|
||||
Title = 'Save snapshot'
|
||||
Left = 40
|
||||
Top = 201
|
||||
Top = 241
|
||||
end
|
||||
object Panel1: TFMXBufferPanel
|
||||
Align = Client
|
||||
@ -108,7 +120,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
|
||||
end
|
||||
object MainMenu1: TMainMenu
|
||||
Left = 40
|
||||
Top = 273
|
||||
Top = 297
|
||||
object EditMenu: TMenuItem
|
||||
Text = 'Edit'
|
||||
object UndoMenuItem: TMenuItem
|
||||
@ -158,10 +170,28 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
|
||||
end
|
||||
end
|
||||
end
|
||||
object PopupMenu1: TPopupMenu
|
||||
OnPopup = PopupMenu1Popup
|
||||
Left = 40
|
||||
Top = 353
|
||||
object BackMenuItem: TMenuItem
|
||||
Text = 'Back'
|
||||
OnClick = BackMenuItemClick
|
||||
end
|
||||
object ForwardMenuItem: TMenuItem
|
||||
Text = 'Forward'
|
||||
OnClick = ForwardMenuItemClick
|
||||
end
|
||||
end
|
||||
object OpenDialog1: TOpenDialog
|
||||
Left = 40
|
||||
Top = 185
|
||||
end
|
||||
object chrmosr: TFMXChromium
|
||||
OnBeforeContextMenu = chrmosrBeforeContextMenu
|
||||
OnTooltip = chrmosrTooltip
|
||||
OnCursorChange = chrmosrCursorChange
|
||||
OnJsdialog = chrmosrJsdialog
|
||||
OnBeforePopup = chrmosrBeforePopup
|
||||
OnAfterCreated = chrmosrAfterCreated
|
||||
OnBeforeClose = chrmosrBeforeClose
|
||||
|
||||
@ -46,9 +46,9 @@ uses
|
||||
Macapi.AppKit, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
|
||||
FMX.Edit, FMX.StdCtrls, FMX.Controls.Presentation,
|
||||
{$IFDEF DELPHI17_UP}FMX.Graphics,{$ENDIF}
|
||||
uCEFFMXChromium, uCEFFMXBufferPanel, uCEFFMXWorkScheduler,
|
||||
uCEFFMXChromium, uCEFFMXBufferPanel, uCEFTimerWorkScheduler,
|
||||
uCEFInterfaces, uCEFTypes, uCEFConstants, uCEFChromiumCore, FMX.Layouts,
|
||||
FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.Menus;
|
||||
FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.Menus, FMX.ComboEdit;
|
||||
|
||||
type
|
||||
tagRGBQUAD = record
|
||||
@ -59,9 +59,16 @@ type
|
||||
end;
|
||||
TRGBQuad = tagRGBQUAD;
|
||||
|
||||
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;
|
||||
@ -79,6 +86,11 @@ type
|
||||
PasteMenuItem: TMenuItem;
|
||||
DeleteMenuItem: TMenuItem;
|
||||
SelectAllMenuItem: TMenuItem;
|
||||
AddressCb: TComboEdit;
|
||||
PopupMenu1: TPopupMenu;
|
||||
BackMenuItem: TMenuItem;
|
||||
ForwardMenuItem: TMenuItem;
|
||||
OpenDialog1: TOpenDialog;
|
||||
|
||||
procedure GoBtnClick(Sender: TObject);
|
||||
procedure GoBtnEnter(Sender: TObject);
|
||||
@ -115,13 +127,15 @@ type
|
||||
procedure chrmosrAfterCreated(Sender: TObject; const browser: ICefBrowser);
|
||||
procedure chrmosrCursorChange(Sender: TObject; const browser: ICefBrowser; cursor_: TCefCursorHandle; cursorType: TCefCursorType; const customCursorInfo: PCefCursorInfo; var aResult: Boolean);
|
||||
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);
|
||||
procedure PopupMenu1Popup(Sender: TObject);
|
||||
|
||||
procedure SnapshotBtnClick(Sender: TObject);
|
||||
procedure SnapshotBtnEnter(Sender: TObject);
|
||||
|
||||
|
||||
procedure CopyMenuItemClick(Sender: TObject);
|
||||
procedure CutMenuItemClick(Sender: TObject);
|
||||
procedure DeleteMenuItemClick(Sender: TObject);
|
||||
@ -129,6 +143,8 @@ type
|
||||
procedure RedoMenuItemClick(Sender: TObject);
|
||||
procedure SelectAllMenuItemClick(Sender: TObject);
|
||||
procedure UndoMenuItemClick(Sender: TObject);
|
||||
procedure BackMenuItemClick(Sender: TObject);
|
||||
procedure ForwardMenuItemClick(Sender: TObject);
|
||||
|
||||
protected
|
||||
FPopUpBitmap : TBitmap;
|
||||
@ -143,10 +159,19 @@ type
|
||||
FMouseWheelService : IFMXMouseService;
|
||||
{$ENDIF}
|
||||
|
||||
FJSDialogInfo : TJSDialogInfo;
|
||||
FLastClickPoint : TPointF;
|
||||
|
||||
procedure GlobalCEFTimerWorkScheduler_OnAllowDoWork(Sender: TObject; var allow : boolean);
|
||||
|
||||
procedure LoadURL;
|
||||
function getModifiers(Shift: TShiftState; KeyCode: integer = 0): TCefEventFlags;
|
||||
function getModifiers(Shift: TShiftState): TCefEventFlags; overload;
|
||||
function getModifiers(Shift: TShiftState; KeyCode: integer): TCefEventFlags; overload;
|
||||
function getModifiers(Button: TMouseButton; Shift: TShiftState): TCefEventFlags; overload;
|
||||
function GetButton(Button: TMouseButton): TCefMouseButtonType;
|
||||
function GetMousePosition(var aPoint : TPointF) : boolean;
|
||||
procedure ShowPendingJSDialog;
|
||||
procedure ShowPendingPopupMenu;
|
||||
|
||||
public
|
||||
procedure DoResize;
|
||||
@ -158,27 +183,20 @@ type
|
||||
var
|
||||
FMXExternalPumpBrowserFrm : TFMXExternalPumpBrowserFrm;
|
||||
|
||||
// ****************************************************************************
|
||||
// ********************************* WARNING **********************************
|
||||
// ****************************************************************************
|
||||
// This demo is in ALPHA state. It's incomplete and some features may not work!
|
||||
// ****************************************************************************
|
||||
// Known issues and missing features :
|
||||
// - Right-click crashes the demo.
|
||||
// This is a simple browser using FireMonkey components in OSR mode (off-screen
|
||||
// rendering) and a external message pump for MacOS.
|
||||
|
||||
// It's recomemded to understand the code in the SimpleOSRBrowser and
|
||||
// OSRExternalPumpBrowser demos before reading the code in this demo.
|
||||
|
||||
// This is a simple browser using FireMonkey components in OSR mode (off-screen rendering)
|
||||
// and a external message pump for MacOS.
|
||||
|
||||
// It's recomemded to understand the code in the SimpleOSRBrowser and OSRExternalPumpBrowser demos before
|
||||
// reading the code in this demo.
|
||||
|
||||
// All FMX applications using CEF4Delphi should add the $(FrameworkType) conditional define
|
||||
// in the project options to avoid duplicated resources.
|
||||
// All FMX applications using CEF4Delphi should add the $(FrameworkType)
|
||||
// conditional define in the project options to avoid duplicated resources.
|
||||
// This demo has that define in the menu option :
|
||||
// Project -> Options -> Building -> Delphi compiler -> Conditional defines (All configurations)
|
||||
// Project -> Options -> Building -> Delphi compiler -> Conditional defines
|
||||
// (All configurations)
|
||||
|
||||
// The subprocesses may need to use "FMX" instead of the $(FrameworkType) conditional define
|
||||
// The subprocesses may need to use "FMX" instead of the $(FrameworkType)
|
||||
// conditional define
|
||||
|
||||
// As mentioned in the CEF4Delphi information page, Chromium in MacOS requires
|
||||
// 4 helper bundles used for the subprocesses. The helpers must be copied inside
|
||||
@ -196,6 +214,11 @@ var
|
||||
// helper bundles and the executable inside them. The "AppHelperRenamer" tool
|
||||
// can be used for that purpose.
|
||||
|
||||
// The CopyCEFFramework and CopyCEFHelpers calls in the DPR file will copy
|
||||
// the CEF binaries and the helper bundles automatically but those functions
|
||||
// should only be used during development because the final build should have
|
||||
// all the bundle contents signed using your "Apple developer certificate".
|
||||
|
||||
// All the helpers in this demo have extra information in the info.plist file.
|
||||
// Open the "Project -> Options..." menu option and select "Application -> Version Info"
|
||||
// in the left tree to edit the information in the info.plist file.
|
||||
@ -211,14 +234,17 @@ var
|
||||
// Adding the CEF binaries and the helpers to the "Contents/Frameworks"
|
||||
// directory while the main application is deployed is possible but then Delphi
|
||||
// runs codesign to sign all those files. You need to setup your
|
||||
// "apple developer certificate" details in the project options.
|
||||
// "Apple developer certificate" details in the project options.
|
||||
// Open the "Project -> Options..." menu option and select "Deployment -> Provisioning"
|
||||
// to fill the certificate details needed to sign your application.
|
||||
|
||||
// If you don't have a certificate you can put a breakpoint in the first code
|
||||
// line of the DPR file of your application and copy the CEF binaries and the
|
||||
// helper bundles in the "Contents/Frameworks" directory while the execution is
|
||||
// stopped.
|
||||
// Chromium requires subclassing NSApplication and implementing CrAppProtocol in
|
||||
// NSApplication but the Firemonkey framework only allows to do that partially.
|
||||
// This is a known cause of issues that can be avoided using custom popup menus
|
||||
// and dialogs. This demo shows how to use a custom popup menu to replace the
|
||||
// context menu and Firemonkey dialogs to replace JavaScript dialogs.
|
||||
// If you detect some other issues when the browser shows some native user
|
||||
// interface controls then replace them with custom Firemonkey controls.
|
||||
|
||||
// This is the destruction sequence in OSR mode :
|
||||
// 1- FormCloseQuery sets CanClose to the initial FCanClose value (False) and
|
||||
@ -236,26 +262,18 @@ implementation
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Math, System.IOUtils,
|
||||
FMX.Platform,
|
||||
FMX.Platform, FMX.DialogService, FMX.DialogService.Async,
|
||||
uCEFMiscFunctions, uCEFApplication, uFMXApplicationService,
|
||||
uCEFMacOSConstants, uCEFMacOSFunctions;
|
||||
|
||||
procedure GlobalCEFApp_OnScheduleMessagePumpWork(const aDelayMS : int64);
|
||||
begin
|
||||
if (GlobalFMXWorkScheduler <> nil) then
|
||||
GlobalFMXWorkScheduler.ScheduleMessagePumpWork(aDelayMS);
|
||||
if (GlobalCEFTimerWorkScheduler <> nil) then
|
||||
GlobalCEFTimerWorkScheduler.ScheduleMessagePumpWork(aDelayMS);
|
||||
end;
|
||||
|
||||
procedure CreateGlobalCEFApp;
|
||||
begin
|
||||
// TFMXWorkScheduler will call cef_do_message_loop_work when
|
||||
// it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event.
|
||||
// GlobalFMXWorkScheduler needs to be created before the
|
||||
// GlobalCEFApp.StartMainProcess call.
|
||||
GlobalFMXWorkScheduler := TFMXWorkScheduler.CreateDelayed;
|
||||
GlobalFMXWorkScheduler.UseQueueThread := True;
|
||||
GlobalFMXWorkScheduler.CreateThread;
|
||||
|
||||
GlobalCEFApp := TCefApplication.Create;
|
||||
GlobalCEFApp.WindowlessRenderingEnabled := True;
|
||||
GlobalCEFApp.EnableHighDPISupport := True;
|
||||
@ -268,6 +286,12 @@ begin
|
||||
GlobalCEFApp.LogFile := TPath.GetHomePath + TPath.DirectorySeparatorChar + 'debug.log';
|
||||
GlobalCEFApp.LogSeverity := LOGSEVERITY_INFO;
|
||||
{$ENDIF}
|
||||
|
||||
// TCEFTimerWorkScheduler will call cef_do_message_loop_work when
|
||||
// it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event.
|
||||
// GlobalCEFTimerWorkScheduler needs to be created before the
|
||||
// GlobalCEFApp.StartMainProcess call.
|
||||
GlobalCEFTimerWorkScheduler := TCEFTimerWorkScheduler.Create;
|
||||
end;
|
||||
|
||||
procedure TFMXExternalPumpBrowserFrm.FormActivate(Sender: TObject);
|
||||
@ -288,9 +312,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;
|
||||
@ -299,6 +325,8 @@ procedure TFMXExternalPumpBrowserFrm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
TFMXApplicationService.AddPlatformService;
|
||||
|
||||
GlobalCEFTimerWorkScheduler.OnAllowDoWork := GlobalCEFTimerWorkScheduler_OnAllowDoWork;
|
||||
|
||||
FPopUpBitmap := nil;
|
||||
FPopUpRect := rect(0, 0, 0, 0);
|
||||
FShowPopUp := False;
|
||||
@ -308,7 +336,7 @@ begin
|
||||
FClosing := False;
|
||||
FResizeCS := TCriticalSection.Create;
|
||||
|
||||
chrmosr.DefaultURL := AddressEdt.Text;
|
||||
chrmosr.DefaultURL := AddressCb.Text;
|
||||
|
||||
{$IFDEF DELPHI17_UP}
|
||||
if TPlatformServices.Current.SupportsPlatformService(IFMXMouseService) then
|
||||
@ -337,6 +365,11 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFMXExternalPumpBrowserFrm.ForwardMenuItemClick(Sender: TObject);
|
||||
begin
|
||||
chrmosr.GoForward;
|
||||
end;
|
||||
|
||||
procedure TFMXExternalPumpBrowserFrm.GoBtnClick(Sender: TObject);
|
||||
begin
|
||||
LoadURL;
|
||||
@ -349,7 +382,7 @@ begin
|
||||
FPendingResize := False;
|
||||
FResizeCS.Release;
|
||||
|
||||
chrmosr.LoadURL(AddressEdt.Text);
|
||||
chrmosr.LoadURL(AddressCb.Text);
|
||||
end;
|
||||
|
||||
procedure TFMXExternalPumpBrowserFrm.GoBtnEnter(Sender: TObject);
|
||||
@ -430,29 +463,9 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFMXExternalPumpBrowserFrm.Panel1MouseDown(Sender : TObject;
|
||||
Button : TMouseButton;
|
||||
Shift : TShiftState;
|
||||
X, Y : Single);
|
||||
var
|
||||
TempEvent : TCefMouseEvent;
|
||||
TempCount : integer;
|
||||
procedure TFMXExternalPumpBrowserFrm.GlobalCEFTimerWorkScheduler_OnAllowDoWork(Sender: TObject; var allow : boolean);
|
||||
begin
|
||||
if not(ssTouch in Shift) then
|
||||
begin
|
||||
Panel1.SetFocus;
|
||||
|
||||
TempEvent.x := round(X);
|
||||
TempEvent.y := round(Y);
|
||||
TempEvent.modifiers := getModifiers(Shift);
|
||||
|
||||
if (ssDouble in Shift) then
|
||||
TempCount := 2
|
||||
else
|
||||
TempCount := 1;
|
||||
|
||||
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, TempCount);
|
||||
end;
|
||||
allow := not(TFMXApplicationService(TFMXApplicationService.NewFMXApplicationService).GetHandlingSendEvent);
|
||||
end;
|
||||
|
||||
function TFMXExternalPumpBrowserFrm.GetMousePosition(var aPoint : TPointF) : boolean;
|
||||
@ -517,9 +530,11 @@ var
|
||||
begin
|
||||
if not(ssTouch in Shift) then
|
||||
begin
|
||||
FLastClickPoint.x := x;
|
||||
FLastClickPoint.y := y;
|
||||
TempEvent.x := round(X);
|
||||
TempEvent.y := round(Y);
|
||||
TempEvent.modifiers := getModifiers(Shift);
|
||||
TempEvent.modifiers := getModifiers(Button, Shift);
|
||||
|
||||
if (ssDouble in Shift) then
|
||||
TempCount := 2
|
||||
@ -530,6 +545,44 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFMXExternalPumpBrowserFrm.Panel1MouseDown(Sender : TObject;
|
||||
Button : TMouseButton;
|
||||
Shift : TShiftState;
|
||||
X, Y : Single);
|
||||
var
|
||||
TempEvent : TCefMouseEvent;
|
||||
TempCount : integer;
|
||||
begin
|
||||
if not(ssTouch in Shift) then
|
||||
begin
|
||||
Panel1.SetFocus;
|
||||
|
||||
TempEvent.x := round(X);
|
||||
TempEvent.y := round(Y);
|
||||
TempEvent.modifiers := getModifiers(Button, Shift);
|
||||
|
||||
if (Button = TMouseButton.mbRight) then
|
||||
begin
|
||||
// We set the focus in another control as a workaround to show the context
|
||||
// menu when we click the right mouse button.
|
||||
GoBtn.SetFocus;
|
||||
|
||||
// We move the event point slightly so the mouse is over the context menu
|
||||
TempEvent.x := TempEvent.x - 5;
|
||||
TempEvent.y := TempEvent.y - 5;
|
||||
end
|
||||
else
|
||||
Panel1.SetFocus;
|
||||
|
||||
if (ssDouble in Shift) then
|
||||
TempCount := 2
|
||||
else
|
||||
TempCount := 1;
|
||||
|
||||
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, TempCount);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFMXExternalPumpBrowserFrm.Panel1MouseWheel( Sender : TObject;
|
||||
Shift : TShiftState;
|
||||
WheelDelta : Integer;
|
||||
@ -559,6 +612,12 @@ begin
|
||||
chrmosr.ClipboardPaste;
|
||||
end;
|
||||
|
||||
procedure TFMXExternalPumpBrowserFrm.PopupMenu1Popup(Sender: TObject);
|
||||
begin
|
||||
BackMenuItem.Enabled := chrmosr.CanGoBack;
|
||||
ForwardMenuItem.Enabled := chrmosr.CanGoForward;
|
||||
end;
|
||||
|
||||
procedure TFMXExternalPumpBrowserFrm.RedoMenuItemClick(Sender: TObject);
|
||||
begin
|
||||
chrmosr.ClipboardRedo;
|
||||
@ -582,6 +641,11 @@ begin
|
||||
chrmosr.SendFocusEvent(False);
|
||||
end;
|
||||
|
||||
procedure TFMXExternalPumpBrowserFrm.BackMenuItemClick(Sender: TObject);
|
||||
begin
|
||||
chrmosr.GoBack;
|
||||
end;
|
||||
|
||||
procedure TFMXExternalPumpBrowserFrm.chrmosrAfterCreated(Sender: TObject; const browser: ICefBrowser);
|
||||
begin
|
||||
// Now the browser is fully initialized we can enable the UI.
|
||||
@ -606,8 +670,11 @@ procedure TFMXExternalPumpBrowserFrm.chrmosrBeforeContextMenu( Sender : TO
|
||||
const params : ICefContextMenuParams;
|
||||
const model : ICefMenuModel);
|
||||
begin
|
||||
// Disable the context menu to avoid a crash issue for now
|
||||
// Disable the context menu to avoid crashes and show a custom FMX popup menu instead.
|
||||
// You can call the methods in "model" to populate the custom popup menu with the original menu options.
|
||||
if (model <> nil) then model.Clear;
|
||||
|
||||
TThread.ForceQueue(nil, ShowPendingPopupMenu);
|
||||
end;
|
||||
|
||||
procedure TFMXExternalPumpBrowserFrm.chrmosrBeforePopup( Sender : TObject;
|
||||
@ -691,6 +758,79 @@ 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
|
||||
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.ShowPendingPopupMenu;
|
||||
var
|
||||
TempPoint : TPointF;
|
||||
begin
|
||||
if not(GetMousePosition(TempPoint)) then
|
||||
TempPoint := Panel1.ClientToScreen(FLastClickPoint);
|
||||
|
||||
PopupMenu1.Popup(TempPoint.X, TempPoint.Y);
|
||||
end;
|
||||
|
||||
procedure TFMXExternalPumpBrowserFrm.chrmosrPaint( Sender : TObject;
|
||||
const browser : ICefBrowser;
|
||||
type_ : TCefPaintElementType;
|
||||
@ -963,7 +1103,7 @@ begin
|
||||
if (chrmosr <> nil) then chrmosr.SendCaptureLostEvent;
|
||||
end;
|
||||
|
||||
function TFMXExternalPumpBrowserFrm.getModifiers(Shift: TShiftState; KeyCode: integer): TCefEventFlags;
|
||||
function TFMXExternalPumpBrowserFrm.getModifiers(Shift: TShiftState): TCefEventFlags;
|
||||
begin
|
||||
Result := EVENTFLAG_NONE;
|
||||
|
||||
@ -974,11 +1114,27 @@ begin
|
||||
if (ssRight in Shift) then Result := Result or EVENTFLAG_RIGHT_MOUSE_BUTTON;
|
||||
if (ssMiddle in Shift) then Result := Result or EVENTFLAG_MIDDLE_MOUSE_BUTTON;
|
||||
if (ssCommand in Shift) then Result := Result or EVENTFLAG_COMMAND_DOWN;
|
||||
end;
|
||||
|
||||
function TFMXExternalPumpBrowserFrm.getModifiers(Shift: TShiftState; KeyCode: integer): TCefEventFlags;
|
||||
begin
|
||||
Result := getModifiers(Shift);
|
||||
|
||||
if (KeyCode in CEF_MACOS_KEYPAD_KEYS) then
|
||||
Result := Result or EVENTFLAG_IS_KEY_PAD;
|
||||
end;
|
||||
|
||||
function TFMXExternalPumpBrowserFrm.getModifiers(Button: TMouseButton; Shift: TShiftState): TCefEventFlags;
|
||||
begin
|
||||
Result := getModifiers(shift);
|
||||
|
||||
case Button of
|
||||
TMouseButton.mbLeft : Result := Result or EVENTFLAG_LEFT_MOUSE_BUTTON;
|
||||
TMouseButton.mbRight : Result := Result or EVENTFLAG_RIGHT_MOUSE_BUTTON;
|
||||
TMouseButton.mbMiddle : Result := Result or EVENTFLAG_MIDDLE_MOUSE_BUTTON;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFMXExternalPumpBrowserFrm.GetButton(Button: TMouseButton): TCefMouseButtonType;
|
||||
begin
|
||||
case Button of
|
||||
|
||||
Reference in New Issue
Block a user