// ************************************************************************ // ***************************** 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 © 2022 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 uFMXApplicationService; {$I cef.inc} // This unit is based in the TFMXApplicationService class created by Takashi Yamamoto // https://www.gesource.jp/weblog/?p=7367 interface uses System.TypInfo, Macapi.Foundation, Macapi.CoreFoundation, Macapi.ObjectiveC, Macapi.Helpers, Macapi.CocoaTypes, Macapi.AppKit, FMX.Platform, uCEFMacOSInterfaces; type TFMXApplicationService = class; TFMXApplicationDelegateEx = class(TOCLocal, IFMXApplicationDelegate) protected FAppService : TFMXApplicationService; public constructor Create(const aAppService : TFMXApplicationService); function GetObjectiveCClass: PTypeInfo; override; // CrAppProtocol function isHandlingSendEvent: boolean; cdecl; // CrAppControlProtocol procedure setHandlingSendEvent(handlingSendEvent: boolean); cdecl; // IFMXApplicationDelegate procedure onMenuClicked(sender: NSMenuItem); 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) protected FNewDelegate : IFMXApplicationDelegate; FOldDelegate : IFMXApplicationDelegate; FHandlingSendEventOverride : boolean; procedure ReplaceNSApplicationDelegate; procedure RestoreNSApplicationDelegate; function GetPrivateFieldAsBoolean(const aFieldName : string) : boolean; public constructor Create; procedure AfterConstruction; override; // IFMXApplicationService procedure Run; function HandleMessage: Boolean; procedure WaitMessage; function GetDefaultTitle: string; function GetTitle: string; procedure SetTitle(const Value: string); function GetVersionString: string; procedure Terminate; function Terminating: Boolean; function Running: Boolean; // IFMXApplicationServiceEx function GetHandlingSendEvent : boolean; procedure SetHandlingSendEvent(aValue : boolean); // NSApplicationDelegate function applicationShouldTerminate(Notification: NSNotification): NSInteger; procedure applicationWillTerminate(Notification: NSNotification); procedure applicationDidFinishLaunching(Notification: NSNotification); procedure applicationDidHide(Notification: NSNotification); 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 write SetHandlingSendEvent; end; implementation uses System.RTTI, FMX.Forms, FMX.Helpers.Mac, System.Messaging, uFMXExternalPumpBrowser, uCEFFMXWorkScheduler, uCEFApplication, uCEFConstants, uCEFMacOSFunctions; // TFMXApplicationDelegateEx constructor TFMXApplicationDelegateEx.Create(const aAppService : TFMXApplicationService); begin inherited Create; FAppService := aAppService; end; function TFMXApplicationDelegateEx.GetObjectiveCClass: PTypeInfo; begin Result := TypeInfo(CrAppControlProtocol); end; function TFMXApplicationDelegateEx.isHandlingSendEvent: Boolean; begin Result := (FAppService <> nil) and FAppService.HandlingSendEvent; end; procedure TFMXApplicationDelegateEx.setHandlingSendEvent(handlingSendEvent: boolean); begin if (FAppService <> nil) then FAppService.HandlingSendEvent := handlingSendEvent; end; function TFMXApplicationDelegateEx.applicationShouldTerminate(Notification: NSNotification): NSInteger; begin if assigned(FAppService) then Result := FAppService.applicationShouldTerminate(Notification) else Result := 0; end; procedure TFMXApplicationDelegateEx.applicationWillTerminate(Notification: NSNotification); begin if assigned(FAppService) then FAppService.applicationWillTerminate(Notification); end; procedure TFMXApplicationDelegateEx.applicationDidFinishLaunching(Notification: NSNotification); begin if assigned(FAppService) then FAppService.applicationDidFinishLaunching(Notification); end; procedure TFMXApplicationDelegateEx.applicationDidHide(Notification: NSNotification); begin if assigned(FAppService) then FAppService.applicationDidHide(Notification); end; procedure TFMXApplicationDelegateEx.applicationDidUnhide(Notification: NSNotification); begin if assigned(FAppService) then FAppService.applicationDidUnhide(Notification); end; function TFMXApplicationDelegateEx.applicationDockMenu(sender: NSApplication): NSMenu; begin if assigned(FAppService) then Result := FAppService.applicationDockMenu(sender) else 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; FHandlingSendEventOverride := False; end; procedure TFMXApplicationService.AfterConstruction; begin inherited AfterConstruction; ReplaceNSApplicationDelegate; end; procedure TFMXApplicationService.ReplaceNSApplicationDelegate; var TempNSApplication : NSApplication; begin TempNSApplication := TNSApplication.Wrap(TNSApplication.OCClass.sharedApplication); FNewDelegate := IFMXApplicationDelegate(TFMXApplicationDelegateEx.Create(self)); FOldDelegate := IFMXApplicationDelegate(TempNSApplication.delegate); TempNSApplication.setDelegate(NSApplicationDelegate(FNewDelegate)); end; procedure TFMXApplicationService.RestoreNSApplicationDelegate; var TempNSApplication : NSApplication; begin if assigned(FOldDelegate) then begin TempNSApplication := TNSApplication.Wrap(TNSApplication.OCClass.sharedApplication); TempNSApplication.setDelegate(FOldDelegate); FOldDelegate := nil; end; end; function TFMXApplicationService.GetPrivateFieldAsBoolean(const aFieldName : string) : boolean; var TempContext : TRttiContext; TempRttiType : TRttiType; TempField : TRttiField; TempService : TObject; begin // 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 begin TempRttiType := TempContext.GetType(TempService.ClassType); if (TempRttiType <> nil) then begin 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 begin TPlatformServices.Current.RemovePlatformService(IFMXApplicationService); NewFMXApplicationService := TFMXApplicationService.Create; TPlatformServices.Current.AddPlatformService(IFMXApplicationService, NewFMXApplicationService); end; end; function TFMXApplicationService.GetDefaultTitle: string; begin Result := OldFMXApplicationService.GetDefaultTitle; end; function TFMXApplicationService.GetTitle: string; begin Result := OldFMXApplicationService.GetTitle; end; function TFMXApplicationService.GetVersionString: string; begin {$IFDEF DELPHI22_UP} Result := OldFMXApplicationService.GetVersionString; {$ELSE DELPHI22_UP} Result := 'unsupported yet'; {$ENDIF DELPHI22_UP} end; procedure TFMXApplicationService.Run; begin OldFMXApplicationService.Run; end; procedure TFMXApplicationService.SetTitle(const Value: string); begin OldFMXApplicationService.SetTitle(Value); end; procedure TFMXApplicationService.Terminate; begin OldFMXApplicationService.Terminate; end; function TFMXApplicationService.Terminating: Boolean; begin Result := OldFMXApplicationService.Terminating; end; procedure TFMXApplicationService.WaitMessage; begin OldFMXApplicationService.WaitMessage; end; function TFMXApplicationService.Running: Boolean; begin {$IFDEF DELPHI24_UP} Result := OldFMXApplicationService.Running; {$ELSE} Result := True; {$ENDIF} end; function TFMXApplicationService.applicationShouldTerminate(Notification: NSNotification): NSInteger; begin if assigned(FOldDelegate) then Result := FOldDelegate.applicationShouldTerminate(Notification) else Result := 0; end; procedure TFMXApplicationService.applicationWillTerminate(Notification: NSNotification); begin RestoreNSApplicationDelegate; if assigned(FOldDelegate) then FOldDelegate.applicationWillTerminate(Notification); end; procedure TFMXApplicationService.applicationDidFinishLaunching(Notification: NSNotification); begin if assigned(FOldDelegate) then FOldDelegate.applicationDidFinishLaunching(Notification); end; procedure TFMXApplicationService.applicationDidHide(Notification: NSNotification); begin if assigned(FOldDelegate) then FOldDelegate.applicationDidHide(Notification); end; procedure TFMXApplicationService.applicationDidUnhide(Notification: NSNotification); begin if assigned(FOldDelegate) then FOldDelegate.applicationDidUnhide(Notification); end; function TFMXApplicationService.applicationDockMenu(sender: NSApplication): NSMenu; begin if assigned(FOldDelegate) then Result := FOldDelegate.applicationDockMenu(sender) else 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; end; end.