1
0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-06-02 21:57:37 +02:00

Added CrAppProtocol protocol implementation to FMXExternalPumpBrowser for MacOS

This commit is contained in:
Salvador Díaz Fau 2021-05-23 19:45:24 +02:00
parent 96cec7acb5
commit 51a29225ef
5 changed files with 259 additions and 95 deletions

View File

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

View File

@ -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;
property Title : string read GetTitle write SetTitle;
property AppVersion : string read GetVersionString;
class procedure AddPlatformService;
class function LastMacOsKeyDownCode: integer;
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;
{$IFDEF MSWINDOWS}
var
TempMsg : TMsg;
{$ENDIF}
function TFMXApplicationService.applicationShouldTerminate(Notification: NSNotification): NSInteger;
begin
{$IFDEF MSWINDOWS}
if PeekMessage(TempMsg, 0, 0, 0, PM_NOREMOVE) then
case TempMsg.Message of
WM_MOVE,
WM_MOVING :
if not(Application.Terminated) and
(Application.MainForm <> nil) and
(Application.MainForm is TFMXExternalPumpBrowserFrm) then
TFMXExternalPumpBrowserFrm(Application.MainForm).NotifyMoveOrResizeStarted;
if assigned(FOldDelegate) then
Result := FOldDelegate.applicationShouldTerminate(Notification)
else
Result := 0;
end;
WM_ENTERMENULOOP :
if (TempMsg.wParam = 0) and
(GlobalCEFApp <> nil) then
GlobalCEFApp.OsmodalLoop := True;
procedure TFMXApplicationService.applicationWillTerminate(Notification: NSNotification);
begin
RestoreNSApplicationDelegate;
WM_EXITMENULOOP :
if (TempMsg.wParam = 0) and
(GlobalCEFApp <> nil) then
GlobalCEFApp.OsmodalLoop := False;
if assigned(FOldDelegate) then
FOldDelegate.applicationWillTerminate(Notification);
end;
WM_CAPTURECHANGED,
WM_CANCELMODE :
if not(Application.Terminated) and
(Application.MainForm <> nil) and
(Application.MainForm is TFMXExternalPumpBrowserFrm) then
TFMXExternalPumpBrowserFrm(Application.MainForm).SendCaptureLostEvent;
procedure TFMXApplicationService.applicationDidFinishLaunching(Notification: NSNotification);
begin
if assigned(FOldDelegate) then
FOldDelegate.applicationDidFinishLaunching(Notification);
end;
WM_SYSCHAR :
if not(Application.Terminated) and
(Application.MainForm <> nil) and
(Application.MainForm is TFMXExternalPumpBrowserFrm) then
TFMXExternalPumpBrowserFrm(Application.MainForm).HandleSYSCHAR(TempMsg);
procedure TFMXApplicationService.applicationDidHide(Notification: NSNotification);
begin
if assigned(FOldDelegate) then
FOldDelegate.applicationDidHide(Notification);
end;
WM_SYSKEYDOWN :
if not(Application.Terminated) and
(Application.MainForm <> nil) and
(Application.MainForm is TFMXExternalPumpBrowserFrm) then
TFMXExternalPumpBrowserFrm(Application.MainForm).HandleSYSKEYDOWN(TempMsg);
procedure TFMXApplicationService.applicationDidUnhide(Notification: NSNotification);
begin
if assigned(FOldDelegate) then
FOldDelegate.applicationDidUnhide(Notification);
end;
WM_SYSKEYUP :
if not(Application.Terminated) and
(Application.MainForm <> nil) and
(Application.MainForm is TFMXExternalPumpBrowserFrm) then
TFMXExternalPumpBrowserFrm(Application.MainForm).HandleSYSKEYUP(TempMsg);
function TFMXApplicationService.applicationDockMenu(sender: NSApplication): NSMenu;
begin
if assigned(FOldDelegate) then
Result := FOldDelegate.applicationDockMenu(sender)
else
Result := nil;
end;
WM_KEYDOWN :
if not(Application.Terminated) and
(Application.MainForm <> nil) and
(Application.MainForm is TFMXExternalPumpBrowserFrm) then
TFMXExternalPumpBrowserFrm(Application.MainForm).HandleKEYDOWN(TempMsg);
function TFMXApplicationService.HandleMessage: Boolean; {
const
WaitTimeout = 0.001;
var
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 not(Application.Terminated) and
(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}
if (TempEvent <> nil) and (TempEvent.&type = NSKeyDown) then
FLastMacOsKeyDownCode := TempEvent.keyCode;
}
Result := OldFMXApplicationService.HandleMessage;
end;

View File

@ -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

View File

@ -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.
// - Missing CrAppProtocol implementation in NSApplication. The original file in
// 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.
// - Full screen event is not handled correctly.
// - The CrAppProtocol implementation in uFMXApplicationService needs to be tested.
// - 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

View File

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