Added CrAppProtocol protocol implementation to FMXExternalPumpBrowser for MacOS

demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dpr

@@ -42,7 +42,7 @@ program FMXExternalPumpBrowser;
 uses
   {$IFDEF DELPHI17_UP}
   System.StartUpCopy,
-  {$ENDIF}
+  {$ENDIF }
   FMX.Forms,
   uCEFApplication,
   uCEFFMXWorkScheduler,

demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXApplicationService.pas

@@ -34,7 +34,6 @@
  * this source code without explicit permission.
  *
  *)
-
 unit uFMXApplicationService;
 
 {$I cef.inc}
@@ -45,15 +44,64 @@ unit uFMXApplicationService;
 interface
 
 uses
-  FMX.Platform;
+  Macapi.Foundation, Macapi.CoreFoundation, Macapi.ObjectiveC, Macapi.Helpers,
+  Macapi.CocoaTypes, Macapi.AppKit, FMX.Platform;
 
 type
+  TFMXApplicationService = class;
+
+  ICrAppProtocol = interface(NSApplicationDelegate)
+    ['{2071D289-9A54-4AD7-BD83-E521ACD5C528}']
+    function isHandlingSendEvent: boolean; cdecl;
+  end;
+
+  ICrAppControlProtocol = interface(ICrAppProtocol)
+    ['{BCCDF64D-E8D7-4E0B-83BC-30F87145576C}']
+    procedure setHandlingSendEvent(handlingSendEvent: boolean); cdecl;
+  end;
+
+  TCrAppProtocol = class(TOCLocal, ICrAppControlProtocol)
+  private
+    FAppService : TFMXApplicationService;
+
+  public
+    constructor Create(const aAppService : TFMXApplicationService);
+
+    // ICrAppProtocol
+    function  isHandlingSendEvent: boolean; 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;
+  end;
+
   TFMXApplicationService = class(TInterfacedObject, IFMXApplicationService)
+    private
+      FNewDelegate          : ICrAppControlProtocol;
+      FOldDelegate          : NSApplicationDelegate;
+      FLastMacOsKeyDownCode : integer;
+
     protected
       class var OldFMXApplicationService: IFMXApplicationService;
       class var NewFMXApplicationService: IFMXApplicationService;
 
+      procedure ReplaceNSApplicationDelegate;
+      procedure RestoreNSApplicationDelegate;
+
+      function  GetHandlingSendEvent : boolean;
+
     public
+      constructor Create;
+      procedure   AfterConstruction; override;
+
+      // IFMXApplicationService
       procedure Run;
       function  HandleMessage: Boolean;
       procedure WaitMessage;
@@ -65,30 +113,175 @@ type
       function  Terminating: Boolean;
       function  Running: Boolean;
 
-      class procedure AddPlatformService;
+      // 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;
 
-      property  DefaultTitle  : string read GetDefaultTitle;
+      class procedure AddPlatformService;
-      property  Title         : string read GetTitle          write SetTitle;
+      class function  LastMacOsKeyDownCode: integer;
-      property  AppVersion    : string read GetVersionString;
+
+      property  DefaultTitle         : string    read GetDefaultTitle;
+      property  Title                : string    read GetTitle                write SetTitle;
+      property  AppVersion           : string    read GetVersionString;
+      property  HandlingSendEvent    : boolean   read GetHandlingSendEvent;
   end;
 
 implementation
 
 uses
-  FMX.Forms, {$IFDEF MSWINDOWS}Winapi.Messages, Winapi.Windows,{$ENDIF}
+  System.RTTI, FMX.Forms,
   uFMXExternalPumpBrowser, uCEFFMXWorkScheduler, uCEFApplication, uCEFConstants;
 
+// TCrAppProtocol
+constructor TCrAppProtocol.Create(const aAppService : TFMXApplicationService);
+begin
+  inherited Create;
+
+  FAppService := aAppService;
+end;
+
+function TCrAppProtocol.isHandlingSendEvent: Boolean;
+begin
+  Result := (FAppService <> nil) and FAppService.HandlingSendEvent;
+end;
+
+procedure TCrAppProtocol.setHandlingSendEvent(handlingSendEvent: boolean);
+begin
+  //
+end;
+
+function TCrAppProtocol.applicationShouldTerminate(Notification: NSNotification): NSInteger;
+begin
+  if assigned(FAppService) then
+    Result := FAppService.applicationShouldTerminate(Notification)
+   else
+    Result := 0;
+end;
+
+procedure TCrAppProtocol.applicationWillTerminate(Notification: NSNotification);
+begin
+  if assigned(FAppService) then
+    FAppService.applicationWillTerminate(Notification);
+end;
+
+procedure TCrAppProtocol.applicationDidFinishLaunching(Notification: NSNotification);
+begin
+  if assigned(FAppService) then
+    FAppService.applicationDidFinishLaunching(Notification);
+end;
+
+procedure TCrAppProtocol.applicationDidHide(Notification: NSNotification);
+begin
+  if assigned(FAppService) then
+    FAppService.applicationDidHide(Notification);
+end;
+
+procedure TCrAppProtocol.applicationDidUnhide(Notification: NSNotification);
+begin
+  if assigned(FAppService) then
+    FAppService.applicationDidUnhide(Notification);
+end;
+
+function TCrAppProtocol.applicationDockMenu(sender: NSApplication): NSMenu;
+begin
+  if assigned(FAppService) then
+    Result := FAppService.applicationDockMenu(sender)
+   else
+    Result := nil;
+end;
+
+//  TFMXApplicationService
+constructor TFMXApplicationService.Create;
+begin
+  inherited Create;
+
+  FNewDelegate          := nil;
+  FOldDelegate          := nil;
+  FLastMacOsKeyDownCode := 0;
+end;
+
+procedure TFMXApplicationService.AfterConstruction;
+begin
+  inherited AfterConstruction;
+
+  ReplaceNSApplicationDelegate;
+end;
+
+procedure TFMXApplicationService.ReplaceNSApplicationDelegate;
+var
+  TempNSApplication : NSApplication;
+begin
+  TempNSApplication := TNSApplication.Wrap(TNSApplication.OCClass.sharedApplication);
+  FNewDelegate      := ICrAppControlProtocol(TCrAppProtocol.Create(self));
+  FOldDelegate      := NSApplicationDelegate(TempNSApplication.delegate);
+
+  TempNSApplication.setDelegate(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.GetHandlingSendEvent : 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
+
+  TempService := TObject(TPlatformServices.Current.GetPlatformService(IFMXWindowService));
+
+  if (TempService <> nil) then
+    begin
+      TempRttiType := TempContext.GetType(TempService.ClassType);
+
+      if (TempRttiType <> nil) then
+        begin
+          TempField := TempRttiType.GetField('FDisableClosePopups');
+          Result    := (TempField <> nil) and
+                       TempField.GetValue(TempService).AsBoolean;
+        end;
+    end;
+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;
 
+class function TFMXApplicationService.LastMacOsKeyDownCode: integer;
+begin
+  if assigned(NewFMXApplicationService) then
+    Result := TFMXApplicationService(NewFMXApplicationService).FLastMacOsKeyDownCode
+   else
+    Result := 0;
+end;
+
 function TFMXApplicationService.GetDefaultTitle: string;
 begin
   Result := OldFMXApplicationService.GetDefaultTitle;
@@ -142,84 +335,63 @@ begin
   {$ENDIF}
 end;
 
-function TFMXApplicationService.HandleMessage: Boolean;
+function TFMXApplicationService.applicationShouldTerminate(Notification: NSNotification): NSInteger;
-{$IFDEF MSWINDOWS}
-var
-  TempMsg : TMsg;
-{$ENDIF}
 begin
-  {$IFDEF MSWINDOWS}
+  if assigned(FOldDelegate) then
-  if PeekMessage(TempMsg, 0, 0, 0, PM_NOREMOVE) then
+    Result := FOldDelegate.applicationShouldTerminate(Notification)
-    case TempMsg.Message of
+   else
-      WM_MOVE,
+    Result := 0;
-      WM_MOVING :
+end;
-        if not(Application.Terminated) and
-           (Application.MainForm <> nil) and
-           (Application.MainForm is TFMXExternalPumpBrowserFrm) then
-          TFMXExternalPumpBrowserFrm(Application.MainForm).NotifyMoveOrResizeStarted;
 
-      WM_ENTERMENULOOP :
+procedure TFMXApplicationService.applicationWillTerminate(Notification: NSNotification);
-        if (TempMsg.wParam = 0) and
+begin
-           (GlobalCEFApp <> nil) then
+  RestoreNSApplicationDelegate;
-          GlobalCEFApp.OsmodalLoop := True;
 
-      WM_EXITMENULOOP :
+  if assigned(FOldDelegate) then
-        if (TempMsg.wParam = 0) and
+    FOldDelegate.applicationWillTerminate(Notification);
-           (GlobalCEFApp <> nil) then
+end;
-          GlobalCEFApp.OsmodalLoop := False;
 
-      WM_CAPTURECHANGED,
+procedure TFMXApplicationService.applicationDidFinishLaunching(Notification: NSNotification);
-      WM_CANCELMODE :
+begin
-        if not(Application.Terminated) and
+  if assigned(FOldDelegate) then
-           (Application.MainForm <> nil) and
+    FOldDelegate.applicationDidFinishLaunching(Notification);
-           (Application.MainForm is TFMXExternalPumpBrowserFrm) then
+end;
-          TFMXExternalPumpBrowserFrm(Application.MainForm).SendCaptureLostEvent;
 
-      WM_SYSCHAR :
+procedure TFMXApplicationService.applicationDidHide(Notification: NSNotification);
-        if not(Application.Terminated) and
+begin
-           (Application.MainForm <> nil) and
+  if assigned(FOldDelegate) then
-           (Application.MainForm is TFMXExternalPumpBrowserFrm) then
+    FOldDelegate.applicationDidHide(Notification);
-          TFMXExternalPumpBrowserFrm(Application.MainForm).HandleSYSCHAR(TempMsg);
+end;
 
-      WM_SYSKEYDOWN :
+procedure TFMXApplicationService.applicationDidUnhide(Notification: NSNotification);
-        if not(Application.Terminated) and
+begin
-           (Application.MainForm <> nil) and
+  if assigned(FOldDelegate) then
-           (Application.MainForm is TFMXExternalPumpBrowserFrm) then
+    FOldDelegate.applicationDidUnhide(Notification);
-          TFMXExternalPumpBrowserFrm(Application.MainForm).HandleSYSKEYDOWN(TempMsg);
+end;
 
-      WM_SYSKEYUP :
+function TFMXApplicationService.applicationDockMenu(sender: NSApplication): NSMenu;
-        if not(Application.Terminated) and
+begin
-           (Application.MainForm <> nil) and
+  if assigned(FOldDelegate) then
-           (Application.MainForm is TFMXExternalPumpBrowserFrm) then
+    Result := FOldDelegate.applicationDockMenu(sender)
-          TFMXExternalPumpBrowserFrm(Application.MainForm).HandleSYSKEYUP(TempMsg);
+   else
+    Result := nil;
+end;
 
-      WM_KEYDOWN :
+function TFMXApplicationService.HandleMessage: Boolean;     {
-        if not(Application.Terminated) and
+const
-           (Application.MainForm <> nil) and
+  WaitTimeout = 0.001;
-           (Application.MainForm is TFMXExternalPumpBrowserFrm) then
+var
-          TFMXExternalPumpBrowserFrm(Application.MainForm).HandleKEYDOWN(TempMsg);
+  TempEvent    : NSEvent;
+  TempNSApp    : NSApplication;
+  TempTimeout  : NSDate;   }
+begin            {
+  TempNSApp    := TNSApplication.Wrap(TNSApplication.OCClass.sharedApplication);
+  TempTimeout  := TNSDate.Wrap(TNSDate.OCClass.dateWithTimeIntervalSinceNow(WaitTimeout));
+  TempEvent    := TempNSApp.nextEventMatchingMask(NSAnyEventMask, TempTimeout, NSDefaultRunLoopMode, False);
 
-      WM_KEYUP :
+  if (TempEvent <> nil) and (TempEvent.&type = NSKeyDown) then
-        if not(Application.Terminated) and
+    FLastMacOsKeyDownCode := TempEvent.keyCode;
-           (Application.MainForm <> nil) and
+            }
-           (Application.MainForm is TFMXExternalPumpBrowserFrm) then
-          TFMXExternalPumpBrowserFrm(Application.MainForm).HandleKEYUP(TempMsg);
-
-      WM_POINTERDOWN,
-      WM_POINTERUPDATE,
-      WM_POINTERUP :
-        if not(Application.Terminated) and
-           (Application.MainForm <> nil) and
-           (Application.MainForm is TFMXExternalPumpBrowserFrm) then
-          TFMXExternalPumpBrowserFrm(Application.MainForm).HandlePOINTER(TempMsg);
-
-      CEF_PENDINGRESIZE :
-        if not(Application.Terminated) and
-           (Application.MainForm <> nil) and
-           (Application.MainForm is TFMXExternalPumpBrowserFrm) then
-          TFMXExternalPumpBrowserFrm(Application.MainForm).DoResize;
-    end;
-  {$ENDIF}
 
   Result := OldFMXApplicationService.HandleMessage;
 end;

demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.fmx

@@ -14,6 +14,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
   OnDestroy = FormDestroy
   OnShow = FormShow
   OnHide = FormHide
+  OnSaveState = Panel1Resize
   DesignerMasterStyle = 0
   object AddressPnl: TPanel
     Align = Top
@@ -92,6 +93,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
     Size.Width = 800.000000000000000000
     Size.Height = 600.000000000000000000
     Size.PlatformDefault = False
+    OnResized = Panel1Resize
     OnEnter = Panel1Enter
     OnExit = Panel1Exit
     OnResize = Panel1Resize

demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas

@@ -115,7 +115,6 @@ type
     procedure SnapshotBtnClick(Sender: TObject);
     procedure SnapshotBtnEnter(Sender: TObject);
 
-
   protected
     FPopUpBitmap       : TBitmap;
     FPopUpRect         : TRect;
@@ -125,7 +124,6 @@ type
     FCanClose          : boolean;
     FClosing           : boolean;
     FResizeCS          : TCriticalSection;
-    FAtLeastWin8       : boolean;
     {$IFDEF DELPHI17_UP}
     FMouseWheelService : IFMXMouseService;
     {$ENDIF}
@@ -174,11 +172,10 @@ var
 // ****************************************************************************
 // Known issues and missing features :
 // - Keyboard support not implemented yet.
-// - Maximize event is not handled correctly.
+// - Full screen event is not handled correctly.
-// - Missing CrAppProtocol implementation in NSApplication. The original file in
+// - The CrAppProtocol implementation in uFMXApplicationService needs to be tested.
-//      the CEF sources is here : https://bitbucket.org/chromiumembedded/cef/src/master/include/cef_application_mac.h
-//      Lazarus implementation is in the uCEFLazarusCocoa.pas unit.
 // - All Windows code in this demo must be removed.
+// - Right-click crashes the demo.
 
 
 // This is a simple browser using FireMonkey components in OSR mode (off-screen rendering)
@@ -324,14 +321,6 @@ begin
   FClosing        := False;
   FResizeCS       := TCriticalSection.Create;
 
-  {$IFDEF MSWINDOWS}
-  FAtLeastWin8 := GetWindowsMajorMinorVersion(TempMajorVer, TempMinorVer) and
-                  ((TempMajorVer > 6) or
-                   ((TempMajorVer = 6) and (TempMinorVer >= 2)));
-  {$ELSE}
-  FAtLeastWin8 := False;
-  {$ENDIF}
-
   chrmosr.DefaultURL := AddressEdt.Text;
 
   InitializeLastClick;
@@ -418,6 +407,7 @@ begin
       TempKeyEvent.kind                    := KEYEVENT_CHAR;
       TempKeyEvent.modifiers               := getModifiers(Shift);
       TempKeyEvent.windows_key_code        := ord(KeyChar);
+     // TempKeyEvent.native_key_code         := TFMXApplicationService.LastMacOsKeyDownCode;
       TempKeyEvent.native_key_code         := 0;
       TempKeyEvent.is_system_key           := ord(False);
       TempKeyEvent.character               := #0;
@@ -754,7 +744,7 @@ begin
                 begin
                   if (dirtyRects[n].x >= 0) and (dirtyRects[n].y >= 0) then
                     begin
-                      TempLineSize := min(dirtyRects[n].width, TempWidth - dirtyRects[n].x) * SizeOf(TRGBQuad);
+                      TempLineSize := min(dirtyRects[n].width, TempWidth - dirtyRects[n].x);
 
                       if (TempLineSize > 0) then
                         begin
@@ -783,7 +773,7 @@ begin
 
                               srcPixel := src;
                               dstPixel := dst;
-                              k        := TempLineSize div SizeOf(TRGBQuad);
+                              k        := TempLineSize;
 
                               while (k > 0) do
                                 begin

update_CEF4Delphi.json

@@ -2,7 +2,7 @@
   "UpdateLazPackages" : [
     {
       "ForceNotify" : true,
-      "InternalVersion" : 294,
+      "InternalVersion" : 295,
       "Name" : "cef4delphi_lazarus.lpk",
       "Version" : "90.6.6.0"
     }