Delphi/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2024-11-15 15:55:56 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Added TCEFTimerWorkScheduler

Browse Source 
- Moved the GlobalCEFWorkScheduler creation after the GlobalCEFApp creation in all demos using it.
- Replaced TCEFWorkScheduler by TCEFTimerWorkScheduler in FMX demos for Linux and MacOS.
- Fixed context menu issue in FMXExternalPumpBrowser2 for Linux
- Fixed stability issues in FMXExternalPumpBrowser for MacOS
- Fixed 32bit build issues in TinyBrowser and ToolBoxBrowser2 demos.
- Added uCEFMacOSInterfaces and uCEFMacOSCustomCocoaTimer.
This commit is contained in:
Salvador Díaz Fau 2021-06-04 15:10:40 +02:00
parent b14abde967
commit 43ab8ef953
67 changed files with 2517 additions and 1406 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uCEFLoader.pas
View File

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

2
demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uFMXExternalPumpBrowser2.fmx
View File

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

112
demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/uFMXExternalPumpBrowser2.pas
View File

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

7
demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dpr
View File

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

155
demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXApplicationService.pas
View File

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

58
demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.fmx
View File

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

294
demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas
View File

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

12
demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{BE24D13B-2634-4064-8746-AB331419C5FA}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<MainSource>FMXExternalPumpBrowser.dpr</MainSource>
<Base>True</Base>
@ -341,6 +341,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

18
demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas
View File

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

12
demos/Delphi_FMX_Windows/FMXTabbedBrowser/FMXTabbedBrowser.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7AA2E07C-ACFB-4174-A9F1-083E9BB483BC}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<MainSource>FMXTabbedBrowser.dpr</MainSource>
<Base>True</Base>
@ -329,6 +329,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

2072
demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uBrowserFrame.pas
View File

File diff suppressed because it is too large Load Diff

17
demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uMainForm.pas
View File

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

12
demos/Delphi_FMX_Windows/FMXToolBoxBrowser/FMXToolBoxBrowser.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{04DED2F9-59A2-4E14-A538-C6B47842101F}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<MainSource>FMXToolBoxBrowser.dpr</MainSource>
<Base>True</Base>
@ -347,6 +347,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

12
demos/Delphi_FMX_Windows/SimpleFMXBrowser/SimpleFMXBrowser.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{5967B4A4-5E6D-420E-B524-A52A1240AC82}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<MainSource>SimpleFMXBrowser.dpr</MainSource>
<Base>True</Base>
@ -343,6 +343,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

12
demos/Delphi_VCL/ConsoleBrowser2/ConsoleBrowser2.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{AA8E526F-FBD1-4D31-B463-A4CE79C00B18}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>ConsoleBrowser2.dpr</MainSource>
<Base>True</Base>
@ -286,6 +286,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

12
demos/Delphi_VCL/ConsoleBrowser2/ConsoleBrowser2_sp.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{6ABCF641-08D0-4F35-9D13-2FBD18E5152A}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>ConsoleBrowser2_sp.dpr</MainSource>
<Base>True</Base>
@ -299,6 +299,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

12
demos/Delphi_VCL/Extensions/PageColorExt/PageColorExt.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{55E00327-9D98-4DA3-A4E1-844942A01C6B}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>PageColorExt.dpr</MainSource>
<Base>True</Base>
@ -314,6 +314,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

12
demos/Delphi_VCL/JavaScript/JSExecutingFunctions/JSExecutingFunctions.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7AA32B92-A408-42CB-A571-383721053FFA}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>JSExecutingFunctions.dpr</MainSource>
<Base>True</Base>
@ -311,6 +311,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

12
demos/Delphi_VCL/JavaScript/JSExtensionWithFunction/JSExtensionWithFunction.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7AA32B92-A408-42CB-A571-383721053FFA}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>JSExtensionWithFunction.dpr</MainSource>
<Base>True</Base>
@ -311,6 +311,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

14
demos/Delphi_VCL/JavaScript/JSExtensionWithObjectParameter/JSExtensionWithObjectParameter.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7AA32B92-A408-42CB-A571-383721053FFA}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>JSExtensionWithObjectParameter.dpr</MainSource>
<Base>True</Base>
@ -164,13 +164,13 @@
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="JSExtension.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployFile LocalName="..\..\..\bin\JSExtensionWithObjectParameter.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>JSExtensionWithObjectParameter.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="JSExtension.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
@ -311,6 +311,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

14
demos/Delphi_VCL/JavaScript/JSRTTIExtension/JSRTTIExtension.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7AA32B92-A408-42CB-A571-383721053FFA}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>JSRTTIExtension.dpr</MainSource>
<Base>True</Base>
@ -166,13 +166,13 @@
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="JSExtension.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployFile LocalName="..\..\bin\JSRTTIExtension.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>JSRTTIExtension.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="JSExtension.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
@ -313,6 +313,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

12
demos/Delphi_VCL/JavaScript/JSSimpleExtension/JSSimpleExtension.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7AA32B92-A408-42CB-A571-383721053FFA}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>JSSimpleExtension.dpr</MainSource>
<Base>True</Base>
@ -346,6 +346,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

12
demos/Delphi_VCL/JavaScript/JSSimpleWindowBinding/JSSimpleWindowBinding.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7AA32B92-A408-42CB-A571-383721053FFA}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>JSSimpleWindowBinding.dpr</MainSource>
<Base>True</Base>
@ -310,6 +310,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

12
demos/Delphi_VCL/JavaScript/JSWindowBindingSubProcess/JSSimpleWindowBinding.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7AA32B92-A408-42CB-A571-383721053FFA}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>JSSimpleWindowBinding.dpr</MainSource>
<Base>True</Base>
@ -313,6 +313,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

12
demos/Delphi_VCL/JavaScript/JSWindowBindingSubProcess/SubProcess.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{6ABCF641-08D0-4F35-9D13-2FBD18E5152A}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>SubProcess.dpr</MainSource>
<Base>True</Base>
@ -281,6 +281,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

12
demos/Delphi_VCL/JavaScript/JSWindowBindingWithArrayBuffer/JSWindowBindingWithArrayBuffer.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7AA32B92-A408-42CB-A571-383721053FFA}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>JSWindowBindingWithArrayBuffer.dpr</MainSource>
<Base>True</Base>
@ -310,6 +310,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

12
demos/Delphi_VCL/JavaScript/JSWindowBindingWithFunction/JSWindowBindingWithFunction.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7AA32B92-A408-42CB-A571-383721053FFA}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>JSWindowBindingWithFunction.dpr</MainSource>
<Base>True</Base>
@ -311,6 +311,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

12
demos/Delphi_VCL/JavaScript/JSWindowBindingWithObject/JSWindowBindingWithObject.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7AA32B92-A408-42CB-A571-383721053FFA}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>JSWindowBindingWithObject.dpr</MainSource>
<Base>True</Base>
@ -311,6 +311,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

2
demos/Delphi_VCL/MDIBrowser/MDIBrowser.dproj
View File

@ -7,7 +7,7 @@
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<Base>True</Base>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<Platform Condition="'$(Platform)'==''">Win64</Platform>
<TargetedPlatforms>3</TargetedPlatforms>
<AppType>Application</AppType>
</PropertyGroup>

5
demos/Delphi_VCL/MDIExternalPumpBrowser/uChildForm.pas
View File

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

22
demos/Delphi_VCL/MDIExternalPumpBrowser/uMainForm.pas
View File

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

12
demos/Delphi_VCL/OAuth2Tester/OAuth2Tester.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{FF0090FB-12B4-40DE-86E7-6E71DD3624CA}</ProjectGuid>
<ProjectVersion>19.1</ProjectVersion>
<ProjectVersion>19.2</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>OAuth2Tester.dpr</MainSource>
<Base>True</Base>
@ -277,6 +277,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>

6
demos/Delphi_VCL/SubProcess/SimpleBrowser_sp.dpr
View File

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

5
demos/Delphi_VCL/SubProcess/SimpleBrowser_sp.dproj
View File

@ -5,7 +5,7 @@
<FrameworkType>VCL</FrameworkType>
<MainSource>SimpleBrowser_sp.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Release</Config>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>3</TargetedPlatforms>
<AppType>Application</AppType>
@ -94,6 +94,7 @@
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<AppDPIAwarenessMode>PerMonitor</AppDPIAwarenessMode>
<VerInfo_Keys>CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
@ -141,13 +142,13 @@
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="Win32\Debug\SubProcess.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployFile LocalName="..\..\..\bin\SimpleBrowser_sp.exe" Configuration="Release" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>SimpleBrowser_sp.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\Debug\SubProcess.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>

8
demos/Delphi_VCL/SubProcess/uSimpleBrowser.pas
View File

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

11
demos/Delphi_VCL/TinyBrowser/TinyBrowser.dpr
View File

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

42
demos/Delphi_VCL/TinyBrowser/TinyBrowser.dproj
View File

@ -5,8 +5,8 @@
<FrameworkType>VCL</FrameworkType>
<MainSource>TinyBrowser.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform>
<Config Condition="'$(Config)'==''">Debug mem alloc</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>3</TargetedPlatforms>
<AppType>Application</AppType>
</PropertyGroup>
@ -51,6 +51,17 @@
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug mem alloc' or '$(Cfg_3)'!=''">
<Cfg_3>true</Cfg_3>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_3)'=='true') or '$(Cfg_3_Win32)'!=''">
<Cfg_3_Win32>true</Cfg_3_Win32>
<CfgParent>Cfg_3</CfgParent>
<Cfg_3>true</Cfg_3>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>..\..\..\bin</DCC_ExeOutput>
@ -80,8 +91,8 @@
<DCC_UsePackage>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)</DCC_UsePackage>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>(None)</Manifest_File>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
@ -95,6 +106,8 @@
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<VerInfo_Locale>1033</VerInfo_Locale>
@ -110,22 +123,33 @@
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_3)'!=''">
<DCC_Define>DEBUG;CEF4DELHI_ALLOC_DEBUG;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_3_Win32)'!=''">
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="uTinyBrowser.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Debug mem alloc">
<Key>Cfg_3</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
@ -136,9 +160,9 @@
<Source Name="MainSource">TinyBrowser.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclIPIndyImpl260.bpl">IP Abstraction Indy Implementation Design Time</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k260.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp260.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclIPIndyImpl270.bpl">IP Abstraction Indy Implementation Design Time</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k270.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp270.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">

16
demos/Delphi_VCL/TinyBrowser/uTinyBrowser.pas
View File

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

2
demos/Delphi_VCL/TinyBrowser2/TinyBrowser2.dproj
View File

@ -6,7 +6,7 @@
<MainSource>TinyBrowser2.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<Platform Condition="'$(Platform)'==''">Win64</Platform>
<TargetedPlatforms>3</TargetedPlatforms>
<AppType>Application</AppType>
</PropertyGroup>

2
demos/Delphi_VCL/ToolBoxBrowser2/ToolBoxBrowser2.dproj
View File

@ -6,7 +6,7 @@
<MainSource>ToolBoxBrowser2.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>3</TargetedPlatforms>
<AppType>Application</AppType>
</PropertyGroup>

2
demos/Delphi_VCL/ToolBoxBrowser2/uMainForm.dfm
View File

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

14
demos/Delphi_VCL/ToolBoxBrowser2/uMainForm.pas
View File

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

2
demos/Lazarus_Linux/ExternalPumpBrowser/uExternalPumpBrowser.lfm
View File

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

16
demos/Lazarus_Linux/ExternalPumpBrowser/uExternalPumpBrowser.pas
View File

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

4
demos/Lazarus_Linux/OSRExternalPumpBrowser/uosrexternalpumpbrowser.lfm
View File

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

16
demos/Lazarus_Linux/OSRExternalPumpBrowser/uosrexternalpumpbrowser.pas
View File

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

10
demos/Lazarus_Windows/ExternalPumpBrowser/uExternalPumpBrowser.lfm
View File

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

13
demos/Lazarus_Windows/ExternalPumpBrowser/uExternalPumpBrowser.pas
View File

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

13
demos/Lazarus_Windows/OSRExternalPumpBrowser/uOSRExternalPumpBrowser.pas
View File

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

35
demos/Lazarus_Windows/TinyBrowser/uTinyBrowser.pas
View File

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

14
demos/Lazarus_Windows/ToolBoxBrowser2/uMainForm.lfm
View File

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

27
demos/Lazarus_Windows/ToolBoxBrowser2/uMainForm.pas
View File

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

2
demos/Lazarus_any_OS/BrowserWindow/00-Delete.bat Normal file
View File

@ -0,0 +1,2 @@
rmdir /S /Q lib
rmdir /S /Q backup

BIN
demos/Lazarus_any_OS/BrowserWindow/BrowserWindow.res
View File

Binary file not shown.

2
demos/Lazarus_any_OS/BrowserWindowDom/00-Delete.bat Normal file
View File

@ -0,0 +1,2 @@
rmdir /S /Q lib
rmdir /S /Q backup

BIN
demos/Lazarus_any_OS/ExternalPumpBrowser/ExternalPumpBrowser.res
View File

Binary file not shown.

4
packages/CEF4Delphi.dpk
View File

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

1
packages/CEF4Delphi.dproj
View File

@ -318,6 +318,7 @@
<DCCReference Include="..\source\uCEFPrintJobCallback.pas"/>
<DCCReference Include="..\source\uCEFWorkSchedulerQueueThread.pas"/>
<DCCReference Include="..\source\uCEFLinkedWinControlBase.pas"/>
<DCCReference Include="..\source\uCEFTimerWorkScheduler.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

5
packages/CEF4Delphi_FMX.dpk
View File

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

3
packages/CEF4Delphi_FMX.dproj
View File

@ -349,6 +349,9 @@
<DCCReference Include="..\source\uCEFLinkedWinControlBase.pas"/>
<DCCReference Include="..\source\uCEFMacOSConstants.pas"/>
<DCCReference Include="..\source\uCEFMacOSFunctions.pas"/>
<DCCReference Include="..\source\uCEFTimerWorkScheduler.pas"/>
<DCCReference Include="..\source\uCEFMacOSCustomCocoaTimer.pas"/>
<DCCReference Include="..\source\uCEFMacOSInterfaces.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

6
packages/cef4delphi_lazarus.lpk
View File

@ -22,7 +22,7 @@
<Description Value="CEF4Delphi is an open source project created by Salvador Díaz Fau to embed Chromium-based browsers in applications made with Delphi or Lazarus/FPC."/>
<License Value="MPL 1.1"/>
<Version Major="90" Minor="6" Release="7"/>
<Files Count="201">
<Files Count="202">
<Item1>
<Filename Value="..\source\uCEFAccessibilityHandler.pas"/>
<UnitName Value="uCEFAccessibilityHandler"/>
@ -845,6 +845,10 @@
<HasRegisterProc Value="True"/>
<UnitName Value="uCEFOsrBrowserWindow"/>
</Item201>
<Item202>
<Filename Value="..\source\uCEFTimerWorkScheduler.pas"/>
<UnitName Value="uCEFTimerWorkScheduler"/>
</Item202>
</Files>
<RequiredPkgs Count="5">
<Item1>

3
packages/cef4delphi_lazarus.pas
View File

@ -66,7 +66,8 @@ uses
uCEFPrintDialogCallback, uCEFPrintHandler, uCEFPrintJobCallback,
uCEFLinuxFunctions, uCEFLinuxTypes, uCEFLinuxConstants,
uCEFWorkSchedulerQueueThread, uCEFLinkedWinControlBase, uCEFLazarusCocoa,
uCEFBrowserWindow, uCEFOsrBrowserWindow, LazarusPackageIntf;
uCEFBrowserWindow, uCEFOsrBrowserWindow, uCEFTimerWorkScheduler,
LazarusPackageIntf;
implementation

158
source/uCEFMacOSCustomCocoaTimer.pas Normal file
View File

@ -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 <hgourvest@gmail.com>
* 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.

23
source/uCEFMacOSFunctions.pas
View File

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

82
source/uCEFMacOSInterfaces.pas Normal file
View File

@ -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 <hgourvest@gmail.com>
* 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.

351
source/uCEFTimerWorkScheduler.pas Normal file
View File

@ -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 <hgourvest@gmail.com>
* 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.

2
update_CEF4Delphi.json
View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 298,
"InternalVersion" : 299,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "90.6.7.0"
}