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:
parent
96cec7acb5
commit
51a29225ef
@ -42,7 +42,7 @@ program FMXExternalPumpBrowser;
|
||||
uses
|
||||
{$IFDEF DELPHI17_UP}
|
||||
System.StartUpCopy,
|
||||
{$ENDIF}
|
||||
{$ENDIF }
|
||||
FMX.Forms,
|
||||
uCEFApplication,
|
||||
uCEFFMXWorkScheduler,
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -2,7 +2,7 @@
|
||||
"UpdateLazPackages" : [
|
||||
{
|
||||
"ForceNotify" : true,
|
||||
"InternalVersion" : 294,
|
||||
"InternalVersion" : 295,
|
||||
"Name" : "cef4delphi_lazarus.lpk",
|
||||
"Version" : "90.6.6.0"
|
||||
}
|
||||
|
Loading…
x
Reference in New Issue
Block a user