diff --git a/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uCEFLoader.pas b/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uCEFLoader.pas index 6b8c1452..848a3f7b 100644 --- a/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uCEFLoader.pas +++ b/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uCEFLoader.pas @@ -48,7 +48,7 @@ uses // Read the answer to this question for more more information : // https://stackoverflow.com/questions/52103407/changing-the-initialization-order-of-the-unit-in-delphi System.IOUtils, - uCEFApplication, uCEFConstants, uCEFWorkScheduler, uCEFLinuxFunctions, + uCEFApplication, uCEFConstants, uCEFTimerWorkScheduler, uCEFLinuxFunctions, uCEFLinuxTypes; implementation @@ -65,20 +65,12 @@ end; procedure GlobalCEFApp_OnScheduleMessagePumpWork(const aDelayMS : int64); begin - if (GlobalCEFWorkScheduler <> nil) then - GlobalCEFWorkScheduler.ScheduleMessagePumpWork(aDelayMS); + if (GlobalCEFTimerWorkScheduler <> nil) then + GlobalCEFTimerWorkScheduler.ScheduleMessagePumpWork(aDelayMS); end; procedure InitializeGlobalCEFApp; begin - // TCEFWorkScheduler will call cef_do_message_loop_work when - // it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event. - // GlobalCEFWorkScheduler needs to be created before the - // GlobalCEFApp.StartMainProcess call. - // We use CreateDelayed in order to have a single thread in the process while - // CEF is initialized. - GlobalCEFWorkScheduler := TCEFWorkScheduler.CreateDelayed; - GlobalCEFApp := TCefApplication.Create; GlobalCEFApp.WindowlessRenderingEnabled := True; GlobalCEFApp.EnableHighDPISupport := True; @@ -96,6 +88,14 @@ begin GlobalCEFApp.UserDataPath := GlobalCEFApp.FrameworkDirPath + TPath.DirectorySeparatorChar + 'User Data'; GlobalCEFApp.BrowserSubprocessPath := GlobalCEFApp.FrameworkDirPath + TPath.DirectorySeparatorChar + 'FMXExternalPumpBrowser2_sp'; + // 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. + // We use CreateDelayed in order to have a single thread in the process while + // CEF is initialized. + GlobalCEFTimerWorkScheduler := TCEFTimerWorkScheduler.Create; + {$IFDEF DEBUG} GlobalCEFApp.LogFile := TPath.GetHomePath + TPath.DirectorySeparatorChar + 'debug.log'; GlobalCEFApp.LogSeverity := LOGSEVERITY_INFO; @@ -107,7 +107,6 @@ begin GlobalCEFApp.DisableFeatures := 'HardwareMediaKeyHandling'; GlobalCEFApp.StartMainProcess; - GlobalCEFWorkScheduler.CreateThread; // Install xlib error handlers so that the application won't be terminated // on non-fatal errors. Must be done after initializing GTK. @@ -119,8 +118,8 @@ initialization InitializeGlobalCEFApp; finalization - if (GlobalCEFWorkScheduler <> nil) then GlobalCEFWorkScheduler.StopScheduler; + if (GlobalCEFTimerWorkScheduler <> nil) then GlobalCEFTimerWorkScheduler.StopScheduler; DestroyGlobalCEFApp; - DestroyGlobalCEFWorkScheduler; + DestroyGlobalCEFTimerWorkScheduler; end. diff --git a/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uFMXExternalPumpBrowser2.fmx b/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uFMXExternalPumpBrowser2.fmx index 1df38569..d3ceb1ac 100644 --- a/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uFMXExternalPumpBrowser2.fmx +++ b/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uFMXExternalPumpBrowser2.fmx @@ -98,7 +98,6 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm OnEnter = Panel1Enter OnExit = Panel1Exit OnResize = Panel1Resize - OnClick = Panel1Click OnMouseDown = Panel1MouseDown OnMouseMove = Panel1MouseMove OnMouseUp = Panel1MouseUp @@ -125,6 +124,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm object chrmosr: TFMXChromium OnLoadError = chrmosrLoadError OnLoadingStateChange = chrmosrLoadingStateChange + OnBeforeContextMenu = chrmosrBeforeContextMenu OnTooltip = chrmosrTooltip OnCursorChange = chrmosrCursorChange OnBeforePopup = chrmosrBeforePopup diff --git a/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uFMXExternalPumpBrowser2.pas b/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uFMXExternalPumpBrowser2.pas index 3ca4423e..1c550267 100644 --- a/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uFMXExternalPumpBrowser2.pas +++ b/demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uFMXExternalPumpBrowser2.pas @@ -66,7 +66,6 @@ type procedure Panel1Enter(Sender: TObject); procedure Panel1Exit(Sender: TObject); procedure Panel1Resize(Sender: TObject); - procedure Panel1Click(Sender: TObject); procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single); @@ -93,6 +92,7 @@ type procedure chrmosrCursorChange(Sender: TObject; const browser: ICefBrowser; cursor_: TCefCursorHandle; cursorType: TCefCursorType; const customCursorInfo: PCefCursorInfo; var aResult: Boolean); 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 Timer1Timer(Sender: TObject); procedure AddressEdtEnter(Sender: TObject); @@ -114,7 +114,8 @@ type {$ENDIF} procedure LoadURL; - function getModifiers(Shift: TShiftState): TCefEventFlags; + function getModifiers(Shift: TShiftState): TCefEventFlags; overload; + function getModifiers(Button: TMouseButton; Shift: TShiftState): TCefEventFlags; overload; function GetButton(Button: TMouseButton): TCefMouseButtonType; function GetMousePosition(var aPoint : TPointF) : boolean; public @@ -128,12 +129,6 @@ type var FMXExternalPumpBrowserFrm : TFMXExternalPumpBrowserFrm; -// *************************** -// ********* WARNING ********* -// *************************** -// This is a demo for LINUX and it's in ALPHA state. -// It still has several features unimplemented!!! - // This is a simple browser using FireMonkey components in OSR mode (off-screen rendering) // and a external message pump. @@ -301,11 +296,6 @@ begin if (chrmosr <> nil) then chrmosr.SendFocusEvent(False); end; -procedure TFMXExternalPumpBrowserFrm.Panel1Click(Sender: TObject); -begin - Panel1.SetFocus; -end; - procedure TFMXExternalPumpBrowserFrm.Panel1Enter(Sender: TObject); begin if (chrmosr <> nil) then chrmosr.SendFocusEvent(True); @@ -316,31 +306,6 @@ begin if (chrmosr <> nil) then chrmosr.SendFocusEvent(False); 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(Shift); - - if (ssDouble in Shift) then - TempCount := 2 - else - TempCount := 1; - - chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, TempCount); - end; -end; - function TFMXExternalPumpBrowserFrm.GetMousePosition(var aPoint : TPointF) : boolean; begin {$IFDEF DELPHI17_UP} @@ -370,6 +335,7 @@ begin TempEvent.x := round(TempPoint.x); TempEvent.y := round(TempPoint.y); TempEvent.modifiers := EVENTFLAG_NONE; + chrmosr.SendMouseMoveEvent(@TempEvent, True); end; end; @@ -385,6 +351,7 @@ begin TempEvent.x := round(x); TempEvent.y := round(y); TempEvent.modifiers := getModifiers(Shift); + chrmosr.SendMouseMoveEvent(@TempEvent, False); end; end; @@ -401,7 +368,14 @@ begin begin TempEvent.x := round(X); TempEvent.y := round(Y); - TempEvent.modifiers := getModifiers(Shift); + TempEvent.modifiers := getModifiers(Button, Shift); + + if (Button = TMouseButton.mbRight) then + begin + // 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; if (ssDouble in Shift) then TempCount := 2 @@ -412,6 +386,42 @@ 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 + 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; @@ -426,6 +436,7 @@ begin TempEvent.x := round(TempPoint.x); TempEvent.y := round(TempPoint.y); TempEvent.modifiers := getModifiers(Shift); + chrmosr.SendMouseWheelEvent(@TempEvent, 0, WheelDelta); end; end; @@ -468,6 +479,18 @@ begin end); end; +procedure TFMXExternalPumpBrowserFrm.chrmosrBeforeContextMenu( Sender : TObject; + const browser : ICefBrowser; + const frame : ICefFrame; + const params : ICefContextMenuParams; + const model : ICefMenuModel); +begin + // This demo doesn't implement the print events. + // See the "Lazarus_Linux/MiniBrowser" demo to know how to print in Linux. + if (model <> nil) then + model.Remove(MENU_ID_PRINT); +end; + procedure TFMXExternalPumpBrowserFrm.chrmosrBeforePopup( Sender : TObject; const browser : ICefBrowser; const frame : ICefFrame; @@ -839,6 +862,17 @@ begin if (ssMiddle in Shift) then Result := Result or EVENTFLAG_MIDDLE_MOUSE_BUTTON; 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 diff --git a/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dpr b/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dpr index e82489b6..b1261372 100644 --- a/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dpr +++ b/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dpr @@ -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. diff --git a/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXApplicationService.pas b/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXApplicationService.pas index ae082bae..0a53cc88 100644 --- a/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXApplicationService.pas +++ b/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXApplicationService.pas @@ -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; diff --git a/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.fmx b/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.fmx index e35e9680..7b05851a 100644 --- a/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.fmx +++ b/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.fmx @@ -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 diff --git a/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas b/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas index 959b25d8..d13d158a 100644 --- a/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas +++ b/demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas @@ -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 diff --git a/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dproj b/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dproj index 50649206..d75ae215 100644 --- a/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dproj +++ b/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dproj @@ -1,7 +1,7 @@  {BE24D13B-2634-4064-8746-AB331419C5FA} - 19.1 + 19.2 FMX FMXExternalPumpBrowser.dpr True @@ -341,6 +341,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas b/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas index 578b4c0d..5606d702 100644 --- a/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas +++ b/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas @@ -197,26 +197,28 @@ uses procedure GlobalCEFApp_OnScheduleMessagePumpWork(const aDelayMS : int64); begin - if (GlobalFMXWorkScheduler <> nil) then GlobalFMXWorkScheduler.ScheduleMessagePumpWork(aDelayMS); + if (GlobalFMXWorkScheduler <> nil) then + GlobalFMXWorkScheduler.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.Create(nil); - GlobalCEFApp := TCefApplication.Create; GlobalCEFApp.WindowlessRenderingEnabled := True; GlobalCEFApp.EnableHighDPISupport := True; GlobalCEFApp.ExternalMessagePump := True; GlobalCEFApp.MultiThreadedMessageLoop := False; GlobalCEFApp.OnScheduleMessagePumpWork := GlobalCEFApp_OnScheduleMessagePumpWork; - //GlobalCEFApp.EnableGPU := True; + {$IFDEF DEBUG} //GlobalCEFApp.LogFile := 'debug.log'; //GlobalCEFApp.LogSeverity := LOGSEVERITY_INFO; + {$ENDIF} + + // 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.Create(nil); end; procedure TFMXExternalPumpBrowserFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); diff --git a/demos/Delphi_FMX_Windows/FMXTabbedBrowser/FMXTabbedBrowser.dproj b/demos/Delphi_FMX_Windows/FMXTabbedBrowser/FMXTabbedBrowser.dproj index cbce8b4b..cf6d5930 100644 --- a/demos/Delphi_FMX_Windows/FMXTabbedBrowser/FMXTabbedBrowser.dproj +++ b/demos/Delphi_FMX_Windows/FMXTabbedBrowser/FMXTabbedBrowser.dproj @@ -1,7 +1,7 @@  {7AA2E07C-ACFB-4174-A9F1-083E9BB483BC} - 19.1 + 19.2 FMX FMXTabbedBrowser.dpr True @@ -329,6 +329,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uBrowserFrame.pas b/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uBrowserFrame.pas index 41b456a4..ccfd1a33 100644 --- a/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uBrowserFrame.pas +++ b/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uBrowserFrame.pas @@ -1,1062 +1,1057 @@ -// ************************************************************************ -// ***************************** 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 © 2021 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 - * 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 uBrowserFrame; - -{$I cef.inc} - -interface - -uses +// ************************************************************************ +// ***************************** 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 © 2021 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 + * 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 uBrowserFrame; + +{$I cef.inc} + +interface + +uses Winapi.Windows, System.SysUtils, System.Types, System.UITypes, System.Classes, WinApi.Messages, System.Variants, FMX.Types, {$IFDEF DELPHI17_UP}FMX.Graphics,{$ENDIF} System.SyncObjs, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, - FMX.Edit, FMX.Layouts, FMX.Controls.Presentation, FMX.TabControl, - uCEFChromiumCore, uCEFFMXChromium, uCEFFMXWindowParent, uCEFInterfaces, - uCEFTypes, uCEFConstants, uCEFFMXBufferPanel; - -type - TBrowserTitleEvent = procedure(Sender: TObject; const aTitle : string) of object; - - TBrowserFrame = class(TFrame) - FMXChromium1: TFMXChromium; - StatusBar: TStatusBar; - StatusLbl: TLabel; - AddressLay: TLayout; - GoBtn: TSpeedButton; - NavButtonLay: TLayout; - BackBtn: TSpeedButton; - ForwardBtn: TSpeedButton; - ReloadBtn: TSpeedButton; - StopBtn: TSpeedButton; - URLEdt: TEdit; - FMXBufferPanel1: TFMXBufferPanel; - - procedure BackBtnClick(Sender: TObject); - procedure ForwardBtnClick(Sender: TObject); - procedure ReloadBtnClick(Sender: TObject); - procedure StopBtnClick(Sender: TObject); - procedure GoBtnClick(Sender: TObject); - - procedure FMXBufferPanel1Enter(Sender: TObject); - procedure FMXBufferPanel1Exit(Sender: TObject); - procedure FMXBufferPanel1Resize(Sender: TObject); - procedure FMXBufferPanel1Click(Sender: TObject); - procedure FMXBufferPanel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); - procedure FMXBufferPanel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); - procedure FMXBufferPanel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single); - procedure FMXBufferPanel1MouseLeave(Sender: TObject); - procedure FMXBufferPanel1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); - procedure FMXBufferPanel1KeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState); - procedure FMXBufferPanel1DialogKey(Sender: TObject; var Key: Word; Shift: TShiftState); - - procedure FMXChromium1AfterCreated(Sender: TObject; const browser: ICefBrowser); - procedure FMXChromium1BeforeClose(Sender: TObject; const browser: ICefBrowser); - procedure FMXChromium1BeforePopup(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 FMXChromium1CursorChange(Sender: TObject; const browser: ICefBrowser; cursor_: TCefCursorHandle; cursorType: TCefCursorType; const customCursorInfo: PCefCursorInfo; var aResult: Boolean); - procedure FMXChromium1GetScreenInfo(Sender: TObject; const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out Result: Boolean); - procedure FMXChromium1GetScreenPoint(Sender: TObject; const browser: ICefBrowser; viewX, viewY: Integer; var screenX, screenY: Integer; out Result: Boolean); - procedure FMXChromium1GetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect); - procedure FMXChromium1Paint(Sender: TObject; const browser: ICefBrowser; type_: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; width, height: Integer); - procedure FMXChromium1PopupShow(Sender: TObject; const browser: ICefBrowser; show: Boolean); - procedure FMXChromium1PopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect); - procedure FMXChromium1Tooltip(Sender: TObject; const browser: ICefBrowser; var text: ustring; out Result: Boolean); - procedure FMXChromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring); - procedure FMXChromium1OpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; out Result: Boolean); - procedure FMXChromium1AddressChange(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const url: ustring); - procedure FMXChromium1LoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring); - procedure FMXChromium1LoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean); - procedure FMXChromium1StatusMessage(Sender: TObject; const browser: ICefBrowser; const value: ustring); - - protected - FPopUpBitmap : TBitmap; - FPopUpRect : TRect; - FShowPopUp : boolean; - FResizing : boolean; - FPendingResize : boolean; - FResizeCS : TCriticalSection; - FAtLeastWin8 : boolean; - FClosing : boolean; // Indicates that this frame is destroying the browser - FHomepage : string; // Used to set the TChromium.DefaultURL property - FOnBrowserDestroyed : TNotifyEvent; - FOnBrowserNeedsResize : TNotifyEvent; - FOnBrowserTitleChange : TBrowserTitleEvent; - - FLastClickCount : integer; - FLastClickTime : integer; - FLastClickPoint : TPointF; - FLastClickButton : TMouseButton; - - function GetParentForm : TCustomForm; - function GetParentTab : TTabItem; - - function getModifiers(Shift: TShiftState): TCefEventFlags; - function GetButton(Button: TMouseButton): TCefMouseButtonType; - function GetMousePosition(var aPoint : TPointF) : boolean; - procedure InitializeLastClick; - function CancelPreviousClick(const x, y : single; var aCurrentTime : integer) : boolean; - {$IFDEF MSWINDOWS} - function PostFormMessage(aMsg : cardinal; aWParam : WPARAM = 0; aLParam : LPARAM = 0) : boolean; - function ArePointerEventsSupported : boolean; - function HandlePenEvent(const aID : uint32; aMsg : cardinal) : boolean; - function HandleTouchEvent(const aID : uint32; aMsg : cardinal) : boolean; overload; - function HandlePointerEvent(const aMessage : TMsg) : boolean; - {$ENDIF} - - public - constructor Create(AOwner : TComponent); override; - destructor Destroy; override; - - procedure NotifyMoveOrResizeStarted; - procedure SendCaptureLostEvent; - {$IFDEF MSWINDOWS} - procedure HandleSYSCHAR(const aMessage : TMsg); - procedure HandleSYSKEYDOWN(const aMessage : TMsg); - procedure HandleSYSKEYUP(const aMessage : TMsg); - procedure HandleKEYDOWN(const aMessage : TMsg); - procedure HandleKEYUP(const aMessage : TMsg); - function HandlePOINTER(const aMessage : TMsg) : boolean; - {$ENDIF} - - procedure CreateBrowser; - procedure CloseBrowser; - procedure ResizeBrowser; - procedure FocusBrowser; - - property ParentForm : TCustomForm read GetParentForm; - property ParentTab : TTabItem read GetParentTab; - property Closing : boolean read FClosing; - property Homepage : string read FHomepage write FHomepage; - property OnBrowserDestroyed : TNotifyEvent read FOnBrowserDestroyed write FOnBrowserDestroyed; - property OnBrowserTitleChange : TBrowserTitleEvent read FOnBrowserTitleChange write FOnBrowserTitleChange; - property OnBrowserNeedsResize : TNotifyEvent read FOnBrowserNeedsResize write FOnBrowserNeedsResize; - end; - -implementation - -{$R *.fmx} - -uses + FMX.Edit, FMX.Layouts, FMX.Controls.Presentation, FMX.TabControl, + uCEFChromiumCore, uCEFFMXChromium, uCEFFMXWindowParent, uCEFInterfaces, + uCEFTypes, uCEFConstants, uCEFFMXBufferPanel; + +type + TBrowserTitleEvent = procedure(Sender: TObject; const aTitle : string) of object; + + TBrowserFrame = class(TFrame) + FMXChromium1: TFMXChromium; + StatusBar: TStatusBar; + StatusLbl: TLabel; + AddressLay: TLayout; + GoBtn: TSpeedButton; + NavButtonLay: TLayout; + BackBtn: TSpeedButton; + ForwardBtn: TSpeedButton; + ReloadBtn: TSpeedButton; + StopBtn: TSpeedButton; + URLEdt: TEdit; + FMXBufferPanel1: TFMXBufferPanel; + + procedure BackBtnClick(Sender: TObject); + procedure ForwardBtnClick(Sender: TObject); + procedure ReloadBtnClick(Sender: TObject); + procedure StopBtnClick(Sender: TObject); + procedure GoBtnClick(Sender: TObject); + + procedure FMXBufferPanel1Enter(Sender: TObject); + procedure FMXBufferPanel1Exit(Sender: TObject); + procedure FMXBufferPanel1Resize(Sender: TObject); + procedure FMXBufferPanel1Click(Sender: TObject); + procedure FMXBufferPanel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); + procedure FMXBufferPanel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); + procedure FMXBufferPanel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single); + procedure FMXBufferPanel1MouseLeave(Sender: TObject); + procedure FMXBufferPanel1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); + procedure FMXBufferPanel1KeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState); + procedure FMXBufferPanel1DialogKey(Sender: TObject; var Key: Word; Shift: TShiftState); + + procedure FMXChromium1AfterCreated(Sender: TObject; const browser: ICefBrowser); + procedure FMXChromium1BeforeClose(Sender: TObject; const browser: ICefBrowser); + procedure FMXChromium1BeforePopup(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 FMXChromium1CursorChange(Sender: TObject; const browser: ICefBrowser; cursor_: TCefCursorHandle; cursorType: TCefCursorType; const customCursorInfo: PCefCursorInfo; var aResult: Boolean); + procedure FMXChromium1GetScreenInfo(Sender: TObject; const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out Result: Boolean); + procedure FMXChromium1GetScreenPoint(Sender: TObject; const browser: ICefBrowser; viewX, viewY: Integer; var screenX, screenY: Integer; out Result: Boolean); + procedure FMXChromium1GetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect); + procedure FMXChromium1Paint(Sender: TObject; const browser: ICefBrowser; type_: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; width, height: Integer); + procedure FMXChromium1PopupShow(Sender: TObject; const browser: ICefBrowser; show: Boolean); + procedure FMXChromium1PopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect); + procedure FMXChromium1Tooltip(Sender: TObject; const browser: ICefBrowser; var text: ustring; out Result: Boolean); + procedure FMXChromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring); + procedure FMXChromium1OpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; out Result: Boolean); + procedure FMXChromium1AddressChange(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const url: ustring); + procedure FMXChromium1LoadError(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; const errorText, failedUrl: ustring); + procedure FMXChromium1LoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean); + procedure FMXChromium1StatusMessage(Sender: TObject; const browser: ICefBrowser; const value: ustring); + + protected + FPopUpBitmap : TBitmap; + FPopUpRect : TRect; + FShowPopUp : boolean; + FResizing : boolean; + FPendingResize : boolean; + FResizeCS : TCriticalSection; + FAtLeastWin8 : boolean; + FClosing : boolean; // Indicates that this frame is destroying the browser + FHomepage : string; // Used to set the TChromium.DefaultURL property + FOnBrowserDestroyed : TNotifyEvent; + FOnBrowserNeedsResize : TNotifyEvent; + FOnBrowserTitleChange : TBrowserTitleEvent; + + FLastClickCount : integer; + FLastClickTime : integer; + FLastClickPoint : TPointF; + FLastClickButton : TMouseButton; + + function GetParentForm : TCustomForm; + function GetParentTab : TTabItem; + + function getModifiers(Shift: TShiftState): TCefEventFlags; + function GetButton(Button: TMouseButton): TCefMouseButtonType; + function GetMousePosition(var aPoint : TPointF) : boolean; + procedure InitializeLastClick; + function CancelPreviousClick(const x, y : single; var aCurrentTime : integer) : boolean; + {$IFDEF MSWINDOWS} + function PostFormMessage(aMsg : cardinal; aWParam : WPARAM = 0; aLParam : LPARAM = 0) : boolean; + function ArePointerEventsSupported : boolean; + function HandlePenEvent(const aID : uint32; aMsg : cardinal) : boolean; + function HandleTouchEvent(const aID : uint32; aMsg : cardinal) : boolean; overload; + function HandlePointerEvent(const aMessage : TMsg) : boolean; + {$ENDIF} + + public + constructor Create(AOwner : TComponent); override; + destructor Destroy; override; + + procedure NotifyMoveOrResizeStarted; + procedure SendCaptureLostEvent; + {$IFDEF MSWINDOWS} + procedure HandleSYSCHAR(const aMessage : TMsg); + procedure HandleSYSKEYDOWN(const aMessage : TMsg); + procedure HandleSYSKEYUP(const aMessage : TMsg); + procedure HandleKEYDOWN(const aMessage : TMsg); + procedure HandleKEYUP(const aMessage : TMsg); + function HandlePOINTER(const aMessage : TMsg) : boolean; + {$ENDIF} + + procedure CreateBrowser; + procedure CloseBrowser; + procedure ResizeBrowser; + procedure FocusBrowser; + + property ParentForm : TCustomForm read GetParentForm; + property ParentTab : TTabItem read GetParentTab; + property Closing : boolean read FClosing; + property Homepage : string read FHomepage write FHomepage; + property OnBrowserDestroyed : TNotifyEvent read FOnBrowserDestroyed write FOnBrowserDestroyed; + property OnBrowserTitleChange : TBrowserTitleEvent read FOnBrowserTitleChange write FOnBrowserTitleChange; + property OnBrowserNeedsResize : TNotifyEvent read FOnBrowserNeedsResize write FOnBrowserNeedsResize; + end; + +implementation + +{$R *.fmx} + +uses FMX.Platform, {$IFDEF MSWINDOWS}FMX.Platform.Win,{$ENDIF} System.Math, - uCEFMiscFunctions, uCEFApplication, uBrowserTab, uMainForm; - -procedure TBrowserFrame.BackBtnClick(Sender: TObject); -begin - FMXChromium1.GoBack; -end; - -constructor TBrowserFrame.Create(AOwner : TComponent); -var - TempMajorVer, TempMinorVer : DWORD; -begin - inherited Create(AOwner); - - FClosing := False; - FHomepage := ''; - FOnBrowserDestroyed := nil; - FOnBrowserTitleChange := nil; - - FPopUpBitmap := nil; - FPopUpRect := rect(0, 0, 0, 0); - FShowPopUp := False; - FResizing := False; - FPendingResize := False; - FClosing := False; - FResizeCS := TCriticalSection.Create; - - FAtLeastWin8 := GetWindowsMajorMinorVersion(TempMajorVer, TempMinorVer) and - ((TempMajorVer > 6) or - ((TempMajorVer = 6) and (TempMinorVer >= 2))); - - InitializeLastClick; -end; + uCEFMiscFunctions, uCEFApplication, uBrowserTab, uMainForm; + +procedure TBrowserFrame.BackBtnClick(Sender: TObject); +begin + FMXChromium1.GoBack; +end; + +constructor TBrowserFrame.Create(AOwner : TComponent); +var + TempMajorVer, TempMinorVer : DWORD; +begin + inherited Create(AOwner); + + FClosing := False; + FHomepage := ''; + FOnBrowserDestroyed := nil; + FOnBrowserTitleChange := nil; + + FPopUpBitmap := nil; + FPopUpRect := rect(0, 0, 0, 0); + FShowPopUp := False; + FResizing := False; + FPendingResize := False; + FClosing := False; + FResizeCS := TCriticalSection.Create; + + FAtLeastWin8 := GetWindowsMajorMinorVersion(TempMajorVer, TempMinorVer) and + ((TempMajorVer > 6) or + ((TempMajorVer = 6) and (TempMinorVer >= 2))); + + InitializeLastClick; +end; destructor TBrowserFrame.Destroy; begin FResizeCS.Free; if (FPopUpBitmap <> nil) then FreeAndNil(FPopUpBitmap); - inherited Destroy; end; - procedure TBrowserFrame.ReloadBtnClick(Sender: TObject); -begin - FMXChromium1.Reload; -end; - +begin + FMXChromium1.Reload; +end; + procedure TBrowserFrame.FocusBrowser; begin - FMXBufferPanel1.SetFocus; + FMXBufferPanel1.SetFocus; end; - procedure TBrowserFrame.ResizeBrowser; -begin - try - if (FResizeCS <> nil) then - begin - FResizeCS.Acquire; - - if FResizing then - FPendingResize := True - else - if FMXBufferPanel1.BufferIsResized then - FMXChromium1.Invalidate(PET_VIEW) - else - begin - FResizing := True; - FMXChromium1.WasResized; - end; - end; - finally - if (FResizeCS <> nil) then FResizeCS.Release; - end; -end; +begin + try + if (FResizeCS <> nil) then + begin + FResizeCS.Acquire; + if FResizing then + FPendingResize := True + else + if FMXBufferPanel1.BufferIsResized then + FMXChromium1.Invalidate(PET_VIEW) + else + begin + FResizing := True; + FMXChromium1.WasResized; + end; + end; + finally + if (FResizeCS <> nil) then FResizeCS.Release; + end; +end; procedure TBrowserFrame.NotifyMoveOrResizeStarted; begin FMXChromium1.NotifyMoveOrResizeStarted; end; - -procedure TBrowserFrame.SendCaptureLostEvent; -begin - FMXChromium1.SendCaptureLostEvent; + +procedure TBrowserFrame.SendCaptureLostEvent; +begin + FMXChromium1.SendCaptureLostEvent; end; - - procedure TBrowserFrame.StopBtnClick(Sender: TObject); -begin - FMXChromium1.StopLoad; -end; - + + +procedure TBrowserFrame.StopBtnClick(Sender: TObject); +begin + FMXChromium1.StopLoad; +end; + procedure TBrowserFrame.FMXBufferPanel1Click(Sender: TObject); -begin - FocusBrowser; -end; - -procedure TBrowserFrame.FMXBufferPanel1DialogKey(Sender: TObject; var Key: Word; - Shift: TShiftState); -begin - if (Key = vkTab) then Key := 0; -end; - -procedure TBrowserFrame.FMXBufferPanel1Enter(Sender: TObject); -begin - FMXChromium1.SendFocusEvent(True); -end; - -procedure TBrowserFrame.FMXBufferPanel1Exit(Sender: TObject); -begin - FMXChromium1.SendFocusEvent(False); -end; - -procedure TBrowserFrame.FMXBufferPanel1KeyDown(Sender: TObject; var Key: Word; - var KeyChar: Char; Shift: TShiftState); -var - TempKeyEvent : TCefKeyEvent; -begin - if not(FMXBufferPanel1.IsFocused) then exit; - - if (Key = 0) and (KeyChar <> #0) then - begin - TempKeyEvent.kind := KEYEVENT_CHAR; - TempKeyEvent.modifiers := getModifiers(Shift); - TempKeyEvent.windows_key_code := ord(KeyChar); - TempKeyEvent.native_key_code := 0; - TempKeyEvent.is_system_key := ord(False); - TempKeyEvent.character := #0; - TempKeyEvent.unmodified_character := #0; - TempKeyEvent.focus_on_editable_field := ord(False); - - FMXChromium1.SendKeyEvent(@TempKeyEvent); - end - else - if (Key <> 0) and (KeyChar = #0) and - (Key in [vkLeft, vkRight, vkUp, vkDown]) then - Key := 0; -end; - -procedure TBrowserFrame.FMXBufferPanel1MouseDown(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Single); -var - TempEvent : TCefMouseEvent; - TempTime : integer; -begin - if not(ssTouch in Shift) then - begin - FocusBrowser; - - if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then - inc(FLastClickCount) - else - begin - FLastClickPoint.x := x; - FLastClickPoint.y := y; - FLastClickCount := 1; - end; - - FLastClickTime := TempTime; - FLastClickButton := Button; - - TempEvent.x := round(X); - TempEvent.y := round(Y); - TempEvent.modifiers := getModifiers(Shift); - FMXChromium1.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount); - end; -end; - -procedure TBrowserFrame.FMXBufferPanel1MouseLeave(Sender: TObject); -var - TempEvent : TCefMouseEvent; - TempPoint : TPoint; - TempPointF : TPointF; - TempTime : integer; -begin - if GetMousePosition(TempPointF) then - begin - TempPoint.x := round(TempPointF.x); - TempPoint.y := round(TempPointF.y); - TempPoint := FMXBufferPanel1.ScreenToclient(TempPoint); - - if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick; - - TempEvent.x := TempPoint.x; - TempEvent.y := TempPoint.y; - TempEvent.modifiers := GetCefMouseModifiers; - FMXChromium1.SendMouseMoveEvent(@TempEvent, True); - end; -end; - -procedure TBrowserFrame.FMXBufferPanel1MouseMove(Sender: TObject; - Shift: TShiftState; X, Y: Single); -var - TempEvent : TCefMouseEvent; - TempTime : integer; -begin - if not(ssTouch in Shift) then - begin - if CancelPreviousClick(x, y, TempTime) then InitializeLastClick; - - TempEvent.x := round(X); - TempEvent.y := round(Y); - TempEvent.modifiers := getModifiers(Shift); - FMXChromium1.SendMouseMoveEvent(@TempEvent, False); - end; -end; - -procedure TBrowserFrame.FMXBufferPanel1MouseUp(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Single); -var - TempEvent : TCefMouseEvent; -begin - if not(ssTouch in Shift) then - begin - TempEvent.x := round(X); - TempEvent.y := round(Y); - TempEvent.modifiers := getModifiers(Shift); - FMXChromium1.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount); - end; -end; - -procedure TBrowserFrame.FMXBufferPanel1MouseWheel(Sender: TObject; - Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); -var - TempEvent : TCefMouseEvent; - TempPoint : TPoint; - TempPointF : TPointF; -begin - if FMXBufferPanel1.IsFocused and GetMousePosition(TempPointF) then - begin - TempPoint.x := round(TempPointF.x); - TempPoint.y := round(TempPointF.y); - TempPoint := FMXBufferPanel1.ScreenToClient(TempPoint); - - TempEvent.x := TempPoint.x; - TempEvent.y := TempPoint.y; - TempEvent.modifiers := getModifiers(Shift); - FMXChromium1.SendMouseWheelEvent(@TempEvent, 0, WheelDelta); - end; -end; - -procedure TBrowserFrame.FMXBufferPanel1Resize(Sender: TObject); -begin - ResizeBrowser; -end; - -procedure TBrowserFrame.FMXChromium1AddressChange(Sender: TObject; - const browser: ICefBrowser; const frame: ICefFrame; const url: ustring); -begin - URLEdt.Text := url; -end; - -procedure TBrowserFrame.FMXChromium1AfterCreated(Sender: TObject; - const browser: ICefBrowser); -begin - AddressLay.Enabled := True; - FocusBrowser; -end; - -procedure TBrowserFrame.FMXChromium1BeforeClose(Sender: TObject; - const browser: ICefBrowser); -begin - if assigned(FOnBrowserDestroyed) then FOnBrowserDestroyed(Sender); -end; - -procedure TBrowserFrame.FMXChromium1BeforePopup(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 TBrowserFrame.FMXChromium1CursorChange(Sender: TObject; - const browser: ICefBrowser; cursor_: TCefCursorHandle; cursorType: TCefCursorType; - const customCursorInfo: PCefCursorInfo; var aResult: Boolean); -begin - FMXBufferPanel1.Cursor := CefCursorToWindowsCursor(cursorType); - aResult := True; -end; - -procedure TBrowserFrame.FMXChromium1GetScreenInfo(Sender: TObject; - const browser: ICefBrowser; var screenInfo: TCefScreenInfo; - out Result: Boolean); -var - TempRect : TCEFRect; -begin - TempRect.x := 0; - TempRect.y := 0; - TempRect.width := round(FMXBufferPanel1.Width); - TempRect.height := round(FMXBufferPanel1.Height); - - screenInfo.device_scale_factor := FMXBufferPanel1.ScreenScale; - screenInfo.depth := 0; - screenInfo.depth_per_component := 0; - screenInfo.is_monochrome := Ord(False); - screenInfo.rect := TempRect; - screenInfo.available_rect := TempRect; - - Result := True; -end; - -procedure TBrowserFrame.FMXChromium1GetScreenPoint(Sender: TObject; - const browser: ICefBrowser; viewX, viewY: Integer; var screenX, - screenY: Integer; out Result: Boolean); -var - TempScreenPt, TempViewPt : TPoint; -begin - // TFMXBufferPanel.ClientToScreen applies the scale factor. No need to call LogicalToDevice to set TempViewPt. - TempViewPt.x := viewX; - TempViewPt.y := viewY; - TempScreenPt := FMXBufferPanel1.ClientToScreen(TempViewPt); - screenX := TempScreenPt.x; - screenY := TempScreenPt.y; - Result := True; -end; - -procedure TBrowserFrame.FMXChromium1GetViewRect(Sender: TObject; - const browser: ICefBrowser; var rect: TCefRect); -begin - rect.x := 0; - rect.y := 0; - rect.width := round(FMXBufferPanel1.Width); - rect.height := round(FMXBufferPanel1.Height); -end; - -procedure TBrowserFrame.FMXChromium1LoadError(Sender: TObject; - const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; - const errorText, failedUrl: ustring); -var - TempString : string; -begin - if (errorCode = ERR_ABORTED) then exit; - - TempString := '' + - '

Failed to load URL ' + failedUrl + - ' with error ' + errorText + - ' (' + inttostr(errorCode) + ').

'; - - FMXChromium1.LoadString(TempString, frame); -end; - -procedure TBrowserFrame.FMXChromium1LoadingStateChange(Sender: TObject; - const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean); -begin - BackBtn.Enabled := canGoBack; - ForwardBtn.Enabled := canGoForward; - - if isLoading then - begin - ReloadBtn.Enabled := False; - StopBtn.Enabled := True; - end - else - begin - ReloadBtn.Enabled := True; - StopBtn.Enabled := False; - end; -end; - -procedure TBrowserFrame.FMXChromium1OpenUrlFromTab(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 TBrowserFrame.FMXChromium1Paint(Sender: TObject; - const browser: ICefBrowser; type_: TCefPaintElementType; - dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; - const buffer: Pointer; width, height: Integer); -var - src, dst: PByte; - i, j, TempLineSize, TempSrcOffset, TempDstOffset, SrcStride, TempWidth, TempHeight : Integer; - n : NativeUInt; - {$IFNDEF DELPHI17_UP} - TempScanlineSize, DstStride : integer; - {$ENDIF} - TempBufferBits : Pointer; - TempForcedResize : boolean; - TempBitmapData : TBitmapData; - TempBitmap : TBitmap; - TempSrcRect, TempDstRect : TRectF; -begin - try - FResizeCS.Acquire; - TempForcedResize := False; - - if FMXBufferPanel1.BeginBufferDraw then - try - if (type_ = PET_POPUP) then - begin - if (FPopUpBitmap = nil) or - (width <> FPopUpBitmap.Width) or - (height <> FPopUpBitmap.Height) then - begin - if (FPopUpBitmap <> nil) then FPopUpBitmap.Free; - - FPopUpBitmap := TBitmap.Create(width, height); - {$IFDEF DELPHI17_UP} - FPopUpBitmap.BitmapScale := FMXBufferPanel1.ScreenScale; - {$ENDIF} - end; - - TempWidth := FPopUpBitmap.Width; - TempHeight := FPopUpBitmap.Height; - {$IFNDEF DELPHI17_UP} - TempScanlineSize := FPopUpBitmap.BytesPerLine; - {$ENDIF} - TempBitmap := FPopUpBitmap; - end - else - begin - TempForcedResize := FMXBufferPanel1.UpdateBufferDimensions(Width, Height) or not(FMXBufferPanel1.BufferIsResized(False)); - TempWidth := FMXBufferPanel1.BufferWidth; - TempHeight := FMXBufferPanel1.BufferHeight; - {$IFNDEF DELPHI17_UP} - TempScanlineSize := FMXBufferPanel1.ScanlineSize; - {$ENDIF} - TempBitmap := FMXBufferPanel1.Buffer; - end; - - - if (TempBitmap <> nil) {$IFDEF DELPHI17_UP}and TempBitmap.Map(TMapAccess.ReadWrite, TempBitmapData){$ENDIF} then - begin - try - {$IFNDEF DELPHI17_UP} - TempBufferBits := TempBitmapData.StartLine; - DstStride := TempScanlineSize; - {$ENDIF} - SrcStride := Width * SizeOf(TRGBQuad); - - n := 0; - - while (n < dirtyRectsCount) do - begin - if (dirtyRects[n].x >= 0) and (dirtyRects[n].y >= 0) then - begin - TempLineSize := min(dirtyRects[n].width, TempWidth - dirtyRects[n].x) * SizeOf(TRGBQuad); - - if (TempLineSize > 0) then - begin - TempSrcOffset := ((dirtyRects[n].y * Width) + dirtyRects[n].x) * SizeOf(TRGBQuad); - - {$IFDEF DELPHI17_UP} - TempDstOffset := (dirtyRects[n].x * SizeOf(TRGBQuad)); - {$ELSE} - TempDstOffset := (dirtyRects[n].y * TempScanlineSize) + (dirtyRects[n].x * SizeOf(TRGBQuad)); - {$ENDIF} - - src := @PByte(buffer)[TempSrcOffset]; - {$IFNDEF DELPHI17_UP} - dst := @PByte(TempBufferBits)[TempDstOffset]; - {$ENDIF} - - i := 0; - j := min(dirtyRects[n].height, TempHeight - dirtyRects[n].y); - - while (i < j) do - begin - {$IFDEF DELPHI17_UP} - TempBufferBits := TempBitmapData.GetScanline(dirtyRects[n].y + i); - dst := @PByte(TempBufferBits)[TempDstOffset]; - {$ENDIF} - - System.Move(src^, dst^, TempLineSize); - - {$IFNDEF DELPHI17_UP} - inc(dst, DstStride); - {$ENDIF} - inc(src, SrcStride); - inc(i); - end; - end; - end; - - inc(n); - end; - - FMXBufferPanel1.InvalidatePanel; - finally - {$IFDEF DELPHI17_UP} - TempBitmap.Unmap(TempBitmapData); - {$ENDIF} - end; - - if FShowPopup and (FPopUpBitmap <> nil) then +begin + FocusBrowser; +end; + +procedure TBrowserFrame.FMXBufferPanel1DialogKey(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if (Key = vkTab) then Key := 0; +end; + +procedure TBrowserFrame.FMXBufferPanel1Enter(Sender: TObject); +begin + FMXChromium1.SendFocusEvent(True); +end; + +procedure TBrowserFrame.FMXBufferPanel1Exit(Sender: TObject); +begin + FMXChromium1.SendFocusEvent(False); +end; + +procedure TBrowserFrame.FMXBufferPanel1KeyDown(Sender: TObject; var Key: Word; + var KeyChar: Char; Shift: TShiftState); +var + TempKeyEvent : TCefKeyEvent; +begin + if not(FMXBufferPanel1.IsFocused) then exit; + + if (Key = 0) and (KeyChar <> #0) then + begin + TempKeyEvent.kind := KEYEVENT_CHAR; + TempKeyEvent.modifiers := getModifiers(Shift); + TempKeyEvent.windows_key_code := ord(KeyChar); + TempKeyEvent.native_key_code := 0; + TempKeyEvent.is_system_key := ord(False); + TempKeyEvent.character := #0; + TempKeyEvent.unmodified_character := #0; + TempKeyEvent.focus_on_editable_field := ord(False); + + FMXChromium1.SendKeyEvent(@TempKeyEvent); + end + else + if (Key <> 0) and (KeyChar = #0) and + (Key in [vkLeft, vkRight, vkUp, vkDown]) then + Key := 0; +end; + +procedure TBrowserFrame.FMXBufferPanel1MouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Single); +var + TempEvent : TCefMouseEvent; + TempTime : integer; +begin + if not(ssTouch in Shift) then + begin + FocusBrowser; + + if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then + inc(FLastClickCount) + else + begin + FLastClickPoint.x := x; + FLastClickPoint.y := y; + FLastClickCount := 1; + end; + + FLastClickTime := TempTime; + FLastClickButton := Button; + + TempEvent.x := round(X); + TempEvent.y := round(Y); + TempEvent.modifiers := getModifiers(Shift); + FMXChromium1.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount); + end; +end; + +procedure TBrowserFrame.FMXBufferPanel1MouseLeave(Sender: TObject); +var + TempEvent : TCefMouseEvent; + TempPoint : TPoint; + TempPointF : TPointF; + TempTime : integer; +begin + if GetMousePosition(TempPointF) then + begin + TempPoint.x := round(TempPointF.x); + TempPoint.y := round(TempPointF.y); + TempPoint := FMXBufferPanel1.ScreenToclient(TempPoint); + + if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick; + + TempEvent.x := TempPoint.x; + TempEvent.y := TempPoint.y; + TempEvent.modifiers := GetCefMouseModifiers; + FMXChromium1.SendMouseMoveEvent(@TempEvent, True); + end; +end; + +procedure TBrowserFrame.FMXBufferPanel1MouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Single); +var + TempEvent : TCefMouseEvent; + TempTime : integer; +begin + if not(ssTouch in Shift) then + begin + if CancelPreviousClick(x, y, TempTime) then InitializeLastClick; + + TempEvent.x := round(X); + TempEvent.y := round(Y); + TempEvent.modifiers := getModifiers(Shift); + FMXChromium1.SendMouseMoveEvent(@TempEvent, False); + end; +end; + +procedure TBrowserFrame.FMXBufferPanel1MouseUp(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Single); +var + TempEvent : TCefMouseEvent; +begin + if not(ssTouch in Shift) then + begin + TempEvent.x := round(X); + TempEvent.y := round(Y); + TempEvent.modifiers := getModifiers(Shift); + FMXChromium1.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount); + end; +end; + +procedure TBrowserFrame.FMXBufferPanel1MouseWheel(Sender: TObject; + Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); +var + TempEvent : TCefMouseEvent; + TempPoint : TPoint; + TempPointF : TPointF; +begin + if FMXBufferPanel1.IsFocused and GetMousePosition(TempPointF) then + begin + TempPoint.x := round(TempPointF.x); + TempPoint.y := round(TempPointF.y); + TempPoint := FMXBufferPanel1.ScreenToClient(TempPoint); + + TempEvent.x := TempPoint.x; + TempEvent.y := TempPoint.y; + TempEvent.modifiers := getModifiers(Shift); + FMXChromium1.SendMouseWheelEvent(@TempEvent, 0, WheelDelta); + end; +end; + +procedure TBrowserFrame.FMXBufferPanel1Resize(Sender: TObject); +begin + ResizeBrowser; +end; + +procedure TBrowserFrame.FMXChromium1AddressChange(Sender: TObject; + const browser: ICefBrowser; const frame: ICefFrame; const url: ustring); +begin + URLEdt.Text := url; +end; + +procedure TBrowserFrame.FMXChromium1AfterCreated(Sender: TObject; + const browser: ICefBrowser); +begin + AddressLay.Enabled := True; + FocusBrowser; +end; + +procedure TBrowserFrame.FMXChromium1BeforeClose(Sender: TObject; + const browser: ICefBrowser); +begin + if assigned(FOnBrowserDestroyed) then FOnBrowserDestroyed(Sender); +end; + +procedure TBrowserFrame.FMXChromium1BeforePopup(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 TBrowserFrame.FMXChromium1CursorChange(Sender: TObject; + const browser: ICefBrowser; cursor_: TCefCursorHandle; cursorType: TCefCursorType; + const customCursorInfo: PCefCursorInfo; var aResult: Boolean); +begin + FMXBufferPanel1.Cursor := CefCursorToWindowsCursor(cursorType); + aResult := True; +end; + +procedure TBrowserFrame.FMXChromium1GetScreenInfo(Sender: TObject; + const browser: ICefBrowser; var screenInfo: TCefScreenInfo; + out Result: Boolean); +var + TempRect : TCEFRect; +begin + TempRect.x := 0; + TempRect.y := 0; + TempRect.width := round(FMXBufferPanel1.Width); + TempRect.height := round(FMXBufferPanel1.Height); + + screenInfo.device_scale_factor := FMXBufferPanel1.ScreenScale; + screenInfo.depth := 0; + screenInfo.depth_per_component := 0; + screenInfo.is_monochrome := Ord(False); + screenInfo.rect := TempRect; + screenInfo.available_rect := TempRect; + + Result := True; +end; + +procedure TBrowserFrame.FMXChromium1GetScreenPoint(Sender: TObject; + const browser: ICefBrowser; viewX, viewY: Integer; var screenX, + screenY: Integer; out Result: Boolean); +var + TempScreenPt, TempViewPt : TPoint; +begin + // TFMXBufferPanel.ClientToScreen applies the scale factor. No need to call LogicalToDevice to set TempViewPt. + TempViewPt.x := viewX; + TempViewPt.y := viewY; + TempScreenPt := FMXBufferPanel1.ClientToScreen(TempViewPt); + screenX := TempScreenPt.x; + screenY := TempScreenPt.y; + Result := True; +end; + +procedure TBrowserFrame.FMXChromium1GetViewRect(Sender: TObject; + const browser: ICefBrowser; var rect: TCefRect); +begin + rect.x := 0; + rect.y := 0; + rect.width := round(FMXBufferPanel1.Width); + rect.height := round(FMXBufferPanel1.Height); +end; + +procedure TBrowserFrame.FMXChromium1LoadError(Sender: TObject; + const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer; + const errorText, failedUrl: ustring); +var + TempString : string; +begin + if (errorCode = ERR_ABORTED) then exit; + + TempString := '' + + '

Failed to load URL ' + failedUrl + + ' with error ' + errorText + + ' (' + inttostr(errorCode) + ').

'; + + FMXChromium1.LoadString(TempString, frame); +end; + +procedure TBrowserFrame.FMXChromium1LoadingStateChange(Sender: TObject; + const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean); +begin + BackBtn.Enabled := canGoBack; + ForwardBtn.Enabled := canGoForward; + + if isLoading then + begin + ReloadBtn.Enabled := False; + StopBtn.Enabled := True; + end + else + begin + ReloadBtn.Enabled := True; + StopBtn.Enabled := False; + end; +end; + +procedure TBrowserFrame.FMXChromium1OpenUrlFromTab(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 TBrowserFrame.FMXChromium1Paint(Sender: TObject; + const browser: ICefBrowser; type_: TCefPaintElementType; + dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; + const buffer: Pointer; width, height: Integer); +var + src, dst: PByte; + i, j, TempLineSize, TempSrcOffset, TempDstOffset, SrcStride, TempWidth, TempHeight : Integer; + n : NativeUInt; + {$IFNDEF DELPHI17_UP} + TempScanlineSize, DstStride : integer; + {$ENDIF} + TempBufferBits : Pointer; + TempForcedResize : boolean; + TempBitmapData : TBitmapData; + TempBitmap : TBitmap; + TempSrcRect, TempDstRect : TRectF; +begin + try + FResizeCS.Acquire; + TempForcedResize := False; + + if FMXBufferPanel1.BeginBufferDraw then + try + if (type_ = PET_POPUP) then + begin + if (FPopUpBitmap = nil) or + (width <> FPopUpBitmap.Width) or + (height <> FPopUpBitmap.Height) then + begin + if (FPopUpBitmap <> nil) then FPopUpBitmap.Free; + + FPopUpBitmap := TBitmap.Create(width, height); + {$IFDEF DELPHI17_UP} + FPopUpBitmap.BitmapScale := FMXBufferPanel1.ScreenScale; + {$ENDIF} + end; + + TempWidth := FPopUpBitmap.Width; + TempHeight := FPopUpBitmap.Height; + {$IFNDEF DELPHI17_UP} + TempScanlineSize := FPopUpBitmap.BytesPerLine; + {$ENDIF} + TempBitmap := FPopUpBitmap; + end + else + begin + TempForcedResize := FMXBufferPanel1.UpdateBufferDimensions(Width, Height) or not(FMXBufferPanel1.BufferIsResized(False)); + TempWidth := FMXBufferPanel1.BufferWidth; + TempHeight := FMXBufferPanel1.BufferHeight; + {$IFNDEF DELPHI17_UP} + TempScanlineSize := FMXBufferPanel1.ScanlineSize; + {$ENDIF} + TempBitmap := FMXBufferPanel1.Buffer; + end; + + + if (TempBitmap <> nil) {$IFDEF DELPHI17_UP}and TempBitmap.Map(TMapAccess.ReadWrite, TempBitmapData){$ENDIF} then + begin + try + {$IFNDEF DELPHI17_UP} + TempBufferBits := TempBitmapData.StartLine; + DstStride := TempScanlineSize; + {$ENDIF} + SrcStride := Width * SizeOf(TRGBQuad); + + n := 0; + + while (n < dirtyRectsCount) do + begin + if (dirtyRects[n].x >= 0) and (dirtyRects[n].y >= 0) then + begin + TempLineSize := min(dirtyRects[n].width, TempWidth - dirtyRects[n].x) * SizeOf(TRGBQuad); + + if (TempLineSize > 0) then + begin + TempSrcOffset := ((dirtyRects[n].y * Width) + dirtyRects[n].x) * SizeOf(TRGBQuad); + + {$IFDEF DELPHI17_UP} + TempDstOffset := (dirtyRects[n].x * SizeOf(TRGBQuad)); + {$ELSE} + TempDstOffset := (dirtyRects[n].y * TempScanlineSize) + (dirtyRects[n].x * SizeOf(TRGBQuad)); + {$ENDIF} + + src := @PByte(buffer)[TempSrcOffset]; + {$IFNDEF DELPHI17_UP} + dst := @PByte(TempBufferBits)[TempDstOffset]; + {$ENDIF} + + i := 0; + j := min(dirtyRects[n].height, TempHeight - dirtyRects[n].y); + + while (i < j) do + begin + {$IFDEF DELPHI17_UP} + TempBufferBits := TempBitmapData.GetScanline(dirtyRects[n].y + i); + dst := @PByte(TempBufferBits)[TempDstOffset]; + {$ENDIF} + + System.Move(src^, dst^, TempLineSize); + + {$IFNDEF DELPHI17_UP} + inc(dst, DstStride); + {$ENDIF} + inc(src, SrcStride); + inc(i); + end; + end; + end; + + inc(n); + end; + + FMXBufferPanel1.InvalidatePanel; + finally + {$IFDEF DELPHI17_UP} + TempBitmap.Unmap(TempBitmapData); + {$ENDIF} + end; + + if FShowPopup and (FPopUpBitmap <> nil) then begin TempSrcRect := RectF(0, 0, min(FPopUpRect.Width, FPopUpBitmap.Width), min(FPopUpRect.Height, FPopUpBitmap.Height)); - TempDstRect.Left := FPopUpRect.Left / GlobalCEFApp.DeviceScaleFactor; TempDstRect.Top := FPopUpRect.Top / GlobalCEFApp.DeviceScaleFactor; TempDstRect.Right := TempDstRect.Left + (TempSrcRect.Width / GlobalCEFApp.DeviceScaleFactor); TempDstRect.Bottom := TempDstRect.Top + (TempSrcRect.Height / GlobalCEFApp.DeviceScaleFactor); - FMXBufferPanel1.BufferDraw(FPopUpBitmap, TempSrcRect, TempDstRect); - end; - end; - - if (type_ = PET_VIEW) then - begin - if (TempForcedResize or FPendingResize) and - assigned(FOnBrowserNeedsResize) then - FOnBrowserNeedsResize(self); - - FResizing := False; - FPendingResize := False; - end; - finally - FMXBufferPanel1.EndBufferDraw; - end; - finally - FResizeCS.Release; - end; -end; - -procedure TBrowserFrame.FMXChromium1PopupShow(Sender: TObject; - const browser: ICefBrowser; show: Boolean); -begin - if show then - FShowPopUp := True - else - begin - FShowPopUp := False; - FPopUpRect := rect(0, 0, 0, 0); - - FMXChromium1.Invalidate(PET_VIEW); - end; -end; - -procedure TBrowserFrame.FMXChromium1PopupSize(Sender: TObject; - const browser: ICefBrowser; const rect: PCefRect); -begin - if (GlobalCEFApp <> nil) then + end; + end; + + if (type_ = PET_VIEW) then + begin + if (TempForcedResize or FPendingResize) and + assigned(FOnBrowserNeedsResize) then + FOnBrowserNeedsResize(self); + + FResizing := False; + FPendingResize := False; + end; + finally + FMXBufferPanel1.EndBufferDraw; + end; + finally + FResizeCS.Release; + end; +end; + +procedure TBrowserFrame.FMXChromium1PopupShow(Sender: TObject; + const browser: ICefBrowser; show: Boolean); +begin + if show then + FShowPopUp := True + else + begin + FShowPopUp := False; + FPopUpRect := rect(0, 0, 0, 0); + + FMXChromium1.Invalidate(PET_VIEW); + end; +end; + +procedure TBrowserFrame.FMXChromium1PopupSize(Sender: TObject; + const browser: ICefBrowser; const rect: PCefRect); +begin + if (GlobalCEFApp <> nil) then begin LogicalToDevice(rect^, GlobalCEFApp.DeviceScaleFactor); - FPopUpRect.Left := rect.x; FPopUpRect.Top := rect.y; FPopUpRect.Right := rect.x + rect.width - 1; FPopUpRect.Bottom := rect.y + rect.height - 1; - end; -end; - -procedure TBrowserFrame.FMXChromium1StatusMessage(Sender: TObject; - const browser: ICefBrowser; const value: ustring); -begin - StatusLbl.Text := value; -end; - -procedure TBrowserFrame.FMXChromium1TitleChange(Sender: TObject; - const browser: ICefBrowser; const title: ustring); -begin - if assigned(FOnBrowserTitleChange) then FOnBrowserTitleChange(Sender, title); -end; - -procedure TBrowserFrame.FMXChromium1Tooltip(Sender: TObject; - const browser: ICefBrowser; var text: ustring; out Result: Boolean); -begin - FMXBufferPanel1.Hint := text; - FMXBufferPanel1.ShowHint := (length(text) > 0); - Result := True; -end; - -procedure TBrowserFrame.ForwardBtnClick(Sender: TObject); -begin - FMXChromium1.GoForward; -end; - -function TBrowserFrame.GetParentForm : TCustomForm; -var - TempParent : TTabItem; -begin - Result := nil; - TempParent := ParentTab; - - if (TempParent <> nil) and (TempParent is TBrowserTab) then - Result := TBrowserTab(TempParent).ParentForm; -end; - -function TBrowserFrame.GetParentTab : TTabItem; -var - TempParent : TFMXObject; -begin - Result := nil; - TempParent := Parent; - - while (TempParent <> nil) and not(TempParent is TTabItem) do - TempParent := TempParent.Parent; - - if (TempParent <> nil) and (TempParent is TTabItem) then - Result := TTabItem(TempParent); -end; - -procedure TBrowserFrame.GoBtnClick(Sender: TObject); -begin - FMXChromium1.LoadURL(URLEdt.Text); -end; - -procedure TBrowserFrame.CreateBrowser; -begin + end; +end; + +procedure TBrowserFrame.FMXChromium1StatusMessage(Sender: TObject; + const browser: ICefBrowser; const value: ustring); +begin + StatusLbl.Text := value; +end; + +procedure TBrowserFrame.FMXChromium1TitleChange(Sender: TObject; + const browser: ICefBrowser; const title: ustring); +begin + if assigned(FOnBrowserTitleChange) then FOnBrowserTitleChange(Sender, title); +end; + +procedure TBrowserFrame.FMXChromium1Tooltip(Sender: TObject; + const browser: ICefBrowser; var text: ustring; out Result: Boolean); +begin + FMXBufferPanel1.Hint := text; + FMXBufferPanel1.ShowHint := (length(text) > 0); + Result := True; +end; + +procedure TBrowserFrame.ForwardBtnClick(Sender: TObject); +begin + FMXChromium1.GoForward; +end; + +function TBrowserFrame.GetParentForm : TCustomForm; +var + TempParent : TTabItem; +begin + Result := nil; + TempParent := ParentTab; + + if (TempParent <> nil) and (TempParent is TBrowserTab) then + Result := TBrowserTab(TempParent).ParentForm; +end; + +function TBrowserFrame.GetParentTab : TTabItem; +var + TempParent : TFMXObject; +begin + Result := nil; + TempParent := Parent; + + while (TempParent <> nil) and not(TempParent is TTabItem) do + TempParent := TempParent.Parent; + + if (TempParent <> nil) and (TempParent is TTabItem) then + Result := TTabItem(TempParent); +end; + +procedure TBrowserFrame.GoBtnClick(Sender: TObject); +begin + FMXChromium1.LoadURL(URLEdt.Text); +end; + +procedure TBrowserFrame.CreateBrowser; +begin if not(FMXChromium1.Initialized) then begin FMXChromium1.DefaultUrl := FHomepage; FMXChromium1.CreateBrowser; end; -end; - -procedure TBrowserFrame.CloseBrowser; -begin - if not(FClosing) then +end; + +procedure TBrowserFrame.CloseBrowser; +begin + if not(FClosing) then begin FClosing := True; AddressLay.Enabled := False; FMXChromium1.CloseBrowser(True); - end; -end; - -function TBrowserFrame.getModifiers(Shift: TShiftState): TCefEventFlags; -begin - Result := EVENTFLAG_NONE; - - if (ssShift in Shift) then Result := Result or EVENTFLAG_SHIFT_DOWN; - if (ssAlt in Shift) then Result := Result or EVENTFLAG_ALT_DOWN; - if (ssCtrl in Shift) then Result := Result or EVENTFLAG_CONTROL_DOWN; - if (ssLeft in Shift) then Result := Result or EVENTFLAG_LEFT_MOUSE_BUTTON; - if (ssRight in Shift) then Result := Result or EVENTFLAG_RIGHT_MOUSE_BUTTON; - if (ssMiddle in Shift) then Result := Result or EVENTFLAG_MIDDLE_MOUSE_BUTTON; -end; - -function TBrowserFrame.GetButton(Button: TMouseButton): TCefMouseButtonType; -begin - case Button of - TMouseButton.mbRight : Result := MBT_RIGHT; - TMouseButton.mbMiddle : Result := MBT_MIDDLE; - else Result := MBT_LEFT; - end; -end; - -function TBrowserFrame.GetMousePosition(var aPoint : TPointF) : boolean; -var - TempForm : TCustomForm; -begin - TempForm := ParentForm; - Result := (TempForm <> nil) and - (TempForm is TMainForm) and - TMainForm(TempForm).GetMousePosition(aPoint); -end; - -procedure TBrowserFrame.InitializeLastClick; -begin - FLastClickCount := 1; - FLastClickTime := 0; - FLastClickPoint.x := 0; - FLastClickPoint.y := 0; - FLastClickButton := TMouseButton.mbLeft; -end; - -function TBrowserFrame.CancelPreviousClick(const x, y : single; var aCurrentTime : integer) : boolean; -begin - {$IFDEF MSWINDOWS} - aCurrentTime := GetMessageTime; - - Result := (abs(FLastClickPoint.x - x) > (GetSystemMetrics(SM_CXDOUBLECLK) div 2)) or - (abs(FLastClickPoint.y - y) > (GetSystemMetrics(SM_CYDOUBLECLK) div 2)) or - (cardinal(aCurrentTime - FLastClickTime) > GetDoubleClickTime); - {$ELSE} - aCurrentTime := 0; - Result := False; - {$ENDIF} -end; - -{$IFDEF MSWINDOWS} -function TBrowserFrame.PostFormMessage(aMsg : cardinal; aWParam : WPARAM; aLParam : LPARAM) : boolean; -var - TempTab : TTabItem; - -begin - TempTab := ParentTab; - Result := (TempTab <> nil) and - (TempTab is TBrowserTab) and - TBrowserTab(TempTab).PostFormMessage(aMsg, aWParam, aLParam); -end; - -function TBrowserFrame.ArePointerEventsSupported : boolean; -begin - Result := FAtLeastWin8 and - (@GetPointerType <> nil) and - (@GetPointerTouchInfo <> nil) and - (@GetPointerPenInfo <> nil); -end; - -function TBrowserFrame.HandlePointerEvent(const aMessage : TMsg) : boolean; -const - PT_TOUCH = 2; - PT_PEN = 3; -var - TempID : uint32; - TempType : POINTER_INPUT_TYPE; -begin - Result := False; - TempID := LoWord(aMessage.wParam); - - if GetPointerType(TempID, @TempType) then - case TempType of - PT_PEN : Result := HandlePenEvent(TempID, aMessage.message); - PT_TOUCH : Result := HandleTouchEvent(TempID, aMessage.message); - end; -end; - -function TBrowserFrame.HandlePenEvent(const aID : uint32; aMsg : cardinal) : boolean; -var - TempPenInfo : POINTER_PEN_INFO; - TempTouchEvent : TCefTouchEvent; - TempPoint : TPoint; -begin - Result := False; - - if not(GetPointerPenInfo(aID, @TempPenInfo)) then exit; - - TempTouchEvent.id := aID; - TempTouchEvent.x := 0; - TempTouchEvent.y := 0; - TempTouchEvent.radius_x := 0; - TempTouchEvent.radius_y := 0; - TempTouchEvent.type_ := CEF_TET_RELEASED; - TempTouchEvent.modifiers := EVENTFLAG_NONE; - - if ((TempPenInfo.penFlags and PEN_FLAG_ERASER) <> 0) then - TempTouchEvent.pointer_type := CEF_POINTER_TYPE_ERASER - else - TempTouchEvent.pointer_type := CEF_POINTER_TYPE_PEN; - - if ((TempPenInfo.penMask and PEN_MASK_PRESSURE) <> 0) then - TempTouchEvent.pressure := TempPenInfo.pressure / 1024 - else - TempTouchEvent.pressure := 0; - - if ((TempPenInfo.penMask and PEN_MASK_ROTATION) <> 0) then - TempTouchEvent.rotation_angle := TempPenInfo.rotation / 180 * Pi - else - TempTouchEvent.rotation_angle := 0; - - Result := True; - - case aMsg of - WM_POINTERDOWN : - TempTouchEvent.type_ := CEF_TET_PRESSED; - - WM_POINTERUPDATE : - if ((TempPenInfo.pointerInfo.pointerFlags and POINTER_FLAG_INCONTACT) <> 0) then - TempTouchEvent.type_ := CEF_TET_MOVED - else - exit; // Ignore hover events. - - WM_POINTERUP : - TempTouchEvent.type_ := CEF_TET_RELEASED; - end; - - if ((TempPenInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then - TempTouchEvent.type_ := CEF_TET_CANCELLED; - - TempPoint := FMXBufferPanel1.ScreenToClient(TempPenInfo.pointerInfo.ptPixelLocation); - // TFMXBufferPanel.ScreenToClient applies the scale factor. No need to call DeviceToLogical to set TempTouchEvent. - TempTouchEvent.x := TempPoint.x; - TempTouchEvent.y := TempPoint.y; - - FMXChromium1.SendTouchEvent(@TempTouchEvent); -end; - -function TBrowserFrame.HandleTouchEvent(const aID : uint32; aMsg : cardinal) : boolean; -var - TempTouchInfo : POINTER_TOUCH_INFO; - TempTouchEvent : TCefTouchEvent; - TempPoint : TPoint; -begin - Result := False; - - if not(GetPointerTouchInfo(aID, @TempTouchInfo)) then exit; - - TempTouchEvent.id := aID; - TempTouchEvent.x := 0; - TempTouchEvent.y := 0; - TempTouchEvent.radius_x := 0; - TempTouchEvent.radius_y := 0; - TempTouchEvent.rotation_angle := 0; - TempTouchEvent.pressure := 0; - TempTouchEvent.type_ := CEF_TET_RELEASED; - TempTouchEvent.modifiers := EVENTFLAG_NONE; - TempTouchEvent.pointer_type := CEF_POINTER_TYPE_TOUCH; - - Result := True; - - case aMsg of - WM_POINTERDOWN : - TempTouchEvent.type_ := CEF_TET_PRESSED; - - WM_POINTERUPDATE : - if ((TempTouchInfo.pointerInfo.pointerFlags and POINTER_FLAG_INCONTACT) <> 0) then - TempTouchEvent.type_ := CEF_TET_MOVED - else - exit; // Ignore hover events. - - WM_POINTERUP : - TempTouchEvent.type_ := CEF_TET_RELEASED; - end; - - if ((TempTouchInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then - TempTouchEvent.type_ := CEF_TET_CANCELLED; - - TempPoint := FMXBufferPanel1.ScreenToClient(TempTouchInfo.pointerInfo.ptPixelLocation); - // TFMXBufferPanel.ScreenToClient applies the scale factor. No need to call DeviceToLogical to set TempTouchEvent. - TempTouchEvent.x := TempPoint.x; - TempTouchEvent.y := TempPoint.y; - - FMXChromium1.SendTouchEvent(@TempTouchEvent); -end; + end; +end; + +function TBrowserFrame.getModifiers(Shift: TShiftState): TCefEventFlags; +begin + Result := EVENTFLAG_NONE; + + if (ssShift in Shift) then Result := Result or EVENTFLAG_SHIFT_DOWN; + if (ssAlt in Shift) then Result := Result or EVENTFLAG_ALT_DOWN; + if (ssCtrl in Shift) then Result := Result or EVENTFLAG_CONTROL_DOWN; + if (ssLeft in Shift) then Result := Result or EVENTFLAG_LEFT_MOUSE_BUTTON; + if (ssRight in Shift) then Result := Result or EVENTFLAG_RIGHT_MOUSE_BUTTON; + if (ssMiddle in Shift) then Result := Result or EVENTFLAG_MIDDLE_MOUSE_BUTTON; +end; + +function TBrowserFrame.GetButton(Button: TMouseButton): TCefMouseButtonType; +begin + case Button of + TMouseButton.mbRight : Result := MBT_RIGHT; + TMouseButton.mbMiddle : Result := MBT_MIDDLE; + else Result := MBT_LEFT; + end; +end; + +function TBrowserFrame.GetMousePosition(var aPoint : TPointF) : boolean; +var + TempForm : TCustomForm; +begin + TempForm := ParentForm; + Result := (TempForm <> nil) and + (TempForm is TMainForm) and + TMainForm(TempForm).GetMousePosition(aPoint); +end; + +procedure TBrowserFrame.InitializeLastClick; +begin + FLastClickCount := 1; + FLastClickTime := 0; + FLastClickPoint.x := 0; + FLastClickPoint.y := 0; + FLastClickButton := TMouseButton.mbLeft; +end; + +function TBrowserFrame.CancelPreviousClick(const x, y : single; var aCurrentTime : integer) : boolean; +begin + {$IFDEF MSWINDOWS} + aCurrentTime := GetMessageTime; + + Result := (abs(FLastClickPoint.x - x) > (GetSystemMetrics(SM_CXDOUBLECLK) div 2)) or + (abs(FLastClickPoint.y - y) > (GetSystemMetrics(SM_CYDOUBLECLK) div 2)) or + (cardinal(aCurrentTime - FLastClickTime) > GetDoubleClickTime); + {$ELSE} + aCurrentTime := 0; + Result := False; + {$ENDIF} +end; + +{$IFDEF MSWINDOWS} +function TBrowserFrame.PostFormMessage(aMsg : cardinal; aWParam : WPARAM; aLParam : LPARAM) : boolean; +var + TempTab : TTabItem; + +begin + TempTab := ParentTab; + Result := (TempTab <> nil) and + (TempTab is TBrowserTab) and + TBrowserTab(TempTab).PostFormMessage(aMsg, aWParam, aLParam); +end; + +function TBrowserFrame.ArePointerEventsSupported : boolean; +begin + Result := FAtLeastWin8 and + (@GetPointerType <> nil) and + (@GetPointerTouchInfo <> nil) and + (@GetPointerPenInfo <> nil); +end; + +function TBrowserFrame.HandlePointerEvent(const aMessage : TMsg) : boolean; +const + PT_TOUCH = 2; + PT_PEN = 3; +var + TempID : uint32; + TempType : POINTER_INPUT_TYPE; +begin + Result := False; + TempID := LoWord(aMessage.wParam); + + if GetPointerType(TempID, @TempType) then + case TempType of + PT_PEN : Result := HandlePenEvent(TempID, aMessage.message); + PT_TOUCH : Result := HandleTouchEvent(TempID, aMessage.message); + end; +end; + +function TBrowserFrame.HandlePenEvent(const aID : uint32; aMsg : cardinal) : boolean; +var + TempPenInfo : POINTER_PEN_INFO; + TempTouchEvent : TCefTouchEvent; + TempPoint : TPoint; +begin + Result := False; + + if not(GetPointerPenInfo(aID, @TempPenInfo)) then exit; + + TempTouchEvent.id := aID; + TempTouchEvent.x := 0; + TempTouchEvent.y := 0; + TempTouchEvent.radius_x := 0; + TempTouchEvent.radius_y := 0; + TempTouchEvent.type_ := CEF_TET_RELEASED; + TempTouchEvent.modifiers := EVENTFLAG_NONE; + + if ((TempPenInfo.penFlags and PEN_FLAG_ERASER) <> 0) then + TempTouchEvent.pointer_type := CEF_POINTER_TYPE_ERASER + else + TempTouchEvent.pointer_type := CEF_POINTER_TYPE_PEN; + + if ((TempPenInfo.penMask and PEN_MASK_PRESSURE) <> 0) then + TempTouchEvent.pressure := TempPenInfo.pressure / 1024 + else + TempTouchEvent.pressure := 0; + + if ((TempPenInfo.penMask and PEN_MASK_ROTATION) <> 0) then + TempTouchEvent.rotation_angle := TempPenInfo.rotation / 180 * Pi + else + TempTouchEvent.rotation_angle := 0; + + Result := True; + + case aMsg of + WM_POINTERDOWN : + TempTouchEvent.type_ := CEF_TET_PRESSED; + + WM_POINTERUPDATE : + if ((TempPenInfo.pointerInfo.pointerFlags and POINTER_FLAG_INCONTACT) <> 0) then + TempTouchEvent.type_ := CEF_TET_MOVED + else + exit; // Ignore hover events. + + WM_POINTERUP : + TempTouchEvent.type_ := CEF_TET_RELEASED; + end; + + if ((TempPenInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then + TempTouchEvent.type_ := CEF_TET_CANCELLED; + + TempPoint := FMXBufferPanel1.ScreenToClient(TempPenInfo.pointerInfo.ptPixelLocation); + // TFMXBufferPanel.ScreenToClient applies the scale factor. No need to call DeviceToLogical to set TempTouchEvent. + TempTouchEvent.x := TempPoint.x; + TempTouchEvent.y := TempPoint.y; + + FMXChromium1.SendTouchEvent(@TempTouchEvent); +end; + +function TBrowserFrame.HandleTouchEvent(const aID : uint32; aMsg : cardinal) : boolean; +var + TempTouchInfo : POINTER_TOUCH_INFO; + TempTouchEvent : TCefTouchEvent; + TempPoint : TPoint; +begin + Result := False; + + if not(GetPointerTouchInfo(aID, @TempTouchInfo)) then exit; + + TempTouchEvent.id := aID; + TempTouchEvent.x := 0; + TempTouchEvent.y := 0; + TempTouchEvent.radius_x := 0; + TempTouchEvent.radius_y := 0; + TempTouchEvent.rotation_angle := 0; + TempTouchEvent.pressure := 0; + TempTouchEvent.type_ := CEF_TET_RELEASED; + TempTouchEvent.modifiers := EVENTFLAG_NONE; + TempTouchEvent.pointer_type := CEF_POINTER_TYPE_TOUCH; + + Result := True; + + case aMsg of + WM_POINTERDOWN : + TempTouchEvent.type_ := CEF_TET_PRESSED; + + WM_POINTERUPDATE : + if ((TempTouchInfo.pointerInfo.pointerFlags and POINTER_FLAG_INCONTACT) <> 0) then + TempTouchEvent.type_ := CEF_TET_MOVED + else + exit; // Ignore hover events. + + WM_POINTERUP : + TempTouchEvent.type_ := CEF_TET_RELEASED; + end; + + if ((TempTouchInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then + TempTouchEvent.type_ := CEF_TET_CANCELLED; + + TempPoint := FMXBufferPanel1.ScreenToClient(TempTouchInfo.pointerInfo.ptPixelLocation); + // TFMXBufferPanel.ScreenToClient applies the scale factor. No need to call DeviceToLogical to set TempTouchEvent. + TempTouchEvent.x := TempPoint.x; + TempTouchEvent.y := TempPoint.y; + + FMXChromium1.SendTouchEvent(@TempTouchEvent); +end; procedure TBrowserFrame.HandleSYSCHAR(const aMessage : TMsg); -var - TempKeyEvent : TCefKeyEvent; -begin - if FMXBufferPanel1.IsFocused and (aMessage.wParam in [VK_BACK..VK_HELP]) then - begin - TempKeyEvent.kind := KEYEVENT_CHAR; - TempKeyEvent.modifiers := GetCefKeyboardModifiers(aMessage.wParam, aMessage.lParam); - TempKeyEvent.windows_key_code := integer(aMessage.wParam); - TempKeyEvent.native_key_code := integer(aMessage.lParam); - TempKeyEvent.is_system_key := ord(True); - TempKeyEvent.character := #0; - TempKeyEvent.unmodified_character := #0; - TempKeyEvent.focus_on_editable_field := ord(False); - - FMXChromium1.SendKeyEvent(@TempKeyEvent); - end; -end; - -procedure TBrowserFrame.HandleSYSKEYDOWN(const aMessage : TMsg); -var - TempKeyEvent : TCefKeyEvent; -begin - if FMXBufferPanel1.IsFocused and (aMessage.wParam in [VK_BACK..VK_HELP]) then - begin - TempKeyEvent.kind := KEYEVENT_RAWKEYDOWN; - TempKeyEvent.modifiers := GetCefKeyboardModifiers(aMessage.wParam, aMessage.lParam); - TempKeyEvent.windows_key_code := integer(aMessage.wParam); - TempKeyEvent.native_key_code := integer(aMessage.lParam); - TempKeyEvent.is_system_key := ord(True); - TempKeyEvent.character := #0; - TempKeyEvent.unmodified_character := #0; - TempKeyEvent.focus_on_editable_field := ord(False); - - FMXChromium1.SendKeyEvent(@TempKeyEvent); - end; -end; - -procedure TBrowserFrame.HandleSYSKEYUP(const aMessage : TMsg); -var - TempKeyEvent : TCefKeyEvent; -begin - if FMXBufferPanel1.IsFocused and (aMessage.wParam in [VK_BACK..VK_HELP]) then - begin - TempKeyEvent.kind := KEYEVENT_KEYUP; - TempKeyEvent.modifiers := GetCefKeyboardModifiers(aMessage.wParam, aMessage.lParam); - TempKeyEvent.windows_key_code := integer(aMessage.wParam); - TempKeyEvent.native_key_code := integer(aMessage.lParam); - TempKeyEvent.is_system_key := ord(True); - TempKeyEvent.character := #0; - TempKeyEvent.unmodified_character := #0; - TempKeyEvent.focus_on_editable_field := ord(False); - - FMXChromium1.SendKeyEvent(@TempKeyEvent); - end; +var + TempKeyEvent : TCefKeyEvent; +begin + if FMXBufferPanel1.IsFocused and (aMessage.wParam in [VK_BACK..VK_HELP]) then + begin + TempKeyEvent.kind := KEYEVENT_CHAR; + TempKeyEvent.modifiers := GetCefKeyboardModifiers(aMessage.wParam, aMessage.lParam); + TempKeyEvent.windows_key_code := integer(aMessage.wParam); + TempKeyEvent.native_key_code := integer(aMessage.lParam); + TempKeyEvent.is_system_key := ord(True); + TempKeyEvent.character := #0; + TempKeyEvent.unmodified_character := #0; + TempKeyEvent.focus_on_editable_field := ord(False); + + FMXChromium1.SendKeyEvent(@TempKeyEvent); + end; end; - -procedure TBrowserFrame.HandleKEYDOWN(const aMessage : TMsg); -var - TempKeyEvent : TCefKeyEvent; -begin - if FMXBufferPanel1.IsFocused then + +procedure TBrowserFrame.HandleSYSKEYDOWN(const aMessage : TMsg); +var + TempKeyEvent : TCefKeyEvent; +begin + if FMXBufferPanel1.IsFocused and (aMessage.wParam in [VK_BACK..VK_HELP]) then + begin + TempKeyEvent.kind := KEYEVENT_RAWKEYDOWN; + TempKeyEvent.modifiers := GetCefKeyboardModifiers(aMessage.wParam, aMessage.lParam); + TempKeyEvent.windows_key_code := integer(aMessage.wParam); + TempKeyEvent.native_key_code := integer(aMessage.lParam); + TempKeyEvent.is_system_key := ord(True); + TempKeyEvent.character := #0; + TempKeyEvent.unmodified_character := #0; + TempKeyEvent.focus_on_editable_field := ord(False); + + FMXChromium1.SendKeyEvent(@TempKeyEvent); + end; +end; + +procedure TBrowserFrame.HandleSYSKEYUP(const aMessage : TMsg); +var + TempKeyEvent : TCefKeyEvent; +begin + if FMXBufferPanel1.IsFocused and (aMessage.wParam in [VK_BACK..VK_HELP]) then + begin + TempKeyEvent.kind := KEYEVENT_KEYUP; + TempKeyEvent.modifiers := GetCefKeyboardModifiers(aMessage.wParam, aMessage.lParam); + TempKeyEvent.windows_key_code := integer(aMessage.wParam); + TempKeyEvent.native_key_code := integer(aMessage.lParam); + TempKeyEvent.is_system_key := ord(True); + TempKeyEvent.character := #0; + TempKeyEvent.unmodified_character := #0; + TempKeyEvent.focus_on_editable_field := ord(False); + + FMXChromium1.SendKeyEvent(@TempKeyEvent); + end; +end; + + +procedure TBrowserFrame.HandleKEYDOWN(const aMessage : TMsg); +var + TempKeyEvent : TCefKeyEvent; +begin + if FMXBufferPanel1.IsFocused then begin TempKeyEvent.kind := KEYEVENT_RAWKEYDOWN; TempKeyEvent.modifiers := GetCefKeyboardModifiers(aMessage.wParam, aMessage.lParam); @@ -1066,31 +1061,29 @@ begin TempKeyEvent.character := #0; TempKeyEvent.unmodified_character := #0; TempKeyEvent.focus_on_editable_field := ord(False); - FMXChromium1.SendKeyEvent(@TempKeyEvent); - end; -end; - -procedure TBrowserFrame.HandleKEYUP(const aMessage : TMsg); -var - TempKeyEvent : TCefKeyEvent; -begin - if FMXBufferPanel1.IsFocused then + end; +end; + +procedure TBrowserFrame.HandleKEYUP(const aMessage : TMsg); +var + TempKeyEvent : TCefKeyEvent; +begin + if FMXBufferPanel1.IsFocused then begin if (aMessage.wParam = vkReturn) then begin - TempKeyEvent.kind := KEYEVENT_CHAR; - TempKeyEvent.modifiers := GetCefKeyboardModifiers(aMessage.wParam, aMessage.lParam); + TempKeyEvent.kind := KEYEVENT_CHAR; + TempKeyEvent.modifiers := GetCefKeyboardModifiers(aMessage.wParam, aMessage.lParam); TempKeyEvent.windows_key_code := integer(aMessage.wParam); - TempKeyEvent.native_key_code := integer(aMessage.lParam); - TempKeyEvent.is_system_key := ord(False); - TempKeyEvent.character := #0; - TempKeyEvent.unmodified_character := #0; - TempKeyEvent.focus_on_editable_field := ord(False); - + TempKeyEvent.native_key_code := integer(aMessage.lParam); + TempKeyEvent.is_system_key := ord(False); + TempKeyEvent.character := #0; + TempKeyEvent.unmodified_character := #0; + TempKeyEvent.focus_on_editable_field := ord(False); + FMXChromium1.SendKeyEvent(@TempKeyEvent); end; - TempKeyEvent.kind := KEYEVENT_KEYUP; TempKeyEvent.modifiers := GetCefKeyboardModifiers(aMessage.wParam, aMessage.lParam); TempKeyEvent.windows_key_code := integer(aMessage.wParam); @@ -1099,19 +1092,18 @@ begin TempKeyEvent.character := #0; TempKeyEvent.unmodified_character := #0; TempKeyEvent.focus_on_editable_field := ord(False); - FMXChromium1.SendKeyEvent(@TempKeyEvent); - end; + end; +end; + +function TBrowserFrame.HandlePOINTER(const aMessage : TMsg) : boolean; +begin + Result := FMXBufferPanel1.IsFocused and + (GlobalCEFApp <> nil) and + ArePointerEventsSupported and + HandlePointerEvent(aMessage); end; - -function TBrowserFrame.HandlePOINTER(const aMessage : TMsg) : boolean; -begin - Result := FMXBufferPanel1.IsFocused and - (GlobalCEFApp <> nil) and - ArePointerEventsSupported and - HandlePointerEvent(aMessage); -end; {$ENDIF} - - -end. + + +end. diff --git a/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uMainForm.pas b/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uMainForm.pas index 1fdc7a9e..bbcc1679 100644 --- a/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uMainForm.pas +++ b/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uMainForm.pas @@ -182,12 +182,6 @@ 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.Create(nil); - GlobalCEFApp := TCefApplication.Create; GlobalCEFApp.WindowlessRenderingEnabled := True; GlobalCEFApp.EnableHighDPISupport := True; @@ -196,7 +190,16 @@ begin GlobalCEFApp.cache := 'cache'; GlobalCEFApp.OnScheduleMessagePumpWork := GlobalCEFApp_OnScheduleMessagePumpWork; GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized; - //GlobalCEFApp.EnableGPU := True; + {$IFDEF DEBUG} + //GlobalCEFApp.LogFile := 'debug.log'; + //GlobalCEFApp.LogSeverity := LOGSEVERITY_INFO; + {$ENDIF} + + // 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.Create(nil); end; procedure TMainForm.NotifyMoveOrResizeStarted; diff --git a/demos/Delphi_FMX_Windows/FMXToolBoxBrowser/FMXToolBoxBrowser.dproj b/demos/Delphi_FMX_Windows/FMXToolBoxBrowser/FMXToolBoxBrowser.dproj index 79e17b45..9133a028 100644 --- a/demos/Delphi_FMX_Windows/FMXToolBoxBrowser/FMXToolBoxBrowser.dproj +++ b/demos/Delphi_FMX_Windows/FMXToolBoxBrowser/FMXToolBoxBrowser.dproj @@ -1,7 +1,7 @@  {04DED2F9-59A2-4E14-A538-C6B47842101F} - 19.1 + 19.2 FMX FMXToolBoxBrowser.dpr True @@ -347,6 +347,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_FMX_Windows/SimpleFMXBrowser/SimpleFMXBrowser.dproj b/demos/Delphi_FMX_Windows/SimpleFMXBrowser/SimpleFMXBrowser.dproj index a44ae3ba..b389f127 100644 --- a/demos/Delphi_FMX_Windows/SimpleFMXBrowser/SimpleFMXBrowser.dproj +++ b/demos/Delphi_FMX_Windows/SimpleFMXBrowser/SimpleFMXBrowser.dproj @@ -1,7 +1,7 @@  {5967B4A4-5E6D-420E-B524-A52A1240AC82} - 19.1 + 19.2 FMX SimpleFMXBrowser.dpr True @@ -343,6 +343,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/ConsoleBrowser2/ConsoleBrowser2.dproj b/demos/Delphi_VCL/ConsoleBrowser2/ConsoleBrowser2.dproj index c689a95c..fd6490b7 100644 --- a/demos/Delphi_VCL/ConsoleBrowser2/ConsoleBrowser2.dproj +++ b/demos/Delphi_VCL/ConsoleBrowser2/ConsoleBrowser2.dproj @@ -1,7 +1,7 @@  {AA8E526F-FBD1-4D31-B463-A4CE79C00B18} - 19.1 + 19.2 VCL ConsoleBrowser2.dpr True @@ -286,6 +286,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/ConsoleBrowser2/ConsoleBrowser2_sp.dproj b/demos/Delphi_VCL/ConsoleBrowser2/ConsoleBrowser2_sp.dproj index a1e2d2f3..b4b5b5d8 100644 --- a/demos/Delphi_VCL/ConsoleBrowser2/ConsoleBrowser2_sp.dproj +++ b/demos/Delphi_VCL/ConsoleBrowser2/ConsoleBrowser2_sp.dproj @@ -1,7 +1,7 @@  {6ABCF641-08D0-4F35-9D13-2FBD18E5152A} - 19.1 + 19.2 VCL ConsoleBrowser2_sp.dpr True @@ -299,6 +299,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/Extensions/PageColorExt/PageColorExt.dproj b/demos/Delphi_VCL/Extensions/PageColorExt/PageColorExt.dproj index 5c3b7e88..e08667bb 100644 --- a/demos/Delphi_VCL/Extensions/PageColorExt/PageColorExt.dproj +++ b/demos/Delphi_VCL/Extensions/PageColorExt/PageColorExt.dproj @@ -1,7 +1,7 @@  {55E00327-9D98-4DA3-A4E1-844942A01C6B} - 19.1 + 19.2 VCL PageColorExt.dpr True @@ -314,6 +314,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/JavaScript/JSExecutingFunctions/JSExecutingFunctions.dproj b/demos/Delphi_VCL/JavaScript/JSExecutingFunctions/JSExecutingFunctions.dproj index fa51d713..054be347 100644 --- a/demos/Delphi_VCL/JavaScript/JSExecutingFunctions/JSExecutingFunctions.dproj +++ b/demos/Delphi_VCL/JavaScript/JSExecutingFunctions/JSExecutingFunctions.dproj @@ -1,7 +1,7 @@  {7AA32B92-A408-42CB-A571-383721053FFA} - 19.1 + 19.2 VCL JSExecutingFunctions.dpr True @@ -311,6 +311,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/JavaScript/JSExtensionWithFunction/JSExtensionWithFunction.dproj b/demos/Delphi_VCL/JavaScript/JSExtensionWithFunction/JSExtensionWithFunction.dproj index d3918b8e..c4052775 100644 --- a/demos/Delphi_VCL/JavaScript/JSExtensionWithFunction/JSExtensionWithFunction.dproj +++ b/demos/Delphi_VCL/JavaScript/JSExtensionWithFunction/JSExtensionWithFunction.dproj @@ -1,7 +1,7 @@  {7AA32B92-A408-42CB-A571-383721053FFA} - 19.1 + 19.2 VCL JSExtensionWithFunction.dpr True @@ -311,6 +311,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/JavaScript/JSExtensionWithObjectParameter/JSExtensionWithObjectParameter.dproj b/demos/Delphi_VCL/JavaScript/JSExtensionWithObjectParameter/JSExtensionWithObjectParameter.dproj index d1af8a6c..80b2e792 100644 --- a/demos/Delphi_VCL/JavaScript/JSExtensionWithObjectParameter/JSExtensionWithObjectParameter.dproj +++ b/demos/Delphi_VCL/JavaScript/JSExtensionWithObjectParameter/JSExtensionWithObjectParameter.dproj @@ -1,7 +1,7 @@  {7AA32B92-A408-42CB-A571-383721053FFA} - 19.1 + 19.2 VCL JSExtensionWithObjectParameter.dpr True @@ -164,13 +164,13 @@ + JSExtensionWithObjectParameter.exe true - 1 @@ -311,6 +311,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/JavaScript/JSRTTIExtension/JSRTTIExtension.dproj b/demos/Delphi_VCL/JavaScript/JSRTTIExtension/JSRTTIExtension.dproj index 145f34f5..b78479f1 100644 --- a/demos/Delphi_VCL/JavaScript/JSRTTIExtension/JSRTTIExtension.dproj +++ b/demos/Delphi_VCL/JavaScript/JSRTTIExtension/JSRTTIExtension.dproj @@ -1,7 +1,7 @@  {7AA32B92-A408-42CB-A571-383721053FFA} - 19.1 + 19.2 VCL JSRTTIExtension.dpr True @@ -166,13 +166,13 @@ + JSRTTIExtension.exe true - 1 @@ -313,6 +313,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/JavaScript/JSSimpleExtension/JSSimpleExtension.dproj b/demos/Delphi_VCL/JavaScript/JSSimpleExtension/JSSimpleExtension.dproj index 40d08eb1..8b72284b 100644 --- a/demos/Delphi_VCL/JavaScript/JSSimpleExtension/JSSimpleExtension.dproj +++ b/demos/Delphi_VCL/JavaScript/JSSimpleExtension/JSSimpleExtension.dproj @@ -1,7 +1,7 @@  {7AA32B92-A408-42CB-A571-383721053FFA} - 19.1 + 19.2 VCL JSSimpleExtension.dpr True @@ -346,6 +346,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/JavaScript/JSSimpleWindowBinding/JSSimpleWindowBinding.dproj b/demos/Delphi_VCL/JavaScript/JSSimpleWindowBinding/JSSimpleWindowBinding.dproj index e1cc636c..78d1d4b2 100644 --- a/demos/Delphi_VCL/JavaScript/JSSimpleWindowBinding/JSSimpleWindowBinding.dproj +++ b/demos/Delphi_VCL/JavaScript/JSSimpleWindowBinding/JSSimpleWindowBinding.dproj @@ -1,7 +1,7 @@  {7AA32B92-A408-42CB-A571-383721053FFA} - 19.1 + 19.2 VCL JSSimpleWindowBinding.dpr True @@ -310,6 +310,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/JavaScript/JSWindowBindingSubProcess/JSSimpleWindowBinding.dproj b/demos/Delphi_VCL/JavaScript/JSWindowBindingSubProcess/JSSimpleWindowBinding.dproj index 749d1fbf..083eee29 100644 --- a/demos/Delphi_VCL/JavaScript/JSWindowBindingSubProcess/JSSimpleWindowBinding.dproj +++ b/demos/Delphi_VCL/JavaScript/JSWindowBindingSubProcess/JSSimpleWindowBinding.dproj @@ -1,7 +1,7 @@  {7AA32B92-A408-42CB-A571-383721053FFA} - 19.1 + 19.2 VCL JSSimpleWindowBinding.dpr True @@ -313,6 +313,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/JavaScript/JSWindowBindingSubProcess/SubProcess.dproj b/demos/Delphi_VCL/JavaScript/JSWindowBindingSubProcess/SubProcess.dproj index da37f9f9..91e8b97e 100644 --- a/demos/Delphi_VCL/JavaScript/JSWindowBindingSubProcess/SubProcess.dproj +++ b/demos/Delphi_VCL/JavaScript/JSWindowBindingSubProcess/SubProcess.dproj @@ -1,7 +1,7 @@  {6ABCF641-08D0-4F35-9D13-2FBD18E5152A} - 19.1 + 19.2 VCL SubProcess.dpr True @@ -281,6 +281,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/JavaScript/JSWindowBindingWithArrayBuffer/JSWindowBindingWithArrayBuffer.dproj b/demos/Delphi_VCL/JavaScript/JSWindowBindingWithArrayBuffer/JSWindowBindingWithArrayBuffer.dproj index c30691b1..d9b8eff2 100644 --- a/demos/Delphi_VCL/JavaScript/JSWindowBindingWithArrayBuffer/JSWindowBindingWithArrayBuffer.dproj +++ b/demos/Delphi_VCL/JavaScript/JSWindowBindingWithArrayBuffer/JSWindowBindingWithArrayBuffer.dproj @@ -1,7 +1,7 @@  {7AA32B92-A408-42CB-A571-383721053FFA} - 19.1 + 19.2 VCL JSWindowBindingWithArrayBuffer.dpr True @@ -310,6 +310,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/JavaScript/JSWindowBindingWithFunction/JSWindowBindingWithFunction.dproj b/demos/Delphi_VCL/JavaScript/JSWindowBindingWithFunction/JSWindowBindingWithFunction.dproj index 68bc52f9..db193c01 100644 --- a/demos/Delphi_VCL/JavaScript/JSWindowBindingWithFunction/JSWindowBindingWithFunction.dproj +++ b/demos/Delphi_VCL/JavaScript/JSWindowBindingWithFunction/JSWindowBindingWithFunction.dproj @@ -1,7 +1,7 @@  {7AA32B92-A408-42CB-A571-383721053FFA} - 19.1 + 19.2 VCL JSWindowBindingWithFunction.dpr True @@ -311,6 +311,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/JavaScript/JSWindowBindingWithObject/JSWindowBindingWithObject.dproj b/demos/Delphi_VCL/JavaScript/JSWindowBindingWithObject/JSWindowBindingWithObject.dproj index 46ccdd59..a2a591ac 100644 --- a/demos/Delphi_VCL/JavaScript/JSWindowBindingWithObject/JSWindowBindingWithObject.dproj +++ b/demos/Delphi_VCL/JavaScript/JSWindowBindingWithObject/JSWindowBindingWithObject.dproj @@ -1,7 +1,7 @@  {7AA32B92-A408-42CB-A571-383721053FFA} - 19.1 + 19.2 VCL JSWindowBindingWithObject.dpr True @@ -311,6 +311,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/MDIBrowser/MDIBrowser.dproj b/demos/Delphi_VCL/MDIBrowser/MDIBrowser.dproj index 5c9ef246..31807b1d 100644 --- a/demos/Delphi_VCL/MDIBrowser/MDIBrowser.dproj +++ b/demos/Delphi_VCL/MDIBrowser/MDIBrowser.dproj @@ -7,7 +7,7 @@ 19.2 VCL True - Win32 + Win64 3 Application diff --git a/demos/Delphi_VCL/MDIExternalPumpBrowser/uChildForm.pas b/demos/Delphi_VCL/MDIExternalPumpBrowser/uChildForm.pas index 6d2fd621..e7f14877 100644 --- a/demos/Delphi_VCL/MDIExternalPumpBrowser/uChildForm.pas +++ b/demos/Delphi_VCL/MDIExternalPumpBrowser/uChildForm.pas @@ -204,6 +204,7 @@ end; procedure TChildForm.FormShow(Sender: TObject); var TempContext : ICefRequestContext; + TempCache : string; begin // The new request context overrides several GlobalCEFApp properties like : // cache, AcceptLanguageList, PersistSessionCookies, PersistUserPreferences and @@ -214,8 +215,10 @@ begin // The cache directories of all the browsers *MUST* be a subdirectory of // GlobalCEFApp.RootCache unless you use a blank cache (in-memory). + TempCache := GlobalCEFApp.RootCache + '\cache2'; + if MainForm.NewContextChk.Checked then - TempContext := TCefRequestContextRef.New('', '', '', False, False, False, False) + TempContext := TCefRequestContextRef.New(TempCache, '', '', False, False, False, False) else TempContext := nil; diff --git a/demos/Delphi_VCL/MDIExternalPumpBrowser/uMainForm.pas b/demos/Delphi_VCL/MDIExternalPumpBrowser/uMainForm.pas index d93805d5..2826aa28 100644 --- a/demos/Delphi_VCL/MDIExternalPumpBrowser/uMainForm.pas +++ b/demos/Delphi_VCL/MDIExternalPumpBrowser/uMainForm.pas @@ -65,10 +65,12 @@ type NewBtn: TSpeedButton; ExitBtn: TSpeedButton; NewContextChk: TCheckBox; + procedure FormCreate(Sender: TObject); procedure NewBtnClick(Sender: TObject); procedure ExitBtnClick(Sender: TObject); procedure FormShow(Sender: TObject); + private // Variables to control when can we destroy the form safely FCanClose : boolean; // Set to True when all the child forms are closed @@ -84,7 +86,6 @@ type public function CloseQuery: Boolean; override; - property ChildClosing : boolean read GetChildClosing; end; @@ -114,22 +115,25 @@ end; procedure GlobalCEFApp_OnScheduleMessagePumpWork(const aDelayMS : int64); begin - if (GlobalCEFWorkScheduler <> nil) then GlobalCEFWorkScheduler.ScheduleMessagePumpWork(aDelayMS); + if (GlobalCEFWorkScheduler <> nil) then + GlobalCEFWorkScheduler.ScheduleMessagePumpWork(aDelayMS); end; procedure CreateGlobalCEFApp; begin - // TCEFWorkScheduler will call cef_do_message_loop_work when - // it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event. - // GlobalCEFWorkScheduler needs to be created before the - // GlobalCEFApp.StartMainProcess call. - GlobalCEFWorkScheduler := TCEFWorkScheduler.Create(nil); - GlobalCEFApp := TCefApplication.Create; GlobalCEFApp.ExternalMessagePump := True; GlobalCEFApp.MultiThreadedMessageLoop := False; GlobalCEFApp.OnScheduleMessagePumpWork := GlobalCEFApp_OnScheduleMessagePumpWork; GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized; + GlobalCEFApp.RootCache := ExtractFileDir(ParamStr(0)); + GlobalCEFApp.cache := GlobalCEFApp.RootCache + '\cache'; + + // TCEFWorkScheduler will call cef_do_message_loop_work when + // it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event. + // GlobalCEFWorkScheduler needs to be created before the + // GlobalCEFApp.StartMainProcess call. + GlobalCEFWorkScheduler := TCEFWorkScheduler.Create(nil); end; procedure TMainForm.CreateMDIChild(const Name: string); @@ -161,7 +165,6 @@ var begin Result := false; i := pred(MDIChildCount); - while (i >= 0) do if TChildForm(MDIChildren[i]).Closing then begin @@ -196,6 +199,7 @@ end; procedure TMainForm.ChildDestroyedMsg(var aMessage : TMessage); begin // If there are no more child forms we can destroy the main form + if FClosing and (MDIChildCount = 0) then begin ButtonPnl.Enabled := False; diff --git a/demos/Delphi_VCL/OAuth2Tester/OAuth2Tester.dproj b/demos/Delphi_VCL/OAuth2Tester/OAuth2Tester.dproj index b0b99f21..c1de38f2 100644 --- a/demos/Delphi_VCL/OAuth2Tester/OAuth2Tester.dproj +++ b/demos/Delphi_VCL/OAuth2Tester/OAuth2Tester.dproj @@ -1,7 +1,7 @@  {FF0090FB-12B4-40DE-86E7-6E71DD3624CA} - 19.1 + 19.2 VCL OAuth2Tester.dpr True @@ -277,6 +277,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi diff --git a/demos/Delphi_VCL/SubProcess/SimpleBrowser_sp.dpr b/demos/Delphi_VCL/SubProcess/SimpleBrowser_sp.dpr index 0240af9d..fdc046b6 100644 --- a/demos/Delphi_VCL/SubProcess/SimpleBrowser_sp.dpr +++ b/demos/Delphi_VCL/SubProcess/SimpleBrowser_sp.dpr @@ -34,11 +34,8 @@ * this source code without explicit permission. * *) - program SimpleBrowser_sp; - {$I cef.inc} - uses {$IFDEF DELPHI16_UP} WinApi.Windows, @@ -50,7 +47,6 @@ uses // CEF3 needs to set the LARGEADDRESSAWARE flag which allows 32-bit processes // to use up to 3GB of RAM. {$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE} - begin // This SubProcess project is only used for the CEF subprocesses and it needs // to declare "CEFSUBPROCESS" conditional define. Follow these steps to add it: @@ -59,8 +55,6 @@ begin // 2. Select "All configurations - All platforms" option as the "Target" on // the right section of that window. // 3. Add "CEFSUBPROCESS" (without quotes) in the "Conditional defines" box. - // uCEFLoader will call CreateGlobalCEFApp and DestroyGlobalCEFApp in the // initialization and finalization sections of that unit. end. - diff --git a/demos/Delphi_VCL/SubProcess/SimpleBrowser_sp.dproj b/demos/Delphi_VCL/SubProcess/SimpleBrowser_sp.dproj index c348e895..38c0b270 100644 --- a/demos/Delphi_VCL/SubProcess/SimpleBrowser_sp.dproj +++ b/demos/Delphi_VCL/SubProcess/SimpleBrowser_sp.dproj @@ -5,7 +5,7 @@ VCL SimpleBrowser_sp.dpr True - Release + Debug Win32 3 Application @@ -94,6 +94,7 @@ false PerMonitor CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) + Debug false @@ -141,13 +142,13 @@ + SimpleBrowser_sp.exe true - 1 diff --git a/demos/Delphi_VCL/SubProcess/uSimpleBrowser.pas b/demos/Delphi_VCL/SubProcess/uSimpleBrowser.pas index 8f5fb896..ce55b8e3 100644 --- a/demos/Delphi_VCL/SubProcess/uSimpleBrowser.pas +++ b/demos/Delphi_VCL/SubProcess/uSimpleBrowser.pas @@ -59,12 +59,14 @@ type AddressEdt: TEdit; GoBtn: TButton; Timer1: TTimer; + procedure GoBtnClick(Sender: TObject); procedure ChromiumWindow1AfterCreated(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure ChromiumWindow1Close(Sender: TObject); procedure FormActivate(Sender: TObject); + private // 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; @@ -72,6 +74,7 @@ type // 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; + protected // Variables to control when can we destroy the form safely FCanClose : boolean; // Set to True in TChromium.OnBeforeClose @@ -95,12 +98,9 @@ uses // This is a demo with the simplest web browser you can build using CEF4Delphi and // it doesn't show any sign of progress like other web browsers do. - // Remember that it may take a few seconds to load if Windows update, your antivirus or // any other windows service is using your hard drive. - // Depending on your internet connection it may take longer than expected. - // Please check that your firewall or antivirus are not blocking this application // or the domain "google.com". If you don't live in the US, you'll be redirected to // another domain which will take a little time too. @@ -138,7 +138,6 @@ 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(ChromiumWindow1.CreateBrowser) then @@ -181,6 +180,7 @@ end; procedure TForm1.Timer1Timer(Sender: TObject); begin Timer1.Enabled := False; + if not(ChromiumWindow1.CreateBrowser) and not(ChromiumWindow1.Initialized) then Timer1.Enabled := True; end; diff --git a/demos/Delphi_VCL/TinyBrowser/TinyBrowser.dpr b/demos/Delphi_VCL/TinyBrowser/TinyBrowser.dpr index d40e43fa..c17c5375 100644 --- a/demos/Delphi_VCL/TinyBrowser/TinyBrowser.dpr +++ b/demos/Delphi_VCL/TinyBrowser/TinyBrowser.dpr @@ -40,19 +40,22 @@ program TinyBrowser; {$I cef.inc} uses + // FastMM4, {$IFDEF DELPHI16_UP} WinApi.Windows, {$ELSE} Windows, - {$ENDIF } + {$ENDIF} uTinyBrowser in 'uTinyBrowser.pas', uCEFApplicationCore; {$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} +{$IFDEF WIN32} + // 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} +{$ENDIF} begin CreateGlobalCEFApp; diff --git a/demos/Delphi_VCL/TinyBrowser/TinyBrowser.dproj b/demos/Delphi_VCL/TinyBrowser/TinyBrowser.dproj index bd9ab2f1..65cf36a6 100644 --- a/demos/Delphi_VCL/TinyBrowser/TinyBrowser.dproj +++ b/demos/Delphi_VCL/TinyBrowser/TinyBrowser.dproj @@ -5,8 +5,8 @@ VCL TinyBrowser.dpr True - Debug - Win64 + Debug mem alloc + Win32 3 Application @@ -51,6 +51,17 @@ true true + + true + Base + true + + + true + Cfg_3 + true + true + .\$(Platform)\$(Config) ..\..\..\bin @@ -80,8 +91,8 @@ DBXSqliteDriver;bindcompdbx;fmxase;DBXDb2Driver;DBXInterBaseDriver;vcl;DBXSybaseASEDriver;vclactnband;RESTComponents;vclFireDAC;IndyCore260;IndyProtocols260;FireDACDb2Driver;DataSnapFireDAC;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;DBXMSSQLDriver;vclimg;FireDACInfxDriver;DatasnapConnectorsFreePascal;FireDAC;FireDACMSSQLDriver;vcltouch;VisualStyles_runtime;Componentes_UI;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;DBXOracleDriver;inetdb;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;SVGPackage;soaprtl;DbxCommonDriver;FireDACIBDriver;fmx;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;fmxdae;vclwinx;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;dbexpress;FireDACDBXDriver;vclx;bindcomp;appanalytics;dsnap;DataSnapCommon;DBXInformixDriver;FireDACCommon;bindcompvcl;IndySystem260;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;vclie;CEF4Delphi_FMX;bindengine;DBXMySQLDriver;FireDACOracleDriver;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;DBXFirebirdDriver;DataSnapProviderClient;FireDACMongoDBDriver;FireDACCommonODBC;FireDACCommonDriver;CloudService;DataSnapClient;inet;DataSnapServerMidas;$(DCC_UsePackage) Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) Debug - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 1033 + (None) DEBUG;$(DCC_Define) @@ -95,6 +106,8 @@ false true PerMonitorV2 + true + 1033 1033 @@ -110,22 +123,33 @@ true PerMonitorV2 + + DEBUG;CEF4DELHI_ALLOC_DEBUG;$(DCC_Define) + + + true + 1033 + MainSource + + Base + Cfg_2 Base - - Base - Cfg_1 Base + + Cfg_3 + Base + Delphi.Personality.12 @@ -136,9 +160,9 @@ TinyBrowser.dpr - IP Abstraction Indy Implementation Design Time - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components + IP Abstraction Indy Implementation Design Time + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components diff --git a/demos/Delphi_VCL/TinyBrowser/uTinyBrowser.pas b/demos/Delphi_VCL/TinyBrowser/uTinyBrowser.pas index 6b6838f5..2e4cb17e 100644 --- a/demos/Delphi_VCL/TinyBrowser/uTinyBrowser.pas +++ b/demos/Delphi_VCL/TinyBrowser/uTinyBrowser.pas @@ -75,7 +75,7 @@ type procedure CEFWindowComponent_OnWindowCreated(const Sender : TObject; const window : ICefWindow); procedure CEFWindowComponent_OnCanClose(const Sender : TObject; const window : ICefWindow; var aResult : Boolean); - procedure CEFWindowComponent_OnGetPreferredSize(const Sender : TObject; const view : ICefView; var aResult : TCefSize); + procedure CEFWindowComponent_OnGetInitialBounds(const Sender: TObject; const window: ICefWindow; var aResult : TCefRect); public constructor Create(AOwner : TComponent); override; @@ -166,7 +166,7 @@ begin FCEFWindowComponent := TCEFWindowComponent.Create(self); FCEFWindowComponent.OnWindowCreated := CEFWindowComponent_OnWindowCreated; FCEFWindowComponent.OnCanClose := CEFWindowComponent_OnCanClose; - FCEFWindowComponent.OnGetPreferredSize := CEFWindowComponent_OnGetPreferredSize; + FCEFWindowComponent.OnGetInitialBounds := CEFWindowComponent_OnGetInitialBounds; end; procedure TTinyBrowser.CreateTopLevelWindow; @@ -240,11 +240,12 @@ begin aResult := FChromium.TryCloseBrowser; end; -procedure TTinyBrowser.CEFWindowComponent_OnGetPreferredSize(const Sender : TObject; - const view : ICefView; - var aResult : TCefSize); +procedure TTinyBrowser.CEFWindowComponent_OnGetInitialBounds(const Sender : TObject; + const window : ICefWindow; + var aResult : TCefRect); begin - // This is the initial window size + aResult.x := 0; + aResult.y := 0; aResult.width := DEFAULT_WINDOW_VIEW_WIDTH; aResult.height := DEFAULT_WINDOW_VIEW_HEIGHT; end; @@ -277,6 +278,9 @@ begin //GlobalCEFApp.ChromeRuntime := True; // Enable this line to test the new "ChromeRuntime" mode. It's in experimental state. GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized; GlobalCEFApp.OnGetDefaultClient := GlobalCEFApp_OnGetDefaultClient; // This event is only used in "ChromeRuntime" mode + + GlobalCEFApp.LogFile := 'debug.log'; + GlobalCEFApp.LogSeverity := LOGSEVERITY_VERBOSE; end; procedure DestroyTinyBrowser; diff --git a/demos/Delphi_VCL/TinyBrowser2/TinyBrowser2.dproj b/demos/Delphi_VCL/TinyBrowser2/TinyBrowser2.dproj index 04a85ff8..fcf7b3d3 100644 --- a/demos/Delphi_VCL/TinyBrowser2/TinyBrowser2.dproj +++ b/demos/Delphi_VCL/TinyBrowser2/TinyBrowser2.dproj @@ -6,7 +6,7 @@ TinyBrowser2.dpr True Debug - Win32 + Win64 3 Application diff --git a/demos/Delphi_VCL/ToolBoxBrowser2/ToolBoxBrowser2.dproj b/demos/Delphi_VCL/ToolBoxBrowser2/ToolBoxBrowser2.dproj index c3f52b65..24c63539 100644 --- a/demos/Delphi_VCL/ToolBoxBrowser2/ToolBoxBrowser2.dproj +++ b/demos/Delphi_VCL/ToolBoxBrowser2/ToolBoxBrowser2.dproj @@ -6,7 +6,7 @@ ToolBoxBrowser2.dpr True Debug - Win64 + Win32 3 Application diff --git a/demos/Delphi_VCL/ToolBoxBrowser2/uMainForm.dfm b/demos/Delphi_VCL/ToolBoxBrowser2/uMainForm.dfm index 700df022..37b4b3e7 100644 --- a/demos/Delphi_VCL/ToolBoxBrowser2/uMainForm.dfm +++ b/demos/Delphi_VCL/ToolBoxBrowser2/uMainForm.dfm @@ -45,9 +45,9 @@ object MainForm: TMainForm end end object CEFWindowComponent1: TCEFWindowComponent - OnGetPreferredSize = CEFWindowComponent1GetPreferredSize OnWindowCreated = CEFWindowComponent1WindowCreated OnWindowDestroyed = CEFWindowComponent1WindowDestroyed + OnGetInitialBounds = CEFWindowComponent1GetInitialBounds OnCanClose = CEFWindowComponent1CanClose Left = 48 end diff --git a/demos/Delphi_VCL/ToolBoxBrowser2/uMainForm.pas b/demos/Delphi_VCL/ToolBoxBrowser2/uMainForm.pas index 62539576..a557097d 100644 --- a/demos/Delphi_VCL/ToolBoxBrowser2/uMainForm.pas +++ b/demos/Delphi_VCL/ToolBoxBrowser2/uMainForm.pas @@ -68,14 +68,14 @@ type procedure FormShow(Sender: TObject); procedure Button1Click(Sender: TObject); - - procedure CEFWindowComponent1GetPreferredSize(const Sender: TObject; const view: ICefView; var aResult: TCefSize); procedure CEFWindowComponent1WindowCreated(const Sender: TObject; const window: ICefWindow); procedure CEFWindowComponent1WindowDestroyed(const Sender: TObject; const window: ICefWindow); procedure CEFWindowComponent1CanClose(const Sender: TObject; const window: ICefWindow; var aResult: Boolean); procedure Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring); 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 CEFWindowComponent1GetInitialBounds(const Sender: TObject; + const window: ICefWindow; var aResult: TCefRect); protected procedure CEFInitializedMsg(var aMessage : TMessage); message CEFBROWSER_INITIALIZED; @@ -168,10 +168,12 @@ begin aResult := Chromium1.TryCloseBrowser; end; -procedure TMainForm.CEFWindowComponent1GetPreferredSize(const Sender: TObject; - const view: ICefView; var aResult: TCefSize); +procedure TMainForm.CEFWindowComponent1GetInitialBounds( + const Sender: TObject; const window: ICefWindow; var aResult: TCefRect); begin // This is the initial window size + aResult.x := 0; + aResult.y := 0; aResult.width := DEFAULT_WINDOW_VIEW_WIDTH; aResult.height := DEFAULT_WINDOW_VIEW_HEIGHT; end; @@ -185,7 +187,9 @@ var TempDisplay : ICefDisplay; begin TempURL := trim(Edit1.Text); - if (length(TempURL) = 0) then TempURL := 'about:blank'; + + if (length(TempURL) = 0) then + TempURL := 'about:blank'; // This event is executed in the CEF UI thread and we can call all these other // functions on this thread. In fact, all of these functions only work when diff --git a/demos/Lazarus_Linux/ExternalPumpBrowser/uExternalPumpBrowser.lfm b/demos/Lazarus_Linux/ExternalPumpBrowser/uExternalPumpBrowser.lfm index 307025aa..63a6a1fc 100644 --- a/demos/Lazarus_Linux/ExternalPumpBrowser/uExternalPumpBrowser.lfm +++ b/demos/Lazarus_Linux/ExternalPumpBrowser/uExternalPumpBrowser.lfm @@ -10,7 +10,7 @@ object Form1: TForm1 OnCloseQuery = FormCloseQuery OnCreate = FormCreate Position = poScreenCenter - LCLVersion = '2.0.10.0' + LCLVersion = '2.0.12.0' object AddressPnl: TPanel Left = 0 Height = 23 diff --git a/demos/Lazarus_Linux/ExternalPumpBrowser/uExternalPumpBrowser.pas b/demos/Lazarus_Linux/ExternalPumpBrowser/uExternalPumpBrowser.pas index b14ca12b..689d2019 100644 --- a/demos/Lazarus_Linux/ExternalPumpBrowser/uExternalPumpBrowser.pas +++ b/demos/Lazarus_Linux/ExternalPumpBrowser/uExternalPumpBrowser.pas @@ -133,12 +133,6 @@ end; procedure CreateGlobalCEFApp; begin - // TCEFWorkScheduler will call cef_do_message_loop_work when - // it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event. - // GlobalCEFWorkScheduler needs to be created before the - // GlobalCEFApp.StartMainProcess call. - GlobalCEFWorkScheduler := TCEFWorkScheduler.Create(nil); - GlobalCEFApp := TCefApplication.Create; GlobalCEFApp.ExternalMessagePump := True; GlobalCEFApp.MultiThreadedMessageLoop := False; @@ -147,10 +141,12 @@ begin // This is a workaround for the 'GPU is not usable error' issue : // https://bitbucket.org/chromiumembedded/cef/issues/2964/gpu-is-not-usable-error-during-cef GlobalCEFApp.DisableZygote := True; // this property adds the "--no-zygote" command line switch - { - GlobalCEFApp.LogFile := 'cef.log'; - GlobalCEFApp.LogSeverity := LOGSEVERITY_VERBOSE; - } + + // TCEFWorkScheduler will call cef_do_message_loop_work when + // it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event. + // GlobalCEFWorkScheduler needs to be created before the + // GlobalCEFApp.StartMainProcess call. + GlobalCEFWorkScheduler := TCEFWorkScheduler.Create(nil); end; procedure TForm1.FormCreate(Sender: TObject); diff --git a/demos/Lazarus_Linux/OSRExternalPumpBrowser/uosrexternalpumpbrowser.lfm b/demos/Lazarus_Linux/OSRExternalPumpBrowser/uosrexternalpumpbrowser.lfm index 2364188a..c444e7e1 100644 --- a/demos/Lazarus_Linux/OSRExternalPumpBrowser/uosrexternalpumpbrowser.lfm +++ b/demos/Lazarus_Linux/OSRExternalPumpBrowser/uosrexternalpumpbrowser.lfm @@ -12,7 +12,7 @@ object Form1: TForm1 OnDestroy = FormDestroy OnHide = FormHide OnShow = FormShow - LCLVersion = '2.0.10.0' + LCLVersion = '2.0.12.0' object AddressPnl: TPanel Left = 0 Height = 30 @@ -86,9 +86,9 @@ object Form1: TForm1 OnMouseMove = Panel1MouseMove OnMouseUp = Panel1MouseUp OnMouseWheel = Panel1MouseWheel + OnResize = Panel1Resize OnMouseEnter = Panel1MouseEnter OnMouseLeave = Panel1MouseLeave - OnResize = Panel1Resize end object Chromium1: TChromium OnTooltip = Chromium1Tooltip diff --git a/demos/Lazarus_Linux/OSRExternalPumpBrowser/uosrexternalpumpbrowser.pas b/demos/Lazarus_Linux/OSRExternalPumpBrowser/uosrexternalpumpbrowser.pas index 0ef1843f..1083ca12 100644 --- a/demos/Lazarus_Linux/OSRExternalPumpBrowser/uosrexternalpumpbrowser.pas +++ b/demos/Lazarus_Linux/OSRExternalPumpBrowser/uosrexternalpumpbrowser.pas @@ -204,14 +204,6 @@ end; procedure CreateGlobalCEFApp; begin - // TCEFWorkScheduler will call cef_do_message_loop_work when - // it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event. - // GlobalCEFWorkScheduler needs to be created before the - // GlobalCEFApp.StartMainProcess call. - // We use CreateDelayed in order to have a single thread in the process while - // CEF is initialized. - GlobalCEFWorkScheduler := TCEFWorkScheduler.CreateDelayed; - GlobalCEFApp := TCefApplication.Create; GlobalCEFApp.WindowlessRenderingEnabled := True; GlobalCEFApp.EnableHighDPISupport := True; @@ -225,6 +217,14 @@ begin // https://bitbucket.org/chromiumembedded/cef/issues/2964/gpu-is-not-usable-error-during-cef GlobalCEFApp.DisableZygote := True; // this property adds the "--no-zygote" command line switch + // TCEFWorkScheduler will call cef_do_message_loop_work when + // it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event. + // GlobalCEFWorkScheduler needs to be created before the + // GlobalCEFApp.StartMainProcess call. + // We use CreateDelayed in order to have a single thread in the process while + // CEF is initialized. + GlobalCEFWorkScheduler := TCEFWorkScheduler.CreateDelayed; + GlobalCEFApp.StartMainProcess; GlobalCEFWorkScheduler.CreateThread; end; diff --git a/demos/Lazarus_Windows/ExternalPumpBrowser/uExternalPumpBrowser.lfm b/demos/Lazarus_Windows/ExternalPumpBrowser/uExternalPumpBrowser.lfm index 1975ae67..49d6dc15 100644 --- a/demos/Lazarus_Windows/ExternalPumpBrowser/uExternalPumpBrowser.lfm +++ b/demos/Lazarus_Windows/ExternalPumpBrowser/uExternalPumpBrowser.lfm @@ -14,7 +14,7 @@ object ExternalPumpBrowserFrm: TExternalPumpBrowserFrm OnCreate = FormCreate OnShow = FormShow Position = poScreenCenter - LCLVersion = '2.0.6.0' + LCLVersion = '2.0.12.0' object AddressPnl: TPanel Left = 0 Height = 21 @@ -79,15 +79,15 @@ object ExternalPumpBrowserFrm: TExternalPumpBrowserFrm Enabled = False Interval = 300 OnTimer = Timer1Timer - left = 56 - top = 88 + Left = 56 + Top = 88 end object Chromium1: TChromium OnBeforePopup = Chromium1BeforePopup OnAfterCreated = Chromium1AfterCreated OnBeforeClose = Chromium1BeforeClose OnClose = Chromium1Close - left = 56 - top = 152 + Left = 56 + Top = 152 end end diff --git a/demos/Lazarus_Windows/ExternalPumpBrowser/uExternalPumpBrowser.pas b/demos/Lazarus_Windows/ExternalPumpBrowser/uExternalPumpBrowser.pas index 427c4f1f..d9698b1e 100644 --- a/demos/Lazarus_Windows/ExternalPumpBrowser/uExternalPumpBrowser.pas +++ b/demos/Lazarus_Windows/ExternalPumpBrowser/uExternalPumpBrowser.pas @@ -123,21 +123,22 @@ uses procedure GlobalCEFApp_OnScheduleMessagePumpWork(const aDelayMS : int64); begin - if (GlobalCEFWorkScheduler <> nil) then GlobalCEFWorkScheduler.ScheduleMessagePumpWork(aDelayMS); + if (GlobalCEFWorkScheduler <> nil) then + GlobalCEFWorkScheduler.ScheduleMessagePumpWork(aDelayMS); end; procedure CreateGlobalCEFApp; begin + GlobalCEFApp := TCefApplication.Create; + GlobalCEFApp.ExternalMessagePump := True; + GlobalCEFApp.MultiThreadedMessageLoop := False; + GlobalCEFApp.OnScheduleMessagePumpWork := GlobalCEFApp_OnScheduleMessagePumpWork; + // TCEFWorkScheduler will call cef_do_message_loop_work when // it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event. // GlobalCEFWorkScheduler needs to be created before the // GlobalCEFApp.StartMainProcess call. GlobalCEFWorkScheduler := TCEFWorkScheduler.Create(nil); - - GlobalCEFApp := TCefApplication.Create; - GlobalCEFApp.ExternalMessagePump := True; - GlobalCEFApp.MultiThreadedMessageLoop := False; - GlobalCEFApp.OnScheduleMessagePumpWork := GlobalCEFApp_OnScheduleMessagePumpWork; end; procedure TExternalPumpBrowserFrm.FormCreate(Sender: TObject); diff --git a/demos/Lazarus_Windows/OSRExternalPumpBrowser/uOSRExternalPumpBrowser.pas b/demos/Lazarus_Windows/OSRExternalPumpBrowser/uOSRExternalPumpBrowser.pas index 90f11fd4..2fc84135 100644 --- a/demos/Lazarus_Windows/OSRExternalPumpBrowser/uOSRExternalPumpBrowser.pas +++ b/demos/Lazarus_Windows/OSRExternalPumpBrowser/uOSRExternalPumpBrowser.pas @@ -186,19 +186,18 @@ end; procedure CreateGlobalCEFApp; begin - // TCEFWorkScheduler will call cef_do_message_loop_work when - // it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event. - // GlobalCEFWorkScheduler needs to be created before the - // GlobalCEFApp.StartMainProcess call. - GlobalCEFWorkScheduler := TCEFWorkScheduler.Create(nil); - GlobalCEFApp := TCefApplication.Create; GlobalCEFApp.WindowlessRenderingEnabled := True; GlobalCEFApp.EnableHighDPISupport := True; GlobalCEFApp.ExternalMessagePump := True; GlobalCEFApp.MultiThreadedMessageLoop := False; GlobalCEFApp.OnScheduleMessagePumpWork := @GlobalCEFApp_OnScheduleMessagePumpWork; - //GlobalCEFApp.EnableGPU := True; + + // TCEFWorkScheduler will call cef_do_message_loop_work when + // it's told in the GlobalCEFApp.OnScheduleMessagePumpWork event. + // GlobalCEFWorkScheduler needs to be created before the + // GlobalCEFApp.StartMainProcess call. + GlobalCEFWorkScheduler := TCEFWorkScheduler.Create(nil); end; procedure TOSRExternalPumpBrowserFrm.GoBtnClick(Sender: TObject); diff --git a/demos/Lazarus_Windows/TinyBrowser/uTinyBrowser.pas b/demos/Lazarus_Windows/TinyBrowser/uTinyBrowser.pas index 9547f21a..7c48e184 100644 --- a/demos/Lazarus_Windows/TinyBrowser/uTinyBrowser.pas +++ b/demos/Lazarus_Windows/TinyBrowser/uTinyBrowser.pas @@ -61,7 +61,9 @@ type FChromium : TChromium; FCEFWindowComponent : TCEFWindowComponent; FCEFBrowserViewComponent : TCEFBrowserViewComponent; - FHomepage : string; + FHomepage : string; + + function GetClient : ICefClient; procedure Chromium_OnBeforeClose(Sender: TObject; const browser: ICefBrowser); procedure Chromium_OnBeforePopup(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); @@ -69,14 +71,15 @@ type procedure CEFWindowComponent_OnWindowCreated(const Sender : TObject; const window : ICefWindow); procedure CEFWindowComponent_OnCanClose(const Sender : TObject; const window : ICefWindow; var aResult : Boolean); - procedure CEFWindowComponent_OnGetPreferredSize(const Sender : TObject; const view : ICefView; var aResult : TCefSize); + procedure CEFWindowComponent_OnGetInitialBounds(const Sender: TObject; const window: ICefWindow; var aResult : TCefRect); public constructor Create(AOwner : TComponent); override; procedure AfterConstruction; override; procedure CreateTopLevelWindow; - property Homepage : string read FHomepage write FHomepage; + property Homepage : string read FHomepage write FHomepage; + property Client : ICefClient read GetClient; end; var @@ -159,7 +162,7 @@ begin FCEFWindowComponent := TCEFWindowComponent.Create(self); FCEFWindowComponent.OnWindowCreated := CEFWindowComponent_OnWindowCreated; FCEFWindowComponent.OnCanClose := CEFWindowComponent_OnCanClose; - FCEFWindowComponent.OnGetPreferredSize := CEFWindowComponent_OnGetPreferredSize; + FCEFWindowComponent.OnGetInitialBounds := CEFWindowComponent_OnGetInitialBounds; end; procedure TTinyBrowser.CreateTopLevelWindow; @@ -233,13 +236,22 @@ begin aResult := FChromium.TryCloseBrowser; end; -procedure TTinyBrowser.CEFWindowComponent_OnGetPreferredSize(const Sender : TObject; - const view : ICefView; - var aResult : TCefSize); +procedure TTinyBrowser.CEFWindowComponent_OnGetInitialBounds(const Sender : TObject; + const window : ICefWindow; + var aResult : TCefRect); begin - // This is the initial window size + aResult.x := 0; + aResult.y := 0; aResult.width := DEFAULT_WINDOW_VIEW_WIDTH; aResult.height := DEFAULT_WINDOW_VIEW_HEIGHT; +end; + +function TTinyBrowser.GetClient : ICefClient; +begin + if (FChromium <> nil) then + Result := FChromium.CefClient + else + Result := nil; end; procedure GlobalCEFApp_OnContextInitialized; @@ -247,6 +259,11 @@ begin TinyBrowser := TTinyBrowser.Create(nil); TinyBrowser.Homepage := 'https://www.briskbard.com'; TinyBrowser.CreateTopLevelWindow; +end; + +procedure GlobalCEFApp_OnGetDefaultClient(var aClient : ICefClient); +begin + aClient := TinyBrowser.Client; end; procedure CreateGlobalCEFApp; @@ -254,7 +271,9 @@ begin GlobalCEFApp := TCefApplication.Create; GlobalCEFApp.MultiThreadedMessageLoop := False; GlobalCEFApp.ExternalMessagePump := False; + //GlobalCEFApp.ChromeRuntime := True; // Enable this line to test the new "ChromeRuntime" mode. It's in experimental state. GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized; + GlobalCEFApp.OnGetDefaultClient := GlobalCEFApp_OnGetDefaultClient; // This event is only used in "ChromeRuntime" mode end; procedure DestroyTinyBrowser; diff --git a/demos/Lazarus_Windows/ToolBoxBrowser2/uMainForm.lfm b/demos/Lazarus_Windows/ToolBoxBrowser2/uMainForm.lfm index eea1474f..9df7d783 100644 --- a/demos/Lazarus_Windows/ToolBoxBrowser2/uMainForm.lfm +++ b/demos/Lazarus_Windows/ToolBoxBrowser2/uMainForm.lfm @@ -14,7 +14,7 @@ object MainForm: TMainForm Font.Name = 'Tahoma' OnShow = FormShow Position = poScreenCenter - LCLVersion = '2.0.8.0' + LCLVersion = '2.0.12.0' object ButtonPnl: TPanel Left = 0 Height = 37 @@ -45,20 +45,20 @@ object MainForm: TMainForm end end object CEFWindowComponent1: TCEFWindowComponent - OnGetPreferredSize = CEFWindowComponent1GetPreferredSize OnWindowCreated = CEFWindowComponent1WindowCreated OnWindowDestroyed = CEFWindowComponent1WindowDestroyed + OnGetInitialBounds = CEFWindowComponent1GetInitialBounds OnCanClose = CEFWindowComponent1CanClose - left = 48 + Left = 48 end object CEFBrowserViewComponent1: TCEFBrowserViewComponent - left = 152 - top = 65528 + Left = 152 + Top = 65528 end object Chromium1: TChromium OnTitleChange = Chromium1TitleChange OnBeforePopup = Chromium1BeforePopup - left = 256 - top = 8 + Left = 256 + Top = 8 end end diff --git a/demos/Lazarus_Windows/ToolBoxBrowser2/uMainForm.pas b/demos/Lazarus_Windows/ToolBoxBrowser2/uMainForm.pas index fe3810c5..74f3a614 100644 --- a/demos/Lazarus_Windows/ToolBoxBrowser2/uMainForm.pas +++ b/demos/Lazarus_Windows/ToolBoxBrowser2/uMainForm.pas @@ -14,7 +14,7 @@ uses {$ENDIF} uCEFInterfaces, uCEFTypes, uCEFConstants, uCEFViewComponent, uCEFPanelComponent, uCEFWindowComponent, - uCEFBrowserViewComponent, uCEFChromiumCore, uCEFChromium; + uCEFBrowserViewComponent, uCEFChromiumCore, uCEFChromium, uCEFViewsFrameworkEvents; const CEFBROWSER_INITIALIZED = WM_APP + $100; @@ -23,6 +23,9 @@ const DEFAULT_WINDOW_VIEW_HEIGHT = 600; type + + { TMainForm } + TMainForm = class(TForm) ButtonPnl: TPanel; Edit1: TEdit; @@ -34,10 +37,10 @@ type procedure FormShow(Sender: TObject); procedure Button1Click(Sender: TObject); - procedure CEFWindowComponent1GetPreferredSize(const Sender: TObject; const view: ICefView; var aResult: TCefSize); procedure CEFWindowComponent1WindowCreated(const Sender: TObject; const window: ICefWindow); procedure CEFWindowComponent1WindowDestroyed(const Sender: TObject; const window: ICefWindow); - procedure CEFWindowComponent1CanClose(const Sender: TObject; const window: ICefWindow; var aResult: Boolean); + procedure CEFWindowComponent1CanClose(const Sender: TObject; const window: ICefWindow; var aResult: Boolean); + procedure CEFWindowComponent1GetInitialBounds(const Sender: TObject; const window: ICefWindow; var aResult: TCefRect); procedure Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser; const title: ustring); 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); @@ -133,14 +136,6 @@ begin aResult := Chromium1.TryCloseBrowser; end; -procedure TMainForm.CEFWindowComponent1GetPreferredSize(const Sender: TObject; - const view: ICefView; var aResult: TCefSize); -begin - // This is the initial window size - aResult.width := DEFAULT_WINDOW_VIEW_WIDTH; - aResult.height := DEFAULT_WINDOW_VIEW_HEIGHT; -end; - procedure TMainForm.CEFWindowComponent1WindowCreated(const Sender: TObject; const window: ICefWindow); var @@ -206,6 +201,16 @@ begin EnableInterface; end; +procedure TMainForm.CEFWindowComponent1GetInitialBounds(const Sender: TObject; + const window: ICefWindow; var aResult: TCefRect); +begin + // This is the initial window size + aResult.x := 0; + aResult.y := 0; + aResult.width := DEFAULT_WINDOW_VIEW_WIDTH; + aResult.height := DEFAULT_WINDOW_VIEW_HEIGHT; +end; + procedure TMainForm.EnableInterface; begin Caption := 'ToolBox Browser 2'; diff --git a/demos/Lazarus_any_OS/BrowserWindow/00-Delete.bat b/demos/Lazarus_any_OS/BrowserWindow/00-Delete.bat new file mode 100644 index 00000000..0b5ba5c8 --- /dev/null +++ b/demos/Lazarus_any_OS/BrowserWindow/00-Delete.bat @@ -0,0 +1,2 @@ +rmdir /S /Q lib +rmdir /S /Q backup diff --git a/demos/Lazarus_any_OS/BrowserWindow/BrowserWindow.res b/demos/Lazarus_any_OS/BrowserWindow/BrowserWindow.res index bec39b4a..1adb0406 100644 Binary files a/demos/Lazarus_any_OS/BrowserWindow/BrowserWindow.res and b/demos/Lazarus_any_OS/BrowserWindow/BrowserWindow.res differ diff --git a/demos/Lazarus_any_OS/BrowserWindowDom/00-Delete.bat b/demos/Lazarus_any_OS/BrowserWindowDom/00-Delete.bat new file mode 100644 index 00000000..0b5ba5c8 --- /dev/null +++ b/demos/Lazarus_any_OS/BrowserWindowDom/00-Delete.bat @@ -0,0 +1,2 @@ +rmdir /S /Q lib +rmdir /S /Q backup diff --git a/demos/Lazarus_any_OS/ExternalPumpBrowser/ExternalPumpBrowser.res b/demos/Lazarus_any_OS/ExternalPumpBrowser/ExternalPumpBrowser.res index bec39b4a..1adb0406 100644 Binary files a/demos/Lazarus_any_OS/ExternalPumpBrowser/ExternalPumpBrowser.res and b/demos/Lazarus_any_OS/ExternalPumpBrowser/ExternalPumpBrowser.res differ diff --git a/packages/CEF4Delphi.dpk b/packages/CEF4Delphi.dpk index 4c0301bf..dfe5e570 100644 --- a/packages/CEF4Delphi.dpk +++ b/packages/CEF4Delphi.dpk @@ -223,7 +223,7 @@ contains uCEFPrintDialogCallback in '..\source\uCEFPrintDialogCallback.pas', uCEFPrintJobCallback in '..\source\uCEFPrintJobCallback.pas', uCEFWorkSchedulerQueueThread in '..\source\uCEFWorkSchedulerQueueThread.pas', - uCEFLinkedWinControlBase in '..\source\uCEFLinkedWinControlBase.pas'; - + uCEFLinkedWinControlBase in '..\source\uCEFLinkedWinControlBase.pas', + uCEFTimerWorkScheduler in '..\source\uCEFTimerWorkScheduler.pas'; end. diff --git a/packages/CEF4Delphi.dproj b/packages/CEF4Delphi.dproj index 70b88cdf..b020cdfd 100644 --- a/packages/CEF4Delphi.dproj +++ b/packages/CEF4Delphi.dproj @@ -318,6 +318,7 @@ + Base diff --git a/packages/CEF4Delphi_FMX.dpk b/packages/CEF4Delphi_FMX.dpk index df93e51e..07e50345 100644 --- a/packages/CEF4Delphi_FMX.dpk +++ b/packages/CEF4Delphi_FMX.dpk @@ -233,7 +233,10 @@ contains uCEFWorkSchedulerQueueThread in '..\source\uCEFWorkSchedulerQueueThread.pas', uCEFLinkedWinControlBase in '..\source\uCEFLinkedWinControlBase.pas', uCEFMacOSConstants in '..\source\uCEFMacOSConstants.pas', - uCEFMacOSFunctions in '..\source\uCEFMacOSFunctions.pas'; + uCEFMacOSFunctions in '..\source\uCEFMacOSFunctions.pas', + uCEFTimerWorkScheduler in '..\source\uCEFTimerWorkScheduler.pas', + uCEFMacOSCustomCocoaTimer in '..\source\uCEFMacOSCustomCocoaTimer.pas', + uCEFMacOSInterfaces in '..\source\uCEFMacOSInterfaces.pas'; end. diff --git a/packages/CEF4Delphi_FMX.dproj b/packages/CEF4Delphi_FMX.dproj index 0cad2ddd..3fb8e684 100644 --- a/packages/CEF4Delphi_FMX.dproj +++ b/packages/CEF4Delphi_FMX.dproj @@ -349,6 +349,9 @@ + + + Base diff --git a/packages/cef4delphi_lazarus.lpk b/packages/cef4delphi_lazarus.lpk index af4245e7..a9050e55 100644 --- a/packages/cef4delphi_lazarus.lpk +++ b/packages/cef4delphi_lazarus.lpk @@ -22,7 +22,7 @@ - + @@ -845,6 +845,10 @@ + + + + diff --git a/packages/cef4delphi_lazarus.pas b/packages/cef4delphi_lazarus.pas index 71c1d869..433e6cfa 100644 --- a/packages/cef4delphi_lazarus.pas +++ b/packages/cef4delphi_lazarus.pas @@ -66,7 +66,8 @@ uses uCEFPrintDialogCallback, uCEFPrintHandler, uCEFPrintJobCallback, uCEFLinuxFunctions, uCEFLinuxTypes, uCEFLinuxConstants, uCEFWorkSchedulerQueueThread, uCEFLinkedWinControlBase, uCEFLazarusCocoa, - uCEFBrowserWindow, uCEFOsrBrowserWindow, LazarusPackageIntf; + uCEFBrowserWindow, uCEFOsrBrowserWindow, uCEFTimerWorkScheduler, + LazarusPackageIntf; implementation diff --git a/source/uCEFMacOSCustomCocoaTimer.pas b/source/uCEFMacOSCustomCocoaTimer.pas new file mode 100644 index 00000000..ce33d321 --- /dev/null +++ b/source/uCEFMacOSCustomCocoaTimer.pas @@ -0,0 +1,158 @@ +// ************************************************************************ +// ***************************** 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 © 2021 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 + * 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 uCEFMacOSCustomCocoaTimer; + +{$IFDEF FPC} + {$MODE OBJFPC}{$H+} +{$ENDIF} + +{$IFNDEF CPUX64}{$ALIGN ON}{$ENDIF} +{$MINENUMSIZE 4} + +{$I cef.inc} + +interface + +{$IFDEF MACOS} +uses + System.Classes, System.TypInfo, + Macapi.ObjectiveC, Macapi.Foundation, Macapi.CocoaTypes, Macapi.ObjCRuntime, + uCEFMacOSInterfaces; + +type + TCustomCocoaTimer = class(TOCLocal) + private + FTimer : NSTimer; + FOnTimer : TNotifyEvent; + FInterval : integer; + FEnabled : boolean; + + procedure CreateNSTimer; + procedure DestroyNSTimer; + + procedure SetEnabled(aValue : boolean); + + public + constructor Create; + destructor Destroy; override; + function GetObjectiveCClass: PTypeInfo; override; + procedure timerTimeout(timer: NSTimer); cdecl; + + property OnTimer : TNotifyEvent read FOnTimer write FOnTimer; + property Interval : integer read FInterval write FInterval; + property Enabled : boolean read FEnabled write SetEnabled; + end; +{$ENDIF} + +implementation + +{$IFDEF MACOS} +uses + uCEFMacOSFunctions; + +constructor TCustomCocoaTimer.Create; +begin + inherited Create; + + FTimer := nil; + FOnTimer := nil; + FInterval := 1000; + FEnabled := False; +end; + +destructor TCustomCocoaTimer.Destroy; +begin + DestroyNSTimer; + + inherited Destroy; +end; + +procedure TCustomCocoaTimer.DestroyNSTimer; +begin + if (FTimer <> nil) then + begin + FTimer.invalidate; + FTimer := nil; + end; + + FEnabled := False; +end; + +procedure TCustomCocoaTimer.CreateNSTimer; +var + TempInterval : NSTimeInterval; + TempRunLoop : NSRunLoop; +begin + if (FTimer <> nil) then + DestroyNSTimer; + + TempInterval := FInterval / 1000; + FTimer := TNSTimer.Wrap(TNSTimer.OCClass.timerWithTimeInterval(TempInterval, GetObjectID, sel_getUid('timerTimeout:'), nil, False)); + + if (FTimer <> nil) then + begin + TempRunLoop := TNSRunloop.Wrap(TNSRunLoop.OCClass.currentRunLoop); + TempRunLoop.addTimer(FTimer, NSRunLoopCommonModes); + //TempRunLoop.addTimer(FTimer, NSEventTrackingRunLoopMode); + FEnabled := True; + end; +end; + +function TCustomCocoaTimer.GetObjectiveCClass: PTypeInfo; +begin + Result := TypeInfo(ICustomCocoaTimer); +end; + +procedure TCustomCocoaTimer.timerTimeout(timer: NSTimer); +begin + if Assigned(FOnTimer) then + FOnTimer(self); +end; + +procedure TCustomCocoaTimer.SetEnabled(aValue : boolean); +begin + if (FEnabled = aValue) then exit; + + if aValue then + CreateNSTimer + else + DestroyNSTimer; +end; +{$ENDIF} + +end. diff --git a/source/uCEFMacOSFunctions.pas b/source/uCEFMacOSFunctions.pas index 04f65176..05448820 100644 --- a/source/uCEFMacOSFunctions.pas +++ b/source/uCEFMacOSFunctions.pas @@ -50,24 +50,26 @@ interface uses System.UITypes, + {$IFDEF MACOS} + FMX.Helpers.Mac, System.Messaging, Macapi.CoreFoundation, Macapi.Foundation, + {$ENDIF} uCEFMacOSConstants; {$IFDEF MACOSX} function KeyToMacOSKeyCode(aKey : Word): integer; -{$IFDEF FMX} +{$ENDIF} +{$IFDEF MACOS} procedure CopyCEFFramework; procedure CopyCEFHelpers(const aProjectName : string); procedure ShowMessageCF(const aHeading, aMessage : string; const aTimeoutInSecs : double = 0); -{$ENDIF} +function NSEventTrackingRunLoopMode: NSString; {$ENDIF} implementation -{$IFDEF MACOSX} -{$IFDEF FMX} +{$IFDEF MACOS} uses System.SysUtils, System.Types, System.IOUtils, Posix.Stdio, FMX.Types, - Macapi.CoreFoundation, uCEFMiscFunctions; const @@ -81,10 +83,10 @@ const RENDERER_SUBFIX = ' Helper (Renderer)'; {$ENDIF} +{$IFDEF MACOSX} // Key Code translation following the information found in these documents : // https://developer.apple.com/library/archive/documentation/mac/pdf/MacintoshToolboxEssentials.pdf // https://eastmanreference.com/complete-list-of-applescript-key-codes - function KeyToMacOSKeyCode(aKey : Word): integer; begin case aKey of @@ -211,8 +213,9 @@ begin else Result := 0; end; end; +{$ENDIF} -{$IFDEF FMX} +{$IFDEF MACOS} procedure CopyAllFiles(const aSrcPath, aDstPath: string); var TempDirectories, TempFiles : TStringDynArray; @@ -383,7 +386,11 @@ begin CFRelease(TempMessage); end; end; -{$ENDIF} + +function NSEventTrackingRunLoopMode: NSString; +begin + result := CocoaNSStringConst(libFoundation, 'NSEventTrackingRunLoopMode'); +end; {$ENDIF} end. diff --git a/source/uCEFMacOSInterfaces.pas b/source/uCEFMacOSInterfaces.pas new file mode 100644 index 00000000..89de1947 --- /dev/null +++ b/source/uCEFMacOSInterfaces.pas @@ -0,0 +1,82 @@ +// ************************************************************************ +// ***************************** 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 © 2021 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 + * 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 uCEFMacOSInterfaces; + +{$IFDEF FPC} + {$MODE OBJFPC}{$H+} +{$ENDIF} + +{$IFNDEF CPUX64}{$ALIGN ON}{$ENDIF} +{$MINENUMSIZE 4} + +{$I cef.inc} + +interface + +{$IFDEF MACOS} +uses + System.TypInfo, Macapi.Foundation, Macapi.CoreFoundation, Macapi.ObjectiveC, + Macapi.Helpers, Macapi.CocoaTypes, Macapi.AppKit, FMX.Platform; + +type + IFMXApplicationDelegate = interface(NSApplicationDelegate) + ['{A54E08CA-77CC-4F22-B6D9-833DD6AB696D}'] + procedure onMenuClicked(sender: NSMenuItem); cdecl; + end; + + CrAppProtocol = interface(NSObject) + ['{2071D289-9A54-4AD7-BD83-E521ACD5C528}'] + function isHandlingSendEvent: boolean; cdecl; + end; + + //CrAppControlProtocol = interface(CrAppProtocol) + CrAppControlProtocol = interface(NSObject) + ['{BCCDF64D-E8D7-4E0B-83BC-30F87145576C}'] + function isHandlingSendEvent: boolean; cdecl; + procedure setHandlingSendEvent(handlingSendEvent: boolean); cdecl; + end; + + ICustomCocoaTimer = interface(NSObject) + ['{17D92D03-614A-4D4A-B938-FA0D4A3A07F9}'] + procedure timerTimeout(timer: NSTimer); cdecl; + end; +{$ENDIF} + +implementation + +end. diff --git a/source/uCEFTimerWorkScheduler.pas b/source/uCEFTimerWorkScheduler.pas new file mode 100644 index 00000000..1afc2c0c --- /dev/null +++ b/source/uCEFTimerWorkScheduler.pas @@ -0,0 +1,351 @@ +// ************************************************************************ +// ***************************** 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 © 2021 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 + * 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 uCEFTimerWorkScheduler; + +{$IFDEF FPC} + {$MODE OBJFPC}{$H+} +{$ENDIF} + +{$IFNDEF CPUX64}{$ALIGN ON}{$ENDIF} +{$MINENUMSIZE 4} + +{$I cef.inc} + +interface + +uses + {$IFDEF DELPHI16_UP} + System.Classes, System.SyncObjs, {$IFDEF MSWINDOWS}WinApi.Windows, WinApi.Messages,{$ENDIF} + {$IFDEF FMX} + FMX.Types, uCEFMacOSCustomCocoaTimer, + {$ELSE} + Vcl.ExtCtrls, + {$ENDIF} + {$ELSE} + Classes, SyncObjs, {$IFDEF MSWINDOWS}Windows,{$ENDIF} ExtCtrls, + {$IFDEF FPC} + LMessages, Forms, + {$ELSE} + Messages, + {$ENDIF} + {$ENDIF} + uCEFTypes, uCEFConstants, uCEFApplicationCore; + +type + TOnAllowEvent = procedure(Sender: TObject; var allow : boolean) of object; + + TCEFTimerWorkScheduler = class + protected + FTimer : {$IFDEF MACOS}TCustomCocoaTimer{$ELSE}TTimer{$ENDIF}; + FDepleteWorkCycles : cardinal; + FDepleteWorkDelay : cardinal; + FStopped : boolean; + FIsActive : boolean; + FReentrancyDetected : boolean; + FOnAllowDoWork : TOnAllowEvent; + {$IFDEF MSWINDOWS} + FCompHandle : HWND; + {$ENDIF} + + function GetIsTimerPending : boolean; + + procedure Timer_OnTimer(Sender: TObject); + + procedure Initialize; + procedure CreateTimer; + procedure DestroyTimer; + procedure KillTimer; + procedure SetTimer(aInterval : integer); + procedure DoWork; + function PerformMessageLoopWork : boolean; + procedure DoMessageLoopWork; + procedure OnScheduleWork(delay_ms : integer); + procedure DepleteWork; + {$IFDEF MSWINDOWS} + procedure WndProc(var aMessage: TMessage); + procedure AllocateWindowHandle; + procedure DeallocateWindowHandle; + {$ELSE} + {$IFDEF FPC} + procedure OnScheduleWorkAsync(Data: PtrInt); + {$ENDIF} + {$ENDIF} + + public + constructor Create; + destructor Destroy; override; + procedure StopScheduler; + procedure ScheduleMessagePumpWork(const delay_ms : int64); + + property DepleteWorkCycles : cardinal read FDepleteWorkCycles write FDepleteWorkCycles; + property DepleteWorkDelay : cardinal read FDepleteWorkDelay write FDepleteWorkDelay; + property IsTimerPending : boolean read GetIsTimerPending; + property OnAllowDoWork : TOnAllowEvent read FOnAllowDoWork write FOnAllowDoWork; + end; + +var + GlobalCEFTimerWorkScheduler : TCEFTimerWorkScheduler = nil; + +procedure DestroyGlobalCEFTimerWorkScheduler; + +implementation + +uses + {$IFDEF DELPHI16_UP} + System.SysUtils, System.Math {$IFDEF MACOS}, System.RTTI, FMX.Forms, FMX.Platform{$ENDIF}; + {$ELSE} + SysUtils, Math; + {$ENDIF} + +procedure DestroyGlobalCEFTimerWorkScheduler; +begin + if (GlobalCEFTimerWorkScheduler <> nil) then FreeAndNil(GlobalCEFTimerWorkScheduler); +end; + +constructor TCEFTimerWorkScheduler.Create; +begin + inherited Create; + + Initialize; + + {$IFDEF MSWINDOWS} + AllocateWindowHandle; + {$ENDIF} +end; + +destructor TCEFTimerWorkScheduler.Destroy; +begin + DestroyTimer; + + {$IFDEF MSWINDOWS} + DeallocateWindowHandle; + {$ENDIF} + + inherited Destroy; +end; + +procedure TCEFTimerWorkScheduler.Initialize; +begin + {$IFDEF MSWINDOWS} + FCompHandle := 0; + {$ENDIF} + FOnAllowDoWork := nil; + FTimer := nil; + FStopped := False; + FIsActive := False; + FReentrancyDetected := False; + FDepleteWorkCycles := CEF_TIMER_DEPLETEWORK_CYCLES; + FDepleteWorkDelay := CEF_TIMER_DEPLETEWORK_DELAY; +end; + +{$IFDEF MSWINDOWS} +procedure TCEFTimerWorkScheduler.WndProc(var aMessage: TMessage); +begin + if (aMessage.Msg = CEF_PUMPHAVEWORK) then + OnScheduleWork(aMessage.lParam) + else + aMessage.Result := DefWindowProc(FCompHandle, aMessage.Msg, aMessage.WParam, aMessage.LParam); +end; + +procedure TCEFTimerWorkScheduler.AllocateWindowHandle; +begin + if (FCompHandle = 0) and (GlobalCEFApp <> nil) and + ((GlobalCEFApp.ProcessType = ptBrowser) or GlobalCEFApp.SingleProcess) then + FCompHandle := AllocateHWnd({$IFDEF FPC}@{$ENDIF}WndProc); +end; + +procedure TCEFTimerWorkScheduler.DeallocateWindowHandle; +begin + if (FCompHandle <> 0) then + begin + DeallocateHWnd(FCompHandle); + FCompHandle := 0; + end; +end; +{$ENDIF} + +procedure TCEFTimerWorkScheduler.StopScheduler; +begin + FStopped := True; + KillTimer; + DepleteWork; +end; + +procedure TCEFTimerWorkScheduler.DepleteWork; +var + i : cardinal; +begin + i := FDepleteWorkCycles; + + while (i > 0) do + begin + DoMessageLoopWork; + Sleep(FDepleteWorkDelay); + dec(i); + end; +end; + +{$IFNDEF MSWINDOWS}{$IFDEF FPC} +procedure TCEFTimerWorkScheduler.OnScheduleWorkAsync(Data: PtrInt); +begin + OnScheduleWork(integer(Data)); +end; +{$ENDIF}{$ENDIF} + +procedure TCEFTimerWorkScheduler.CreateTimer; +begin + if (FTimer = nil) then + begin + {$IFDEF MACOS} + FTimer := TCustomCocoaTimer.Create; + {$ELSE} + FTimer := TTimer.Create(nil); + {$ENDIF} + FTimer.OnTimer := {$IFDEF FPC}@{$ENDIF}Timer_OnTimer; + FTimer.Enabled := False; + end; +end; + +procedure TCEFTimerWorkScheduler.DestroyTimer; +begin + if (FTimer <> nil) then + FreeAndNil(FTimer); +end; + +procedure TCEFTimerWorkScheduler.KillTimer; +begin + if (FTimer <> nil) then + FTimer.Enabled := False; +end; + +procedure TCEFTimerWorkScheduler.SetTimer(aInterval : integer); +begin + if (FTimer = nil) then + CreateTimer; + + FTimer.Interval := aInterval; + FTimer.Enabled := True; +end; + +function TCEFTimerWorkScheduler.GetIsTimerPending : boolean; +begin + Result := (FTimer <> nil) and FTimer.Enabled; +end; + +procedure TCEFTimerWorkScheduler.OnScheduleWork(delay_ms : integer); +begin + if FStopped or + ((delay_ms = high(integer)) and IsTimerPending) then + exit; + + KillTimer; + + if (delay_ms <= 0) then + DoWork + else + SetTimer(min(delay_ms, CEF_TIMER_MAXDELAY)); +end; + +procedure TCEFTimerWorkScheduler.Timer_OnTimer(Sender: TObject); +begin + KillTimer; + DoWork; +end; + +procedure TCEFTimerWorkScheduler.DoWork; +begin + if PerformMessageLoopWork then + ScheduleMessagePumpWork(0) + else + if not(IsTimerPending) then + ScheduleMessagePumpWork(high(integer)); +end; + +function TCEFTimerWorkScheduler.PerformMessageLoopWork : boolean; +begin + Result := False; + + if FIsActive then + begin + FReentrancyDetected := True; + exit; + end; + + FReentrancyDetected := False; + DoMessageLoopWork; + Result := FReentrancyDetected; +end; + +procedure TCEFTimerWorkScheduler.DoMessageLoopWork; +var + TempAllow : boolean; +begin + TempAllow := True; + + if assigned(FOnAllowDoWork) then + FOnAllowDoWork(self, TempAllow); + + if TempAllow and (GlobalCEFApp <> nil) then + try + FIsActive := True; + GlobalCEFApp.DoMessageLoopWork; + finally + FIsActive := False; + end; +end; + +procedure TCEFTimerWorkScheduler.ScheduleMessagePumpWork(const delay_ms : int64); +begin + if FStopped then exit; + + {$IFDEF MSWINDOWS} + if (FCompHandle <> 0) then + PostMessage(FCompHandle, CEF_PUMPHAVEWORK, 0, LPARAM(delay_ms)); + {$ELSE} + {$IFDEF FPC} + Application.QueueAsyncCall(@OnScheduleWorkAsync, integer(delay_ms)); + {$ELSE} + TThread.ForceQueue(nil, procedure + begin + OnScheduleWork(integer(delay_ms)); + end); + {$ENDIF} + {$ENDIF} +end; + +end. diff --git a/update_CEF4Delphi.json b/update_CEF4Delphi.json index e55fe244..e2b55e82 100644 --- a/update_CEF4Delphi.json +++ b/update_CEF4Delphi.json @@ -2,7 +2,7 @@ "UpdateLazPackages" : [ { "ForceNotify" : true, - "InternalVersion" : 298, + "InternalVersion" : 299, "Name" : "cef4delphi_lazarus.lpk", "Version" : "90.6.7.0" }