pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-05-13 21:46:53 +02:00
Code Issues Actions 1 Releases Activity

Improved keyboard and mouse support in FMXExternalPumpBrowser for MacOS

Browse Source 
Added X11 error handling functions to FMXExternalPumpBrowser2 demo for Linux.
Deleted FMXExternalPumpBrowser demo for Linux.
Added uCEFMacOSConstants and uCEFMacOSFunctions units for MacOS.
Replaced TThread.Queue for TThread.ForceQueue to avoid executing that method immediately in some cases.
This commit is contained in:
Salvador Díaz Fau 2021-05-26 19:32:10 +02:00
parent a22e1a07b1
commit 44896524e8
26 changed files with 726 additions and 3319 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
demos/Delphi_FMX_Linux/FMXExternalPumpBrowser/00-DeleteDCUs.bat
View File

@ -1,23 +0,0 @@
del /s /q *.
del /s /q *.o
del /s /q *.dcu
del /s /q *.exe
del /s /q *.res
del /s /q *.rsm
del /s /q *.log
del /s /q *.dsk
del /s /q *.identcache
del /s /q *.stat
del /s /q *.local
del /s /q *.~*
rmdir Win32\Debug
rmdir Win32\Release
rmdir Win32
rmdir Win64\Debug
rmdir Win64\Release
rmdir Win64
rmdir Linux64\Debug
rmdir Linux64\Release
rmdir Linux64
rmdir __history
rmdir __recovery

80
demos/Delphi_FMX_Linux/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dpr
View File

@ -1,80 +0,0 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 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 © 2018 Salvador Díaz 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.
*
*)
program FMXExternalPumpBrowser;
uses
// FMX initializes GTK in the initialization section of some of its units and
// that means that GTK is already initialized when the code in the DPR is
// executed.
// Chromium has to be initialized in a process with only one thread but GTK
// creates several threads during its initialization. To avoid this problem
// we have to initialize CEF before GTK.
// uCEFLoader *MUST* be the first unit in the DPR file to make sure Chromium
// is initialized before GTK.
// uCEFLoader *MUST NOT* make any reference to any FMX unit to keep the right
// initalization order.
// Read the answer to this question for more more information :
// https://stackoverflow.com/questions/52103407/changing-the-initialization-order-of-the-unit-in-delphi
uCEFLoader in 'uCEFLoader.pas',
System.StartUpCopy,
FMX.Forms,
uCEFApplication,
uCEFWorkScheduler,
uFMXExternalPumpBrowser in 'uFMXExternalPumpBrowser.pas' {FMXExternalPumpBrowserFrm};
{$R *.res}
begin
CreateGlobalCEFApp;
if GlobalCEFApp.StartMainProcess then
begin
{$IFDEF LINUX}InitializeGTK;{$ENDIF}
Application.Initialize;
Application.CreateForm(TFMXExternalPumpBrowserFrm, FMXExternalPumpBrowserFrm);
Application.Run;
// The form needs to be destroyed *BEFORE* stopping the work scheduler.
FMXExternalPumpBrowserFrm.Free;
GlobalCEFWorkScheduler.StopScheduler;
end;
DestroyGlobalCEFApp;
DestroyGlobalCEFWorkScheduler;
end.

1317
demos/Delphi_FMX_Linux/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dproj
View File

File diff suppressed because it is too large Load Diff

468
demos/Delphi_FMX_Linux/FMXExternalPumpBrowser/cef.inc
View File

@ -1,468 +0,0 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 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 © 2017 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.
*
*)
// The complete list of compiler versions is here :
// http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Compiler_Versions
{$DEFINE DELPHI_VERSION_UNKNOW}
// Delphi 5
{$IFDEF VER130}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$ENDIF}
// Delphi 6
{$IFDEF VER140}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$ENDIF}
// Delphi 7
{$IFDEF VER150}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$ENDIF}
// Delphi 8
{$IFDEF VER160}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$ENDIF}
// Delphi 2005
{$IFDEF VER170}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$ENDIF}
{$IFDEF VER180}
{$UNDEF DELPHI_VERSION_UNKNOW}
// Delphi 2007
{$IFDEF VER185}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
// Delphi 2006
{$ELSE}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$ENDIF}
{$ENDIF}
// Delphi 2009
{$IFDEF VER200}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$ENDIF}
//Delphi 2010
{$IFDEF VER210}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$ENDIF}
// Delphi XE
{$IFDEF VER220}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$ENDIF}
// Delphi XE2 (First FireMonkey and 64bit compiler)
{$IFDEF VER230}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$ENDIF}
// Delphi XE3
{$IFDEF VER240}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$ENDIF}
// Delphi XE4
{$IFDEF VER250}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$ENDIF}
// Delphi XE5
{$IFDEF VER260}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$ENDIF}
// Delphi XE6
{$IFDEF VER270}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$ENDIF}
// Delphi XE7
{$IFDEF VER280}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$ENDIF}
// Delphi XE8
{$IFDEF VER290}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$ENDIF VER290}
// Rad Studio 10 - Delphi Seattle
{$IFDEF VER300}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$ENDIF}
// Rad Studio 10.1 - Delphi Berlin
{$IFDEF VER310}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$ENDIF}
// Rad Studio 10.2 - Delphi Tokyo
{$IFDEF VER320}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$ENDIF}
// Rad Studio 10.3 - Delphi Rio
{$IFDEF VER330}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$DEFINE DELPHI26_UP}
{$ENDIF}
// Rad Studio 10.4 - Delphi Sydney
{$IFDEF VER340}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$DEFINE DELPHI26_UP}
{$DEFINE DELPHI27_UP}
{$ENDIF}
{$IFDEF FPC}
{$DEFINE SUPPORTS_INLINE}
{$IF DEFINED(FPC_FULLVERSION) AND (FPC_FULLVERSION >= 30200)}
{$DEFINE FPC_VER_320}
{$IFEND}
{$ELSE}
{$IFDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$DEFINE DELPHI26_UP}
{$DEFINE DELPHI27_UP}
{$ENDIF}
{$ENDIF}
{$IFDEF DELPHI9_UP}
{$DEFINE SUPPORTS_INLINE}
{$ENDIF}
{$IF DEFINED(CPUX32) OR
DEFINED(CPU386) OR
DEFINED(CPUi386) OR
DEFINED(CPUPOWERPC32) OR
DEFINED(CPUSPARC32) OR
DEFINED(CPU32BITS) OR
DEFINED(CPUARM32) OR
DEFINED(WIN32) OR
DEFINED(IOS32) OR
DEFINED(MACOS32) OR
DEFINED(LINUX32) OR
DEFINED(POSIX32) OR
DEFINED(ANDROID32)}
{$DEFINE TARGET_32BITS}
{$IFEND}
// Delphi uses MACOS for the new MacOSX and DARWIN is not defined
// FPC uses DARWIN for the new MacOSX and MACOS is defined for the classic Macintosh OS (System 7)
// We define MACOSX to avoid conflicts in both situations
{$IFDEF FPC}
{$IFDEF DARWIN}
{$DEFINE MACOSX}
{$ENDIF}
{$ELSE}
{$IFDEF MACOS}
{$DEFINE MACOSX}
{$ENDIF}
{$ENDIF}

100
demos/Delphi_FMX_Linux/FMXExternalPumpBrowser/uCEFLoader.pas
View File

@ -1,100 +0,0 @@
// ************************************************************************
// ***************************** 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 uCEFLoader;
interface
{$IFDEF LINUX}
uses
FMUX.Config;
procedure InitializeGTK;
{$ENDIF}
implementation
{$IFDEF LINUX}
uses
System.SysUtils, System.IOUtils;
function GetLibDirName: string;
begin
{$IFNDEF FMXLINUX_EXTERNAL_RUNTIME}
Result := TPath.Combine(TPath.GetHomePath, '.fmxlinux');
{$ELSE}
Result := ExtractFilePath(ParamStr(0));
{$ENDIF}
end;
function GetLibFileName: string;
const
LibName = 'libfmux';
LibVer = '1.60';
begin
{$IFDEF FMXLINUX_EXTERNAL_RUNTIME}
Result := TPath.Combine(GetLibDirName, LibName + '.so');
{$ELSE}
{$IFDEF TRIAL}
Result := TPath.Combine(GetLibDirName, LibName + '-Trial-' + LibVer + '.so');
{$ELSEIF GETIT}
Result := TPath.Combine(GetLibDirName, LibName + '-Getit' + LibVer + '.so');
{$ELSE}
Result := TPath.Combine(GetLibDirName, LibName + '-' + LibVer + '.so');
{$ENDIF}
{$ENDIF}
end;
procedure InitializeGTK;
var
FmuxInit: procedure (Flags: Integer); cdecl;
TempHandle : NativeInt;
begin
TempHandle := LoadLibrary(PChar(GetLibFileName));
if (TempHandle <> 0) then
begin
FmuxInit := GetProcAddress(TempHandle, 'FmuxInit');
FmuxInit(0);
end;
end;
initialization
DoNotCallFmuxInit := True;
{$ENDIF}
end.

141
demos/Delphi_FMX_Linux/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.fmx
View File

@ -1,141 +0,0 @@
object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
Left = 0
Top = 0
Caption = 'Initializing browser. Please wait...'
ClientHeight = 633
ClientWidth = 800
Position = ScreenCenter
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
OnActivate = FormActivate
OnCreate = FormCreate
OnCloseQuery = FormCloseQuery
OnDestroy = FormDestroy
OnShow = FormShow
OnHide = FormHide
DesignerMasterStyle = 0
object AddressPnl: TPanel
Align = Top
Padding.Left = 5.000000000000000000
Padding.Top = 5.000000000000000000
Padding.Right = 5.000000000000000000
Padding.Bottom = 5.000000000000000000
Size.Width = 800.000000000000000000
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
Position.X = 714.000000000000000000
Position.Y = 5.000000000000000000
Size.Width = 81.000000000000000000
Size.Height = 23.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
object GoBtn: TButton
Align = Left
Position.X = 5.000000000000000000
Size.Width = 36.000000000000000000
Size.Height = 23.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
Text = 'Go'
OnClick = GoBtnClick
OnEnter = GoBtnEnter
end
object SnapshotBtn: TButton
Align = Right
StyledSettings = [Style, FontColor]
Position.X = 45.000000000000000000
Size.Width = 36.000000000000000000
Size.Height = 23.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
Text = #181
TextSettings.Font.Family = 'Webdings'
TextSettings.Font.Size = 32.000000000000000000
OnClick = SnapshotBtnClick
OnEnter = SnapshotBtnEnter
end
end
end
object Timer1: TTimer
Enabled = False
Interval = 300
OnTimer = Timer1Timer
Left = 40
Top = 137
end
object SaveDialog1: TSaveDialog
DefaultExt = 'bmp'
Filter = 'Bitmap files (*.bmp)|*.BMP'
Title = 'Save snapshot'
Left = 40
Top = 201
end
object Panel1: TFMXBufferPanel
Align = Client
TabOrder = 0
CanFocus = True
Size.Width = 800.000000000000000000
Size.Height = 578.000000000000000000
Size.PlatformDefault = False
OnEnter = Panel1Enter
OnExit = Panel1Exit
OnResize = Panel1Resize
OnClick = Panel1Click
OnMouseDown = Panel1MouseDown
OnMouseMove = Panel1MouseMove
OnMouseUp = Panel1MouseUp
OnMouseLeave = Panel1MouseLeave
OnMouseWheel = Panel1MouseWheel
OnKeyDown = Panel1KeyDown
OnDialogKey = Panel1DialogKey
end
object StatusBar1: TStatusBar
Position.Y = 611.000000000000000000
ShowSizeGrip = True
Size.Width = 800.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 5
object StatusLbl: TLabel
Align = Client
Margins.Left = 5.000000000000000000
Margins.Right = 50.000000000000000000
Size.Width = 745.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
end
end
object chrmosr: TFMXChromium
OnLoadError = chrmosrLoadError
OnLoadingStateChange = chrmosrLoadingStateChange
OnTooltip = chrmosrTooltip
OnCursorChange = chrmosrCursorChange
OnBeforePopup = chrmosrBeforePopup
OnAfterCreated = chrmosrAfterCreated
OnBeforeClose = chrmosrBeforeClose
OnGetViewRect = chrmosrGetViewRect
OnGetScreenPoint = chrmosrGetScreenPoint
OnGetScreenInfo = chrmosrGetScreenInfo
OnPopupShow = chrmosrPopupShow
OnPopupSize = chrmosrPopupSize
OnPaint = chrmosrPaint
Left = 40
Top = 73
end
end

915
demos/Delphi_FMX_Linux/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas
View File

@ -1,915 +0,0 @@
// ************************************************************************
// ***************************** 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 uFMXExternalPumpBrowser;
{$I cef.inc}
interface
uses
{$IFDEF MSWINDOWS}WinApi.Windows,{$ENDIF}
System.Types, System.UITypes, System.Classes, System.SyncObjs,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Edit, FMX.StdCtrls,
FMX.Controls.Presentation, FMX.Graphics, FMX.Layouts, FMX.DialogService,
uCEFFMXChromium, uCEFFMXBufferPanel, uCEFFMXWorkScheduler,
uCEFInterfaces, uCEFTypes, uCEFConstants, uCEFChromiumCore;
type
TFMXExternalPumpBrowserFrm = class(TForm)
AddressPnl: TPanel;
AddressEdt: TEdit;
chrmosr: TFMXChromium;
Timer1: TTimer;
SaveDialog1: TSaveDialog;
Panel1: TFMXBufferPanel;
Layout1: TLayout;
GoBtn: TButton;
SnapshotBtn: TButton;
StatusBar1: TStatusBar;
StatusLbl: TLabel;
procedure GoBtnClick(Sender: TObject);
procedure GoBtnEnter(Sender: TObject);
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);
procedure Panel1MouseLeave(Sender: TObject);
procedure Panel1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
procedure Panel1KeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
procedure Panel1DialogKey(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure chrmosrPaint(Sender: TObject; const browser: ICefBrowser; type_: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; width, height: Integer);
procedure chrmosrGetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect);
procedure chrmosrGetScreenPoint(Sender: TObject; const browser: ICefBrowser; viewX, viewY: Integer; var screenX, screenY: Integer; out Result: Boolean);
procedure chrmosrGetScreenInfo(Sender: TObject; const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out Result: Boolean);
procedure chrmosrPopupShow(Sender: TObject; const browser: ICefBrowser; show: Boolean);
procedure chrmosrPopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect);
procedure chrmosrBeforeClose(Sender: TObject; const browser: ICefBrowser);
procedure chrmosrTooltip(Sender: TObject; const browser: ICefBrowser; var text: ustring; out Result: Boolean);
procedure chrmosrBeforePopup(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: Boolean; var Result: Boolean);
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 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 Timer1Timer(Sender: TObject);
procedure AddressEdtEnter(Sender: TObject);
procedure SnapshotBtnClick(Sender: TObject);
procedure SnapshotBtnEnter(Sender: TObject);
protected
FPopUpBitmap : TBitmap;
FPopUpRect : TRect;
FShowPopUp : boolean;
FResizing : boolean;
FPendingResize : boolean;
FCanClose : boolean;
FClosing : boolean;
FResizeCS : TCriticalSection;
{$IFDEF DELPHI17_UP}
FMouseWheelService : IFMXMouseService;
{$ENDIF}
procedure LoadURL;
function getModifiers(Shift: TShiftState): TCefEventFlags;
function GetButton(Button: TMouseButton): TCefMouseButtonType;
function GetMousePosition(var aPoint : TPointF) : boolean;
public
procedure DoResize;
procedure NotifyMoveOrResizeStarted;
procedure SendCaptureLostEvent;
procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
procedure SendCEFKeyEvent(const aCefEvent : TCefKeyEvent);
end;
var
FMXExternalPumpBrowserFrm : TFMXExternalPumpBrowserFrm;
procedure CreateGlobalCEFApp;
// ***************************
// ********* WARNING *********
// ***************************
// This is a demo for LINUX and it's in BETA 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.
// 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)
// This is the destruction sequence in OSR mode :
// 1- FormCloseQuery sets CanClose to the initial FCanClose value (False) and
// calls chrmosr.CloseBrowser(True).
// 2- chrmosr.CloseBrowser(True) will trigger chrmosr.OnClose and the default
// implementation will destroy the internal browser immediately, which will
// trigger the chrmosr.OnBeforeClose event.
// 3- chrmosr.OnBeforeClose sets FCanClose to True and enables the timer to
// close the form after a few milliseconds.
implementation
{$R *.fmx}
uses
System.SysUtils, System.Math, System.IOUtils,
FMX.Platform, {$IFDEF LINUX}FMX.Platform.Linux,{$ENDIF}
uCEFApplication, uCEFWorkScheduler, uCEFMiscFunctions, uCEFLinuxTypes,
uCEFLinuxConstants, uCEFLinuxFunctions;
{$IFDEF LINUX}
function GTKKeyPress(Widget: PGtkWidget; Event: PGdkEventKey; Data: gPointer) : GBoolean; cdecl;
var
TempCefEvent : TCefKeyEvent;
begin
if FMXExternalPumpBrowserFrm.Panel1.IsFocused then
begin
GdkEventKeyToCEFKeyEvent(Event, TempCefEvent);
if (Event^._type = GDK_KEY_PRESS) then
begin
TempCefEvent.kind := KEYEVENT_RAWKEYDOWN;
FMXExternalPumpBrowserFrm.SendCEFKeyEvent(TempCefEvent);
TempCefEvent.kind := KEYEVENT_CHAR;
FMXExternalPumpBrowserFrm.SendCEFKeyEvent(TempCefEvent);
end
else
begin
TempCefEvent.kind := KEYEVENT_KEYUP;
FMXExternalPumpBrowserFrm.SendCEFKeyEvent(TempCefEvent);
end;
end;
Result := True;
end;
procedure ConnectKeyPressReleaseEvents(const aWidget : PGtkWidget);
begin
g_signal_connect(aWidget, 'key-press-event', TGCallback(@GTKKeyPress), nil);
g_signal_connect(aWidget, 'key-release-event', TGCallback(@GTKKeyPress), nil);
end;
{$ENDIF}
procedure GlobalCEFApp_OnScheduleMessagePumpWork(const aDelayMS : int64);
begin
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.
// 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;
GlobalCEFApp.ExternalMessagePump := True;
GlobalCEFApp.MultiThreadedMessageLoop := False;
GlobalCEFApp.DisableZygote := True;
GlobalCEFApp.OnScheduleMessagePumpWork := GlobalCEFApp_OnScheduleMessagePumpWork;
// You can deploy the CEF binaries with the executable or you can set these
// properties to use the CEF binaries in your home directory
GlobalCEFApp.FrameworkDirPath := TPath.GetHomePath + TPath.DirectorySeparatorChar + 'cef';
GlobalCEFApp.ResourcesDirPath := GlobalCEFApp.FrameworkDirPath;
GlobalCEFApp.LocalesDirPath := GlobalCEFApp.FrameworkDirPath + TPath.DirectorySeparatorChar + 'locales';
// This is a workaround to fix a Chromium initialization crash.
// The current FMX solution to initialize CEF with a loader unit
// creates a race condition with the media key controller in Chromium.
GlobalCEFApp.DisableFeatures := 'HardwareMediaKeyHandling';
end;
procedure TFMXExternalPumpBrowserFrm.FormActivate(Sender: TObject);
var
TempError : string;
begin
if not(FCanClose) and ((GlobalCEFApp = nil) or not(GlobalCEFApp.LibLoaded)) then
begin
FCanClose := True;
FClosing := True;
TempError := 'CEF binaries missing!';
if (GlobalCEFApp = nil) then
TempError := TempError + CRLF + CRLF + 'GlobalCEFApp was not created!'
else
if (length(GlobalCEFApp.MissingLibFiles) > 0) then
TempError := TempError + CRLF + CRLF +
'The missing files are :' + CRLF +
trim(GlobalCEFApp.MissingLibFiles);
TDialogService.MessageDialog(TempError, TMsgDlgType.mtError,
[TMsgDlgBtn.mbOK], TMsgDlgBtn.mbOK, 0,
procedure(const AResult: TModalResult)
begin
Timer1.Enabled := True;
end);
end
else
if not(chrmosr.Initialized) then
begin
{$IFDEF LINUX}
ConnectKeyPressReleaseEvents(TLinuxWindowHandle(Handle).NativeHandle);
{$ENDIF}
// opaque white background color
chrmosr.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF);
if not(chrmosr.CreateBrowser) then Timer1.Enabled := True;
end;
end;
procedure TFMXExternalPumpBrowserFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := FCanClose;
if not(FClosing) then
begin
FClosing := True;
Visible := False;
AddressPnl.Enabled := False;
chrmosr.CloseBrowser(True);
end;
end;
procedure TFMXExternalPumpBrowserFrm.FormCreate(Sender: TObject);
begin
FPopUpBitmap := nil;
FPopUpRect := rect(0, 0, 0, 0);
FShowPopUp := False;
FResizing := False;
FPendingResize := False;
FCanClose := False;
FClosing := False;
FResizeCS := TCriticalSection.Create;
chrmosr.DefaultURL := AddressEdt.Text;
{$IFDEF DELPHI17_UP}
if TPlatformServices.Current.SupportsPlatformService(IFMXMouseService) then
FMouseWheelService := TPlatformServices.Current.GetPlatformService(IFMXMouseService) as IFMXMouseService;
{$ENDIF}
end;
procedure TFMXExternalPumpBrowserFrm.FormDestroy(Sender: TObject);
begin
FResizeCS.Free;
if (FPopUpBitmap <> nil) then FreeAndNil(FPopUpBitmap);
end;
procedure TFMXExternalPumpBrowserFrm.FormHide(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
chrmosr.WasHidden(True);
end;
procedure TFMXExternalPumpBrowserFrm.FormShow(Sender: TObject);
begin
chrmosr.WasHidden(False);
chrmosr.SendFocusEvent(True);
end;
procedure TFMXExternalPumpBrowserFrm.GoBtnClick(Sender: TObject);
begin
LoadURL;
end;
procedure TFMXExternalPumpBrowserFrm.LoadURL;
begin
FResizeCS.Acquire;
FResizing := False;
FPendingResize := False;
FResizeCS.Release;
chrmosr.LoadURL(AddressEdt.Text);
end;
procedure TFMXExternalPumpBrowserFrm.GoBtnEnter(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
end;
procedure TFMXExternalPumpBrowserFrm.Panel1Click(Sender: TObject);
begin
Panel1.SetFocus;
end;
procedure TFMXExternalPumpBrowserFrm.Panel1DialogKey(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
if (Key = vkTab) then Key := 0;
end;
procedure TFMXExternalPumpBrowserFrm.Panel1Enter(Sender: TObject);
begin
chrmosr.SendFocusEvent(True);
end;
procedure TFMXExternalPumpBrowserFrm.Panel1Exit(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
end;
procedure TFMXExternalPumpBrowserFrm.Panel1KeyDown( Sender : TObject;
var Key : Word;
var KeyChar : Char;
Shift : TShiftState);
var
TempKeyEvent : TCefKeyEvent;
begin
if not(Panel1.IsFocused) then exit;
if (Key = 0) and (KeyChar <> #0) then
begin
TempKeyEvent.kind := KEYEVENT_CHAR;
TempKeyEvent.modifiers := getModifiers(Shift);
TempKeyEvent.windows_key_code := ord(KeyChar);
TempKeyEvent.native_key_code := 0;
TempKeyEvent.is_system_key := ord(False);
TempKeyEvent.character := #0;
TempKeyEvent.unmodified_character := #0;
TempKeyEvent.focus_on_editable_field := ord(False);
chrmosr.SendKeyEvent(@TempKeyEvent);
end
else
if (Key <> 0) and (KeyChar = #0) and
(Key in [vkLeft, vkRight, vkUp, vkDown]) then
Key := 0;
end;
procedure TFMXExternalPumpBrowserFrm.Panel1MouseDown(Sender : TObject;
Button : TMouseButton;
Shift : TShiftState;
X, Y : Single);
var
TempEvent : TCefMouseEvent;
begin
if not(ssTouch in Shift) then
begin
Panel1.SetFocus;
TempEvent.x := round(X);
TempEvent.y := round(Y);
TempEvent.modifiers := getModifiers(Shift);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, 1);
end;
end;
function TFMXExternalPumpBrowserFrm.GetMousePosition(var aPoint : TPointF) : boolean;
begin
if (FMouseWheelService <> nil) then
begin
aPoint := FMouseWheelService.GetMousePos;
Result := True;
end
else
begin
aPoint.x := 0;
aPoint.y := 0;
Result := False;
end;
end;
procedure TFMXExternalPumpBrowserFrm.Panel1MouseLeave(Sender: TObject);
var
TempEvent : TCefMouseEvent;
TempPoint : TPointF;
begin
if GetMousePosition(TempPoint) then
begin
TempPoint := Panel1.ScreenToClient(TempPoint);
TempEvent.x := round(TempPoint.x);
TempEvent.y := round(TempPoint.y);
TempEvent.modifiers := EVENTFLAG_NONE;
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
end;
procedure TFMXExternalPumpBrowserFrm.Panel1MouseMove(Sender : TObject;
Shift : TShiftState;
X, Y : Single);
var
TempEvent : TCefMouseEvent;
begin
if not(ssTouch in Shift) then
begin
TempEvent.x := round(x);
TempEvent.y := round(y);
TempEvent.modifiers := getModifiers(Shift);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
end;
procedure TFMXExternalPumpBrowserFrm.Panel1MouseUp(Sender : TObject;
Button : TMouseButton;
Shift : TShiftState;
X, Y : Single);
var
TempEvent : TCefMouseEvent;
begin
if not(ssTouch in Shift) then
begin
TempEvent.x := round(X);
TempEvent.y := round(Y);
TempEvent.modifiers := getModifiers(Shift);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, 1);
end;
end;
procedure TFMXExternalPumpBrowserFrm.Panel1MouseWheel( Sender : TObject;
Shift : TShiftState;
WheelDelta : Integer;
var Handled : Boolean);
var
TempEvent : TCefMouseEvent;
TempPoint : TPointF;
begin
if Panel1.IsFocused and GetMousePosition(TempPoint) then
begin
TempPoint := Panel1.ScreenToClient(TempPoint);
TempEvent.x := round(TempPoint.x);
TempEvent.y := round(TempPoint.y);
TempEvent.modifiers := getModifiers(Shift);
chrmosr.SendMouseWheelEvent(@TempEvent, 0, WheelDelta);
end;
end;
procedure TFMXExternalPumpBrowserFrm.Panel1Resize(Sender: TObject);
begin
DoResize;
end;
procedure TFMXExternalPumpBrowserFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if FClosing then
close
else
if not(chrmosr.CreateBrowser) and not(chrmosr.Initialized) then
Timer1.Enabled := True;
end;
procedure TFMXExternalPumpBrowserFrm.AddressEdtEnter(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrAfterCreated(Sender: TObject; const browser: ICefBrowser);
begin
// Now the browser is fully initialized we can enable the UI.
Caption := 'FMX External Pump Browser';
AddressPnl.Enabled := True;
Panel1.SetFocus;
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrBeforeClose(Sender: TObject; const browser: ICefBrowser);
begin
FCanClose := True;
// We need to close the form outside this event so we use the timer
Timer1.Enabled := True;
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrBeforePopup( Sender : TObject;
const browser : ICefBrowser;
const frame : ICefFrame;
const targetUrl : ustring;
const targetFrameName : ustring;
targetDisposition : TCefWindowOpenDisposition;
userGesture : Boolean;
const popupFeatures : TCefPopupFeatures;
var windowInfo : TCefWindowInfo;
var client : ICefClient;
var settings : TCefBrowserSettings;
var extra_info : ICefDictionaryValue;
var noJavascriptAccess : Boolean;
var Result : Boolean);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrCursorChange( Sender : TObject;
const browser : ICefBrowser;
cursor_ : TCefCursorHandle;
cursorType : TCefCursorType;
const customCursorInfo : PCefCursorInfo;
var aResult : Boolean);
begin
Panel1.Cursor := CefCursorToWindowsCursor(cursorType);
aResult := True;
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrGetScreenInfo( Sender : TObject;
const browser : ICefBrowser;
var screenInfo : TCefScreenInfo;
out Result : Boolean);
var
TempRect : TCEFRect;
begin
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := round(Panel1.Width);
TempRect.height := round(Panel1.Height);
screenInfo.device_scale_factor := Panel1.ScreenScale;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
Result := True;
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrGetScreenPoint( Sender : TObject;
const browser : ICefBrowser;
viewX : Integer;
viewY : Integer;
var screenX : Integer;
var screenY : Integer;
out Result : Boolean);
var
TempScreenPt, TempViewPt : TPoint;
begin
// TFMXBufferPanel.ClientToScreen applies the scale factor. No need to call LogicalToDevice to set TempViewPt.
TempViewPt.x := viewX;
TempViewPt.y := viewY;
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrGetViewRect( Sender : TObject;
const browser : ICefBrowser;
var rect : TCefRect);
begin
rect.x := 0;
rect.y := 0;
rect.width := round(Panel1.Width);
rect.height := round(Panel1.Height);
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrLoadError(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer;
const errorText, failedUrl: ustring);
var
TempString : ustring;
begin
if (errorCode = ERR_ABORTED) then exit;
TempString := '<html><body bgcolor="white">' +
'<h2>Failed to load URL ' + failedUrl +
' with error ' + errorText +
' (' + inttostr(errorCode) + ').</h2></body></html>';
chrmosr.LoadString(TempString, frame);
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrLoadingStateChange(Sender: TObject;
const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
begin
if isLoading then
StatusLbl.Text := 'Loading...'
else
StatusLbl.Text := '';
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrPaint( Sender : TObject;
const browser : ICefBrowser;
type_ : TCefPaintElementType;
dirtyRectsCount : NativeUInt;
const dirtyRects : PCefRectArray;
const buffer : Pointer;
width : Integer;
height : Integer);
var
src, dst: PByte;
i, j, TempLineSize, TempSrcOffset, TempDstOffset, SrcStride, TempWidth, TempHeight : Integer;
n : NativeUInt;
{$IFNDEF DELPHI17_UP}
TempScanlineSize, DstStride : integer;
{$ENDIF}
TempBufferBits : Pointer;
TempForcedResize : boolean;
TempBitmapData : TBitmapData;
TempBitmap : TBitmap;
TempSrcRect, TempDstRect : TRectF;
begin
try
FResizeCS.Acquire;
TempForcedResize := False;
if Panel1.BeginBufferDraw then
try
if (type_ = PET_POPUP) then
begin
if (FPopUpBitmap = nil) or
(width <> FPopUpBitmap.Width) or
(height <> FPopUpBitmap.Height) then
begin
if (FPopUpBitmap <> nil) then FPopUpBitmap.Free;
FPopUpBitmap := TBitmap.Create(width, height);
{$IFDEF DELPHI17_UP}
FPopUpBitmap.BitmapScale := Panel1.ScreenScale;
{$ENDIF}
end;
TempWidth := FPopUpBitmap.Width;
TempHeight := FPopUpBitmap.Height;
{$IFNDEF DELPHI17_UP}
TempScanlineSize := FPopUpBitmap.BytesPerLine;
{$ENDIF}
TempBitmap := FPopUpBitmap;
end
else
begin
TempForcedResize := Panel1.UpdateBufferDimensions(Width, Height) or not(Panel1.BufferIsResized(False));
TempWidth := Panel1.BufferWidth;
TempHeight := Panel1.BufferHeight;
{$IFNDEF DELPHI17_UP}
TempScanlineSize := Panel1.ScanlineSize;
{$ENDIF}
TempBitmap := Panel1.Buffer;
end;
if (TempBitmap <> nil) {$IFDEF DELPHI17_UP}and TempBitmap.Map(TMapAccess.ReadWrite, TempBitmapData){$ENDIF} then
begin
try
{$IFNDEF DELPHI17_UP}
TempBufferBits := TempBitmapData.StartLine;
DstStride := TempScanlineSize;
{$ENDIF}
SrcStride := Width * SizeOf(TRGBQuad);
n := 0;
while (n < dirtyRectsCount) do
begin
if (dirtyRects[n].x >= 0) and (dirtyRects[n].y >= 0) then
begin
TempLineSize := min(dirtyRects[n].width, TempWidth - dirtyRects[n].x) * SizeOf(TRGBQuad);
if (TempLineSize > 0) then
begin
TempSrcOffset := ((dirtyRects[n].y * Width) + dirtyRects[n].x) * SizeOf(TRGBQuad);
{$IFDEF DELPHI17_UP}
TempDstOffset := (dirtyRects[n].x * SizeOf(TRGBQuad));
{$ELSE}
TempDstOffset := (dirtyRects[n].y * TempScanlineSize) + (dirtyRects[n].x * SizeOf(TRGBQuad));
{$ENDIF}
src := @PByte(buffer)[TempSrcOffset];
{$IFNDEF DELPHI17_UP}
dst := @PByte(TempBufferBits)[TempDstOffset];
{$ENDIF}
i := 0;
j := min(dirtyRects[n].height, TempHeight - dirtyRects[n].y);
while (i < j) do
begin
{$IFDEF DELPHI17_UP}
TempBufferBits := TempBitmapData.GetScanline(dirtyRects[n].y + i);
dst := @PByte(TempBufferBits)[TempDstOffset];
{$ENDIF}
Move(src^, dst^, TempLineSize);
{$IFNDEF DELPHI17_UP}
inc(dst, DstStride);
{$ENDIF}
inc(src, SrcStride);
inc(i);
end;
end;
end;
inc(n);
end;
Panel1.InvalidatePanel;
finally
{$IFDEF DELPHI17_UP}
TempBitmap.Unmap(TempBitmapData);
{$ENDIF}
end;
if FShowPopup and (FPopUpBitmap <> nil) then
begin
TempSrcRect := RectF(0, 0,
min(FPopUpRect.Width, FPopUpBitmap.Width),
min(FPopUpRect.Height, FPopUpBitmap.Height));
TempDstRect.Left := FPopUpRect.Left / GlobalCEFApp.DeviceScaleFactor;
TempDstRect.Top := FPopUpRect.Top / GlobalCEFApp.DeviceScaleFactor;
TempDstRect.Right := TempDstRect.Left + (TempSrcRect.Width / GlobalCEFApp.DeviceScaleFactor);
TempDstRect.Bottom := TempDstRect.Top + (TempSrcRect.Height / GlobalCEFApp.DeviceScaleFactor);
Panel1.BufferDraw(FPopUpBitmap, TempSrcRect, TempDstRect);
end;
end;
if (type_ = PET_VIEW) then
begin
if TempForcedResize or FPendingResize then
TThread.Queue(nil, DoResize);
FResizing := False;
FPendingResize := False;
end;
finally
Panel1.EndBufferDraw;
end;
finally
FResizeCS.Release;
end;
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrPopupShow( Sender : TObject;
const browser : ICefBrowser;
show : Boolean);
begin
if show then
FShowPopUp := True
else
begin
FShowPopUp := False;
FPopUpRect := rect(0, 0, 0, 0);
chrmosr.Invalidate(PET_VIEW);
end;
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrPopupSize( Sender : TObject;
const browser : ICefBrowser;
const rect : PCefRect);
begin
if (GlobalCEFApp <> nil) then
begin
LogicalToDevice(rect^, GlobalCEFApp.DeviceScaleFactor);
FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1;
end;
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrTooltip( Sender : TObject;
const browser : ICefBrowser;
var text : ustring;
out Result : Boolean);
begin
Panel1.Hint := text;
Panel1.ShowHint := (length(text) > 0);
Result := True;
end;
procedure TFMXExternalPumpBrowserFrm.DoResize;
begin
try
if (FResizeCS <> nil) then
begin
FResizeCS.Acquire;
if FResizing then
FPendingResize := True
else
if Panel1.BufferIsResized then
chrmosr.Invalidate(PET_VIEW)
else
begin
FResizing := True;
chrmosr.WasResized;
end;
end;
finally
if (FResizeCS <> nil) then FResizeCS.Release;
end;
end;
procedure TFMXExternalPumpBrowserFrm.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
PositionChanged: Boolean;
begin
PositionChanged := (ALeft <> Left) or (ATop <> Top);
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if PositionChanged then NotifyMoveOrResizeStarted;
end;
procedure TFMXExternalPumpBrowserFrm.SendCEFKeyEvent(const aCefEvent : TCefKeyEvent);
begin
chrmosr.SendKeyEvent(@aCefEvent);
end;
procedure TFMXExternalPumpBrowserFrm.NotifyMoveOrResizeStarted;
begin
if (chrmosr <> nil) then chrmosr.NotifyMoveOrResizeStarted;
end;
procedure TFMXExternalPumpBrowserFrm.SendCaptureLostEvent;
begin
if (chrmosr <> nil) then chrmosr.SendCaptureLostEvent;
end;
function TFMXExternalPumpBrowserFrm.getModifiers(Shift: TShiftState): TCefEventFlags;
begin
Result := EVENTFLAG_NONE;
if (ssShift in Shift) then Result := Result or EVENTFLAG_SHIFT_DOWN;
if (ssAlt in Shift) then Result := Result or EVENTFLAG_ALT_DOWN;
if (ssCtrl in Shift) then Result := Result or EVENTFLAG_CONTROL_DOWN;
if (ssLeft in Shift) then Result := Result or EVENTFLAG_LEFT_MOUSE_BUTTON;
if (ssRight in Shift) then Result := Result or EVENTFLAG_RIGHT_MOUSE_BUTTON;
if (ssMiddle in Shift) then Result := Result or EVENTFLAG_MIDDLE_MOUSE_BUTTON;
end;
function TFMXExternalPumpBrowserFrm.GetButton(Button: TMouseButton): TCefMouseButtonType;
begin
case Button of
TMouseButton.mbRight : Result := MBT_RIGHT;
TMouseButton.mbMiddle : Result := MBT_MIDDLE;
else Result := MBT_LEFT;
end;
end;
procedure TFMXExternalPumpBrowserFrm.SnapshotBtnClick(Sender: TObject);
begin
if SaveDialog1.Execute then Panel1.SaveToFile(SaveDialog1.FileName);
end;
procedure TFMXExternalPumpBrowserFrm.SnapshotBtnEnter(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
end;
end.

9
demos/Delphi_FMX_Linux/FMXExternalPumpBrowser2/FMXExternalPumpBrowser2_sp.dpr
View File

@ -43,7 +43,7 @@ program FMXExternalPumpBrowser2_sp;
uses
System.IOUtils,
uCEFApplicationCore;
uCEFApplicationCore, uCEFConstants;
begin
GlobalCEFApp := TCefApplicationCore.Create;
@ -52,12 +52,19 @@ begin
GlobalCEFApp.ExternalMessagePump := True;
GlobalCEFApp.MultiThreadedMessageLoop := False;
// Use these settings if you already have the CEF binaries in a directory called "cef" inside your home directory.
// You can also use the "Deployment" window but debugging might be slower.
GlobalCEFApp.FrameworkDirPath := TPath.GetHomePath + TPath.DirectorySeparatorChar + 'cef';
GlobalCEFApp.ResourcesDirPath := GlobalCEFApp.FrameworkDirPath;
GlobalCEFApp.LocalesDirPath := GlobalCEFApp.FrameworkDirPath + TPath.DirectorySeparatorChar + 'locales';
GlobalCEFApp.cache := GlobalCEFApp.FrameworkDirPath + TPath.DirectorySeparatorChar + 'cache';
GlobalCEFApp.UserDataPath := GlobalCEFApp.FrameworkDirPath + TPath.DirectorySeparatorChar + 'User Data';
{$IFDEF DEBUG}
GlobalCEFApp.LogFile := TPath.GetHomePath + TPath.DirectorySeparatorChar + 'debug.log';
GlobalCEFApp.LogSeverity := LOGSEVERITY_INFO;
{$ENDIF}
// This is a workaround to fix a Chromium initialization crash.
// The current FMX solution to initialize CEF with a loader unit
// creates a race condition with the media key controller in Chromium.

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

@ -48,10 +48,21 @@ 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;
uCEFApplication, uCEFConstants, uCEFWorkScheduler, uCEFLinuxFunctions,
uCEFLinuxTypes;
implementation
function CustomX11ErrorHandler(Display:PDisplay; ErrorEv:PXErrorEvent):longint;cdecl;
begin
Result := 0;
end;
function CustomXIOErrorHandler(Display:PDisplay):longint;cdecl;
begin
Result := 0;
end;
procedure GlobalCEFApp_OnScheduleMessagePumpWork(const aDelayMS : int64);
begin
if (GlobalCEFWorkScheduler <> nil) then
@ -76,6 +87,8 @@ begin
GlobalCEFApp.DisableZygote := True;
GlobalCEFApp.OnScheduleMessagePumpWork := GlobalCEFApp_OnScheduleMessagePumpWork;
// Use these settings if you already have the CEF binaries in a directory called "cef" inside your home directory.
// You can also use the "Deployment" window but debugging might be slower.
GlobalCEFApp.FrameworkDirPath := TPath.GetHomePath + TPath.DirectorySeparatorChar + 'cef';
GlobalCEFApp.ResourcesDirPath := GlobalCEFApp.FrameworkDirPath;
GlobalCEFApp.LocalesDirPath := GlobalCEFApp.FrameworkDirPath + TPath.DirectorySeparatorChar + 'locales';
@ -83,6 +96,11 @@ begin
GlobalCEFApp.UserDataPath := GlobalCEFApp.FrameworkDirPath + TPath.DirectorySeparatorChar + 'User Data';
GlobalCEFApp.BrowserSubprocessPath := GlobalCEFApp.FrameworkDirPath + TPath.DirectorySeparatorChar + 'FMXExternalPumpBrowser2_sp';
{$IFDEF DEBUG}
GlobalCEFApp.LogFile := TPath.GetHomePath + TPath.DirectorySeparatorChar + 'debug.log';
GlobalCEFApp.LogSeverity := LOGSEVERITY_INFO;
{$ENDIF}
// This is a workaround to fix a Chromium initialization crash.
// The current FMX solution to initialize CEF with a loader unit
// creates a race condition with the media key controller in Chromium.
@ -90,6 +108,11 @@ begin
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.
XSetErrorHandler(@CustomX11ErrorHandler);
XSetIOErrorHandler(@CustomXIOErrorHandler);
end;
initialization

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

@ -17,6 +17,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
DesignerMasterStyle = 0
object AddressPnl: TPanel
Align = Top
Enabled = False
Padding.Left = 5.000000000000000000
Padding.Top = 5.000000000000000000
Padding.Right = 5.000000000000000000
@ -24,7 +25,8 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
Size.Width = 800.000000000000000000
Size.Height = 33.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
TabOrder = 0
TabStop = False
object AddressEdt: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
Align = Client
@ -43,7 +45,8 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
Size.Width = 81.000000000000000000
Size.Height = 23.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
TabOrder = 1
TabStop = False
object GoBtn: TButton
Align = Left
Position.X = 5.000000000000000000
@ -87,7 +90,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
end
object Panel1: TFMXBufferPanel
Align = Client
TabOrder = 0
TabOrder = 1
CanFocus = True
Size.Width = 800.000000000000000000
Size.Height = 578.000000000000000000
@ -101,8 +104,6 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
OnMouseUp = Panel1MouseUp
OnMouseLeave = Panel1MouseLeave
OnMouseWheel = Panel1MouseWheel
OnKeyDown = Panel1KeyDown
OnDialogKey = Panel1DialogKey
end
object StatusBar1: TStatusBar
Position.Y = 611.000000000000000000

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

@ -34,9 +34,7 @@
* this source code without explicit permission.
*
*)
unit uFMXExternalPumpBrowser2;
{$I cef.inc}
interface
@ -74,8 +72,6 @@ type
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
procedure Panel1MouseLeave(Sender: TObject);
procedure Panel1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
procedure Panel1KeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
procedure Panel1DialogKey(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
@ -121,7 +117,6 @@ type
function getModifiers(Shift: TShiftState): TCefEventFlags;
function GetButton(Button: TMouseButton): TCefMouseButtonType;
function GetMousePosition(var aPoint : TPointF) : boolean;
public
procedure DoResize;
procedure NotifyMoveOrResizeStarted;
@ -136,11 +131,9 @@ var
// ***************************
// ********* WARNING *********
// ***************************
// This is a demo for LINUX and it's in BETA state.
// 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.
@ -187,9 +180,11 @@ begin
TempCefEvent.kind := KEYEVENT_KEYUP;
FMXExternalPumpBrowserFrm.SendCEFKeyEvent(TempCefEvent);
end;
end;
Result := True;
Result := True;
end
else
Result := False;
end;
procedure ConnectKeyPressReleaseEvents(const aWidget : PGtkWidget);
@ -231,7 +226,8 @@ begin
// opaque white background color
chrmosr.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF);
if not(chrmosr.CreateBrowser) then Timer1.Enabled := True;
if not(chrmosr.CreateBrowser) then
Timer1.Enabled := True;
end;
end;
@ -302,7 +298,7 @@ end;
procedure TFMXExternalPumpBrowserFrm.GoBtnEnter(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
if (chrmosr <> nil) then chrmosr.SendFocusEvent(False);
end;
procedure TFMXExternalPumpBrowserFrm.Panel1Click(Sender: TObject);
@ -310,48 +306,14 @@ begin
Panel1.SetFocus;
end;
procedure TFMXExternalPumpBrowserFrm.Panel1DialogKey(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
if (Key = vkTab) then Key := 0;
end;
procedure TFMXExternalPumpBrowserFrm.Panel1Enter(Sender: TObject);
begin
chrmosr.SendFocusEvent(True);
if (chrmosr <> nil) then chrmosr.SendFocusEvent(True);
end;
procedure TFMXExternalPumpBrowserFrm.Panel1Exit(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
end;
procedure TFMXExternalPumpBrowserFrm.Panel1KeyDown( Sender : TObject;
var Key : Word;
var KeyChar : Char;
Shift : TShiftState);
var
TempKeyEvent : TCefKeyEvent;
begin
if not(Panel1.IsFocused) then exit;
if (Key = 0) and (KeyChar <> #0) then
begin
TempKeyEvent.kind := KEYEVENT_CHAR;
TempKeyEvent.modifiers := getModifiers(Shift);
TempKeyEvent.windows_key_code := ord(KeyChar);
TempKeyEvent.native_key_code := 0;
TempKeyEvent.is_system_key := ord(False);
TempKeyEvent.character := #0;
TempKeyEvent.unmodified_character := #0;
TempKeyEvent.focus_on_editable_field := ord(False);
chrmosr.SendKeyEvent(@TempKeyEvent);
end
else
if (Key <> 0) and (KeyChar = #0) and
(Key in [vkLeft, vkRight, vkUp, vkDown]) then
Key := 0;
if (chrmosr <> nil) then chrmosr.SendFocusEvent(False);
end;
procedure TFMXExternalPumpBrowserFrm.Panel1MouseDown(Sender : TObject;
@ -374,12 +336,14 @@ end;
function TFMXExternalPumpBrowserFrm.GetMousePosition(var aPoint : TPointF) : boolean;
begin
{$IFDEF DELPHI17_UP}
if (FMouseWheelService <> nil) then
begin
aPoint := FMouseWheelService.GetMousePos;
Result := True;
end
else
{$ENDIF}
begin
aPoint.x := 0;
aPoint.y := 0;
@ -464,13 +428,14 @@ begin
if FClosing then
close
else
if not(chrmosr.CreateBrowser) and not(chrmosr.Initialized) then
if not(chrmosr.CreateBrowser) then
Timer1.Enabled := True;
end;
procedure TFMXExternalPumpBrowserFrm.AddressEdtEnter(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
if (chrmosr <> nil) then
chrmosr.SendFocusEvent(False);
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrAfterCreated(Sender: TObject; const browser: ICefBrowser);
@ -478,14 +443,15 @@ begin
// Now the browser is fully initialized we can enable the UI.
Caption := 'FMX External Pump Browser 2';
AddressPnl.Enabled := True;
Panel1.SetFocus;
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrBeforeClose(Sender: TObject; const browser: ICefBrowser);
begin
FCanClose := True;
// We need to close the form outside this event so we use the timer
Timer1.Enabled := True;
TThread.ForceQueue(nil, procedure
begin
close;
end);
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrBeforePopup( Sender : TObject;
@ -569,13 +535,17 @@ begin
rect.height := round(Panel1.Height);
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrLoadError(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer;
const errorText, failedUrl: ustring);
procedure TFMXExternalPumpBrowserFrm.chrmosrLoadError( Sender : TObject;
const browser : ICefBrowser;
const frame : ICefFrame;
errorCode : Integer;
const errorText : ustring;
const failedUrl : ustring);
var
TempString : ustring;
begin
if (errorCode = ERR_ABORTED) then exit;
if (errorCode = ERR_ABORTED) then
exit;
TempString := '<html><body bgcolor="white">' +
'<h2>Failed to load URL ' + failedUrl +
@ -585,8 +555,11 @@ begin
chrmosr.LoadString(TempString, frame);
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrLoadingStateChange(Sender: TObject;
const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean);
procedure TFMXExternalPumpBrowserFrm.chrmosrLoadingStateChange( Sender : TObject;
const browser : ICefBrowser;
isLoading : Boolean;
canGoBack : Boolean;
canGoForward : Boolean);
begin
if isLoading then
StatusLbl.Text := 'Loading...'
@ -735,7 +708,7 @@ begin
if (type_ = PET_VIEW) then
begin
if TempForcedResize or FPendingResize then
TThread.Queue(nil, DoResize);
TThread.ForceQueue(nil, DoResize);
FResizing := False;
FPendingResize := False;
@ -790,6 +763,9 @@ end;
procedure TFMXExternalPumpBrowserFrm.DoResize;
begin
if (chrmosr = nil) or not(chrmosr.Initialized) then
exit;
try
if (FResizeCS <> nil) then
begin

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

@ -46,9 +46,9 @@ uses
FMX.Forms,
uCEFApplication,
uCEFFMXWorkScheduler,
uCEFMacOSFunctions,
uFMXExternalPumpBrowser in 'uFMXExternalPumpBrowser.pas' {FMXExternalPumpBrowserFrm},
uFMXApplicationService in 'uFMXApplicationService.pas',
uFMXMiscFunctions in 'uFMXMiscFunctions.pas';
uFMXApplicationService in 'uFMXApplicationService.pas';
{$R *.res}

1
demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dproj
View File

@ -160,7 +160,6 @@
<Form>FMXExternalPumpBrowserFrm</Form>
</DCCReference>
<DCCReference Include="uFMXApplicationService.pas"/>
<DCCReference Include="uFMXMiscFunctions.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

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

@ -93,7 +93,6 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
Size.Width = 800.000000000000000000
Size.Height = 600.000000000000000000
Size.PlatformDefault = False
OnResized = Panel1Resize
OnEnter = Panel1Enter
OnExit = Panel1Exit
OnResize = Panel1Resize
@ -107,6 +106,58 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
OnKeyDown = Panel1KeyDown
OnDialogKey = Panel1DialogKey
end
object MainMenu1: TMainMenu
Left = 40
Top = 273
object EditMenu: TMenuItem
Text = 'Edit'
object UndoMenuItem: TMenuItem
Locked = True
ShortCut = 4186
Text = 'Undo'
OnClick = UndoMenuItemClick
end
object RedoMenuItem: TMenuItem
Locked = True
ShortCut = 12378
Text = 'Redo'
OnClick = RedoMenuItemClick
end
object SeparatorMenuItem: TMenuItem
Locked = True
Text = '-'
end
object CutMenuItem: TMenuItem
Locked = True
ShortCut = 4184
Text = 'Cut'
OnClick = CutMenuItemClick
end
object CopyMenuItem: TMenuItem
Locked = True
ShortCut = 4163
Text = 'Copy'
OnClick = CopyMenuItemClick
end
object PasteMenuItem: TMenuItem
Locked = True
ShortCut = 4182
Text = 'Paste'
OnClick = PasteMenuItemClick
end
object DeleteMenuItem: TMenuItem
Locked = True
Text = 'Delete'
OnClick = DeleteMenuItemClick
end
object SelectAllMenuItem: TMenuItem
Locked = True
ShortCut = 4161
Text = 'Select all'
OnClick = SelectAllMenuItemClick
end
end
end
object chrmosr: TFMXChromium
OnTooltip = chrmosrTooltip
OnCursorChange = chrmosrCursorChange

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

@ -48,7 +48,7 @@ uses
{$IFDEF DELPHI17_UP}FMX.Graphics,{$ENDIF}
uCEFFMXChromium, uCEFFMXBufferPanel, uCEFFMXWorkScheduler,
uCEFInterfaces, uCEFTypes, uCEFConstants, uCEFChromiumCore, FMX.Layouts,
FMX.Memo.Types, FMX.ScrollBox, FMX.Memo;
FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.Menus;
type
tagRGBQUAD = record
@ -69,6 +69,16 @@ type
Layout1: TLayout;
GoBtn: TButton;
SnapshotBtn: TButton;
MainMenu1: TMainMenu;
EditMenu: TMenuItem;
UndoMenuItem: TMenuItem;
RedoMenuItem: TMenuItem;
SeparatorMenuItem: TMenuItem;
CutMenuItem: TMenuItem;
CopyMenuItem: TMenuItem;
PasteMenuItem: TMenuItem;
DeleteMenuItem: TMenuItem;
SelectAllMenuItem: TMenuItem;
procedure GoBtnClick(Sender: TObject);
procedure GoBtnEnter(Sender: TObject);
@ -110,6 +120,13 @@ type
procedure SnapshotBtnClick(Sender: TObject);
procedure SnapshotBtnEnter(Sender: TObject);
procedure CopyMenuItemClick(Sender: TObject);
procedure CutMenuItemClick(Sender: TObject);
procedure DeleteMenuItemClick(Sender: TObject);
procedure PasteMenuItemClick(Sender: TObject);
procedure RedoMenuItemClick(Sender: TObject);
procedure SelectAllMenuItemClick(Sender: TObject);
procedure UndoMenuItemClick(Sender: TObject);
protected
FPopUpBitmap : TBitmap;
@ -124,17 +141,10 @@ type
FMouseWheelService : IFMXMouseService;
{$ENDIF}
FLastClickCount : integer;
FLastClickTime : integer;
FLastClickPoint : TPointF;
FLastClickButton : TMouseButton;
procedure LoadURL;
function getModifiers(Shift: TShiftState): TCefEventFlags;
function getModifiers(Shift: TShiftState; KeyCode: integer = 0): TCefEventFlags;
function GetButton(Button: TMouseButton): TCefMouseButtonType;
function GetMousePosition(var aPoint : TPointF) : boolean;
procedure InitializeLastClick;
function CancelPreviousClick(const x, y : single; var aCurrentTime : integer) : boolean;
public
procedure DoResize;
@ -152,10 +162,7 @@ var
// This demo is in ALPHA state. It's incomplete and some features may not work!
// ****************************************************************************
// Known issues and missing features :
// - Keyboard support is incomplete.
// - Full screen event is not handled correctly.
// - The CrAppProtocol implementation in uFMXApplicationService needs to be tested.
// - All Windows code in this demo must be removed.
// - Right-click crashes the demo.
@ -227,8 +234,10 @@ implementation
{$R *.fmx}
uses
System.SysUtils, System.Math, FMX.Platform, {$IFDEF MSWINDOWS}FMX.Platform.Win,{$ENDIF}
uCEFMiscFunctions, uCEFApplication, uFMXApplicationService;
System.SysUtils, System.Math, System.IOUtils,
FMX.Platform,
uCEFMiscFunctions, uCEFApplication, uFMXApplicationService,
uCEFMacOSConstants, uCEFMacOSFunctions;
procedure GlobalCEFApp_OnScheduleMessagePumpWork(const aDelayMS : int64);
begin
@ -252,13 +261,12 @@ begin
GlobalCEFApp.ExternalMessagePump := True;
GlobalCEFApp.MultiThreadedMessageLoop := False;
GlobalCEFApp.UseMockKeyChain := True;
//GlobalCEFApp.SingleProcess := True;
GlobalCEFApp.OnScheduleMessagePumpWork := GlobalCEFApp_OnScheduleMessagePumpWork;
//GlobalCEFApp.EnableGPU := True;
// Replace <username> with your username to create a log file in your home directory
//GlobalCEFApp.LogFile := '/Users/<username>/debug.log';
//GlobalCEFApp.LogSeverity := LOGSEVERITY_INFO;
{$IFDEF DEBUG}
GlobalCEFApp.LogFile := TPath.GetHomePath + TPath.DirectorySeparatorChar + 'debug.log';
GlobalCEFApp.LogSeverity := LOGSEVERITY_INFO;
{$ENDIF}
end;
procedure TFMXExternalPumpBrowserFrm.FormActivate(Sender: TObject);
@ -268,7 +276,8 @@ begin
// opaque white background color
chrmosr.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF);
if not(chrmosr.CreateBrowser) then Timer1.Enabled := True;
if not(chrmosr.CreateBrowser) then
Timer1.Enabled := True;
end;
end;
@ -286,10 +295,6 @@ begin
end;
procedure TFMXExternalPumpBrowserFrm.FormCreate(Sender: TObject);
{$IFDEF MSWINDOWS}
var
TempMajorVer, TempMinorVer : DWORD;
{$ENDIF}
begin
TFMXApplicationService.AddPlatformService;
@ -304,8 +309,6 @@ begin
chrmosr.DefaultURL := AddressEdt.Text;
InitializeLastClick;
{$IFDEF DELPHI17_UP}
if TPlatformServices.Current.SupportsPlatformService(IFMXMouseService) then
FMouseWheelService := TPlatformServices.Current.GetPlatformService(IFMXMouseService) as IFMXMouseService;
@ -358,8 +361,9 @@ begin
Panel1.SetFocus;
end;
procedure TFMXExternalPumpBrowserFrm.Panel1DialogKey(Sender: TObject;
var Key: Word; Shift: TShiftState);
procedure TFMXExternalPumpBrowserFrm.Panel1DialogKey( Sender : TObject;
var Key : Word;
Shift : TShiftState);
begin
if (Key = vkTab) then Key := 0;
end;
@ -374,29 +378,23 @@ begin
chrmosr.SendFocusEvent(False);
end;
procedure TFMXExternalPumpBrowserFrm.Panel1KeyUp(Sender: TObject; var Key: Word;
var KeyChar: Char; Shift: TShiftState);
procedure TFMXExternalPumpBrowserFrm.Panel1KeyUp( Sender : TObject;
var Key : Word;
var KeyChar : Char;
Shift : TShiftState);
var
TempKeyEvent : TCefKeyEvent;
TempChar : char;
begin
if not(Panel1.IsFocused) then exit;
if (KeyChar <> #0) then
TempChar := KeyChar
else
if (Key <> 0) then
TempChar := chr(Key)
else
TempChar := #0;
if not(Panel1.IsFocused) or (KeyChar = #0) then
exit;
TempKeyEvent.kind := KEYEVENT_KEYUP;
TempKeyEvent.modifiers := getModifiers(Shift);
TempKeyEvent.native_key_code := KeyToMacOSKeyCode(Key);
TempKeyEvent.modifiers := getModifiers(Shift, TempKeyEvent.native_key_code);
TempKeyEvent.windows_key_code := 0;
TempKeyEvent.native_key_code := 0;
TempKeyEvent.is_system_key := ord(False);
TempKeyEvent.character := TempChar;
TempKeyEvent.unmodified_character := TempChar;
TempKeyEvent.character := KeyChar;
TempKeyEvent.unmodified_character := KeyChar;
TempKeyEvent.focus_on_editable_field := ord(False);
chrmosr.SendKeyEvent(@TempKeyEvent);
@ -408,40 +406,27 @@ procedure TFMXExternalPumpBrowserFrm.Panel1KeyDown( Sender : TObject;
Shift : TShiftState);
var
TempKeyEvent : TCefKeyEvent;
TempChar : char;
begin
if not(Panel1.IsFocused) then exit;
if (KeyChar <> #0) then
TempChar := KeyChar
else
if (Key <> 0) then
begin
TempChar := chr(Key);
if (Key in [vkLeft, vkRight, vkUp, vkDown]) then
begin
Key := 0;
exit;
end;
end
else
TempChar := #0;
TempKeyEvent.kind := KEYEVENT_KEYDOWN;
TempKeyEvent.modifiers := getModifiers(Shift);
TempKeyEvent.native_key_code := KeyToMacOSKeyCode(Key);
TempKeyEvent.modifiers := getModifiers(Shift, TempKeyEvent.native_key_code);
TempKeyEvent.windows_key_code := 0;
TempKeyEvent.native_key_code := 0;
TempKeyEvent.is_system_key := ord(False);
TempKeyEvent.character := TempChar;
TempKeyEvent.unmodified_character := TempChar;
TempKeyEvent.character := KeyChar;
TempKeyEvent.unmodified_character := KeyChar;
TempKeyEvent.focus_on_editable_field := ord(False);
chrmosr.SendKeyEvent(@TempKeyEvent);
TempKeyEvent.kind := KEYEVENT_CHAR;
chrmosr.SendKeyEvent(@TempKeyEvent);
if not(TempKeyEvent.native_key_code in CEF_MACOS_KEYPAD_KEYS +
CEF_MACOS_ARROW_KEYS +
CEF_MACOS_FUNCTION_KEYS) then
begin
TempKeyEvent.kind := KEYEVENT_CHAR;
chrmosr.SendKeyEvent(@TempKeyEvent);
end;
end;
procedure TFMXExternalPumpBrowserFrm.Panel1MouseDown(Sender : TObject;
@ -450,28 +435,22 @@ procedure TFMXExternalPumpBrowserFrm.Panel1MouseDown(Sender : TObject;
X, Y : Single);
var
TempEvent : TCefMouseEvent;
TempTime : integer;
TempCount : integer;
begin
if not(ssTouch in Shift) then
begin
Panel1.SetFocus;
if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then
inc(FLastClickCount)
else
begin
FLastClickPoint.x := x;
FLastClickPoint.y := y;
FLastClickCount := 1;
end;
FLastClickTime := TempTime;
FLastClickButton := Button;
TempEvent.x := round(X);
TempEvent.y := round(Y);
TempEvent.modifiers := getModifiers(Shift);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount);
if (ssDouble in Shift) then
TempCount := 2
else
TempCount := 1;
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, TempCount);
end;
end;
@ -499,21 +478,14 @@ procedure TFMXExternalPumpBrowserFrm.Panel1MouseLeave(Sender: TObject);
var
TempEvent : TCefMouseEvent;
TempPoint : TPointF;
TempTime : integer;
begin
if GetMousePosition(TempPoint) then
begin
TempPoint := Panel1.ScreenToClient(TempPoint);
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
TempPoint := Panel1.ScreenToClient(TempPoint);
TempEvent.x := round(TempPoint.x);
TempEvent.y := round(TempPoint.y);
{$IFDEF MSWINDOWS}
TempEvent.modifiers := GetCefMouseModifiers;
{$ELSE}
TempEvent.modifiers := EVENTFLAG_NONE;
{$ENDIF}
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
end;
@ -523,15 +495,13 @@ procedure TFMXExternalPumpBrowserFrm.Panel1MouseMove(Sender : TObject;
X, Y : Single);
var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if not(ssTouch in Shift) then
begin
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
TempEvent.x := round(x);
TempEvent.y := round(y);
TempEvent.modifiers := getModifiers(Shift);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
end;
@ -542,13 +512,20 @@ procedure TFMXExternalPumpBrowserFrm.Panel1MouseUp(Sender : TObject;
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(Shift);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount);
if (ssDouble in Shift) then
TempCount := 2
else
TempCount := 1;
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, TempCount);
end;
end;
@ -566,6 +543,7 @@ begin
TempEvent.x := round(TempPoint.x);
TempEvent.y := round(TempPoint.y);
TempEvent.modifiers := getModifiers(Shift);
chrmosr.SendMouseWheelEvent(@TempEvent, 0, WheelDelta);
end;
end;
@ -575,6 +553,16 @@ begin
DoResize;
end;
procedure TFMXExternalPumpBrowserFrm.PasteMenuItemClick(Sender: TObject);
begin
chrmosr.ClipboardPaste;
end;
procedure TFMXExternalPumpBrowserFrm.RedoMenuItemClick(Sender: TObject);
begin
chrmosr.ClipboardRedo;
end;
procedure TFMXExternalPumpBrowserFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
@ -583,6 +571,11 @@ begin
Timer1.Enabled := True;
end;
procedure TFMXExternalPumpBrowserFrm.UndoMenuItemClick(Sender: TObject);
begin
chrmosr.ClipboardUndo;
end;
procedure TFMXExternalPumpBrowserFrm.AddressEdtEnter(Sender: TObject);
begin
chrmosr.SendFocusEvent(False);
@ -600,10 +593,10 @@ procedure TFMXExternalPumpBrowserFrm.chrmosrBeforeClose(Sender: TObject; const b
begin
FCanClose := True;
TThread.Queue(nil, procedure
begin
close
end);
TThread.ForceQueue(nil, procedure
begin
close
end);
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrBeforePopup( Sender : TObject;
@ -842,7 +835,7 @@ begin
if (type_ = PET_VIEW) then
begin
if TempForcedResize or FPendingResize then
TThread.Queue(nil, DoResize);
TThread.ForceQueue(nil, DoResize);
FResizing := False;
FPendingResize := False;
@ -895,6 +888,21 @@ begin
Result := True;
end;
procedure TFMXExternalPumpBrowserFrm.CopyMenuItemClick(Sender: TObject);
begin
chrmosr.ClipboardCopy;
end;
procedure TFMXExternalPumpBrowserFrm.CutMenuItemClick(Sender: TObject);
begin
chrmosr.ClipboardCut;
end;
procedure TFMXExternalPumpBrowserFrm.DeleteMenuItemClick(Sender: TObject);
begin
chrmosr.ClipboardDel;
end;
procedure TFMXExternalPumpBrowserFrm.DoResize;
begin
try
@ -934,21 +942,30 @@ begin
if (chrmosr <> nil) then chrmosr.NotifyMoveOrResizeStarted;
end;
procedure TFMXExternalPumpBrowserFrm.SelectAllMenuItemClick(Sender: TObject);
begin
chrmosr.SelectAll;
end;
procedure TFMXExternalPumpBrowserFrm.SendCaptureLostEvent;
begin
if (chrmosr <> nil) then chrmosr.SendCaptureLostEvent;
end;
function TFMXExternalPumpBrowserFrm.getModifiers(Shift: TShiftState): TCefEventFlags;
function TFMXExternalPumpBrowserFrm.getModifiers(Shift: TShiftState; KeyCode: integer): TCefEventFlags;
begin
Result := EVENTFLAG_NONE;
if (ssShift in Shift) then Result := Result or EVENTFLAG_SHIFT_DOWN;
if (ssAlt in Shift) then Result := Result or EVENTFLAG_ALT_DOWN;
if (ssCtrl in Shift) then Result := Result or EVENTFLAG_CONTROL_DOWN;
if (ssLeft in Shift) then Result := Result or EVENTFLAG_LEFT_MOUSE_BUTTON;
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 (ssShift in Shift) then Result := Result or EVENTFLAG_SHIFT_DOWN;
if (ssAlt in Shift) then Result := Result or EVENTFLAG_ALT_DOWN;
if (ssCtrl in Shift) then Result := Result or EVENTFLAG_CONTROL_DOWN;
if (ssLeft in Shift) then Result := Result or EVENTFLAG_LEFT_MOUSE_BUTTON;
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;
if (KeyCode in CEF_MACOS_KEYPAD_KEYS) then
Result := Result or EVENTFLAG_IS_KEY_PAD;
end;
function TFMXExternalPumpBrowserFrm.GetButton(Button: TMouseButton): TCefMouseButtonType;
@ -960,29 +977,6 @@ begin
end;
end;
procedure TFMXExternalPumpBrowserFrm.InitializeLastClick;
begin
FLastClickCount := 1;
FLastClickTime := 0;
FLastClickPoint.x := 0;
FLastClickPoint.y := 0;
FLastClickButton := TMouseButton.mbLeft;
end;
function TFMXExternalPumpBrowserFrm.CancelPreviousClick(const x, y : single; var aCurrentTime : integer) : boolean;
begin
{$IFDEF MSWINDOWS}
aCurrentTime := GetMessageTime;
Result := (abs(FLastClickPoint.x - x) > (GetSystemMetrics(SM_CXDOUBLECLK) div 2)) or
(abs(FLastClickPoint.y - y) > (GetSystemMetrics(SM_CYDOUBLECLK) div 2)) or
(cardinal(aCurrentTime - FLastClickTime) > GetDoubleClickTime);
{$ELSE}
aCurrentTime := 0;
Result := False;
{$ENDIF}
end;
procedure TFMXExternalPumpBrowserFrm.SnapshotBtnClick(Sender: TObject);
begin
if SaveDialog1.Execute then Panel1.SaveToFile(SaveDialog1.FileName);

2
source/uCEFBufferPanel.pas
View File

@ -491,7 +491,7 @@ begin
Result := HandleAllocated and PostMessage(Handle, CM_INVALIDATE, 0, 0);
{$ELSE}
Result := True;
TThread.Queue(nil, @Invalidate);
TThread.ForceQueue(nil, @Invalidate);
{$ENDIF}
end;

8
source/uCEFChromiumCore.pas
View File

@ -748,6 +748,7 @@ type
procedure ClearDataForOrigin(const aOrigin : ustring; aStorageTypes : TCefClearDataStorageTypes = cdstAll);
procedure ClearCache;
function DeleteCookies(const url : ustring = ''; const cookieName : ustring = ''; aDeleteImmediately : boolean = False) : boolean;
function VisitAllCookies(aID : integer = 0) : boolean;
function VisitURLCookies(const url : ustring; includeHttpOnly : boolean = False; aID : integer = 0) : boolean;
@ -2165,6 +2166,7 @@ begin
Browser.Host.Print;
end;
// The TChromiumCore.OnPdfPrintFinished event will be triggered when the PDF file is created.
procedure TChromiumCore.PrintToPDF(const aFilePath, aTitle, aURL : ustring);
var
TempSettings : TCefPdfPrintSettings;
@ -2512,7 +2514,7 @@ begin
Browser.Host.StartDownload(aURL);
end;
// Use the OnDownloadImageFinished event to receive the image
// Use the TChromiumCore.OnDownloadImageFinished event to receive the image
procedure TChromiumCore.DownloadImage(const imageUrl : ustring;
isFavicon : boolean;
maxImageSize : cardinal;
@ -3634,6 +3636,7 @@ begin
end;
// Leave aFrameName empty to get the HTML source from the main frame
// The TChromiumCore.OnTextResultAvailable event will be triggered with the HTML contents
procedure TChromiumCore.RetrieveHTML(const aFrameName : ustring);
var
TempFrame : ICefFrame;
@ -3692,6 +3695,7 @@ begin
end;
// Leave aFrameName empty to get the HTML source from the main frame
// The TChromiumCore.OnTextResultAvailable event will be triggered with the text contents
procedure TChromiumCore.RetrieveText(const aFrameName : ustring);
var
TempFrame : ICefFrame;
@ -3749,6 +3753,7 @@ begin
end;
end;
// The TChromiumCore.OnNavigationVisitorResultAvailable event will be triggered for each entry
procedure TChromiumCore.GetNavigationEntries(currentOnly: Boolean);
var
TempVisitor : ICefNavigationEntryVisitor;
@ -6616,6 +6621,7 @@ begin
end;
end;
// This procedure will trigger OnMediaSinkDeviceInfo with the device info.
procedure TChromiumCore.GetDeviceInfo(const aMediaSink: ICefMediaSink);
var
TempCallback : ICefMediaSinkDeviceInfoCallback;

8
source/uCEFFMXWorkScheduler.pas
View File

@ -276,10 +276,10 @@ begin
if FUseQueueThread and (FQueueThread <> nil) and FQueueThread.Ready then
FQueueThread.EnqueueValue(integer(delay_ms))
else
TThread.Queue(nil, procedure
begin
ScheduleWork(delay_ms);
end);
TThread.ForceQueue(nil, procedure
begin
ScheduleWork(delay_ms);
end);
end;
procedure TFMXWorkScheduler.StopScheduler;

7
source/uCEFLinuxFunctions.pas
View File

@ -65,6 +65,13 @@ function GdkEventToWindowsKeyCode(Event: PGdkEventKey) : integer;
function GetWindowsKeyCodeWithoutLocation(key_code : integer) : integer;
function GetControlCharacter(windows_key_code : integer; shift : boolean) : integer;
{$IFDEF FMX}
type
TXErrorHandler = function (para1:PDisplay; para2:PXErrorEvent):longint; cdecl;
TXIOErrorHandler = function (para1:PDisplay):longint; cdecl;
function XSetErrorHandler(para1:TXErrorHandler):TXErrorHandler; cdecl; external 'libX11.so';
function XSetIOErrorHandler(para1:TXIOErrorHandler):TXIOErrorHandler; cdecl; external 'libX11.so';
function gdk_keyval_to_unicode(keyval: guint): guint32; cdecl; external 'libgdk-3.so';
function g_signal_connect_data(instance: gpointer; detailed_signal: Pgchar; c_handler: TGCallback; data: gpointer; destroy_data: TGClosureNotify; connect_flags: TGConnectFlags): gulong; cdecl; external 'libgobject-2.0.so';
function g_signal_connect(instance: gpointer; detailed_signal: Pgchar; c_handler: TGCallback; data: gpointer): gulong; overload;

12
source/uCEFLinuxTypes.pas
View File

@ -80,6 +80,18 @@ type
TGdkEventType = int32;
PGdkEventKey = ^TGdkEventKey;
PXDisplay = pointer;
PDisplay = pointer;
PXErrorEvent = ^TXErrorEvent;
TXErrorEvent = record
_type : longint;
display : PDisplay;
resourceid : uint64;
serial : uint64;
error_code : uint8;
request_code : uint8;
minor_code : uint8;
end;
PGTypeClass = ^TGTypeClass;
TGTypeClass = record

240
source/uCEFMacOSConstants.pas Normal file
View File

@ -0,0 +1,240 @@
// ************************************************************************
// ***************************** 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 uCEFMacOSConstants;
{$IFDEF FPC}
{$MODE OBJFPC}{$H+}
{$ENDIF}
{$IFNDEF CPUX64}{$ALIGN ON}{$ENDIF}
{$MINENUMSIZE 4}
{$I cef.inc}
interface
{$IFDEF MACOSX}
const
// Virtual Keycode constants defined in <HIToolbox/Events.h>
// /System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/HIToolbox.framework/Versions/A/Headers/Events.h
// /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/System/Library/Frameworks/Carbon.framework/Versions/A/Frameworks/HIToolbox.framework/Versions/A/Headers/Events.h
// These constants are the virtual keycodes defined originally in
// Inside Mac Volume V, pg. V-191. They identify physical keys on a
// keyboard. Those constants with "ANSI" in the name are labeled
// according to the key position on an ANSI-standard US keyboard.
// For example, kVK_ANSI_A indicates the virtual keycode for the key
// with the letter 'A' in the US keyboard layout. Other keyboard
// layouts may have the 'A' key label on a different physical key;
// in this case, pressing 'A' will generate a different virtual
// keycode.
kVK_ANSI_A = $00;
kVK_ANSI_S = $01;
kVK_ANSI_D = $02;
kVK_ANSI_F = $03;
kVK_ANSI_H = $04;
kVK_ANSI_G = $05;
kVK_ANSI_Z = $06;
kVK_ANSI_X = $07;
kVK_ANSI_C = $08;
kVK_ANSI_V = $09;
kVK_ANSI_B = $0B;
kVK_ANSI_Q = $0C;
kVK_ANSI_W = $0D;
kVK_ANSI_E = $0E;
kVK_ANSI_R = $0F;
kVK_ANSI_Y = $10;
kVK_ANSI_T = $11;
kVK_ANSI_1 = $12;
kVK_ANSI_2 = $13;
kVK_ANSI_3 = $14;
kVK_ANSI_4 = $15;
kVK_ANSI_6 = $16;
kVK_ANSI_5 = $17;
kVK_ANSI_Equal = $18;
kVK_ANSI_9 = $19;
kVK_ANSI_7 = $1A;
kVK_ANSI_Minus = $1B;
kVK_ANSI_8 = $1C;
kVK_ANSI_0 = $1D;
kVK_ANSI_RightBracket = $1E;
kVK_ANSI_O = $1F;
kVK_ANSI_U = $20;
kVK_ANSI_LeftBracket = $21;
kVK_ANSI_I = $22;
kVK_ANSI_P = $23;
kVK_ANSI_L = $25;
kVK_ANSI_J = $26;
kVK_ANSI_Quote = $27;
kVK_ANSI_K = $28;
kVK_ANSI_Semicolon = $29;
kVK_ANSI_Backslash = $2A;
kVK_ANSI_Comma = $2B;
kVK_ANSI_Slash = $2C;
kVK_ANSI_N = $2D;
kVK_ANSI_M = $2E;
kVK_ANSI_Period = $2F;
kVK_ANSI_Grave = $32;
kVK_ANSI_KeypadDecimal = $41;
kVK_ANSI_KeypadMultiply = $43;
kVK_ANSI_KeypadPlus = $45;
kVK_ANSI_KeypadClear = $47;
kVK_ANSI_KeypadDivide = $4B;
kVK_ANSI_KeypadEnter = $4C;
kVK_ANSI_KeypadMinus = $4E;
kVK_ANSI_KeypadEquals = $51;
kVK_ANSI_Keypad0 = $52;
kVK_ANSI_Keypad1 = $53;
kVK_ANSI_Keypad2 = $54;
kVK_ANSI_Keypad3 = $55;
kVK_ANSI_Keypad4 = $56;
kVK_ANSI_Keypad5 = $57;
kVK_ANSI_Keypad6 = $58;
kVK_ANSI_Keypad7 = $59;
kVK_ANSI_Keypad8 = $5B;
kVK_ANSI_Keypad9 = $5C;
// keycodes for keys that are independent of keyboard layout
kVK_Return = $24;
kVK_Tab = $30;
kVK_Space = $31;
kVK_Delete = $33;
kVK_Escape = $35;
kVK_Command = $37;
kVK_Shift = $38;
kVK_CapsLock = $39;
kVK_Option = $3A;
kVK_Control = $3B;
kVK_RightShift = $3C;
kVK_RightOption = $3D;
kVK_RightControl = $3E;
kVK_Function = $3F;
kVK_F17 = $40;
kVK_VolumeUp = $48;
kVK_VolumeDown = $49;
kVK_Mute = $4A;
kVK_F18 = $4F;
kVK_F19 = $50;
kVK_F20 = $5A;
kVK_F5 = $60;
kVK_F6 = $61;
kVK_F7 = $62;
kVK_F3 = $63;
kVK_F8 = $64;
kVK_F9 = $65;
kVK_F11 = $67;
kVK_F13 = $69;
kVK_F16 = $6A;
kVK_F14 = $6B;
kVK_F10 = $6D;
kVK_F12 = $6F;
kVK_F15 = $71;
kVK_Help = $72;
kVK_Home = $73;
kVK_PageUp = $74;
kVK_ForwardDelete = $75;
kVK_F4 = $76;
kVK_End = $77;
kVK_F2 = $78;
kVK_PageDown = $79;
kVK_F1 = $7A;
kVK_LeftArrow = $7B;
kVK_RightArrow = $7C;
kVK_DownArrow = $7D;
kVK_UpArrow = $7E;
// ISO keyboards only
kVK_ISO_Section = $0A;
// JIS keyboards only
kVK_JIS_Yen = $5D;
kVK_JIS_Underscore = $5E;
kVK_JIS_KeypadComma = $5F;
kVK_JIS_Eisu = $66;
kVK_JIS_Kana = $68;
CEF_MACOS_KEYPAD_KEYS = [kVK_ANSI_KeypadDecimal,
kVK_ANSI_KeypadMultiply,
kVK_ANSI_KeypadPlus,
kVK_ANSI_KeypadClear,
kVK_ANSI_KeypadDivide,
kVK_ANSI_KeypadEnter,
kVK_ANSI_KeypadMinus,
kVK_ANSI_KeypadEquals,
kVK_ANSI_Keypad0,
kVK_ANSI_Keypad1,
kVK_ANSI_Keypad2,
kVK_ANSI_Keypad3,
kVK_ANSI_Keypad4,
kVK_ANSI_Keypad5,
kVK_ANSI_Keypad6,
kVK_ANSI_Keypad7,
kVK_ANSI_Keypad8,
kVK_ANSI_Keypad9];
CEF_MACOS_ARROW_KEYS = [kVK_LeftArrow,
kVK_RightArrow,
kVK_DownArrow,
kVK_UpArrow];
CEF_MACOS_FUNCTION_KEYS = [kVK_F1,
kVK_F2,
kVK_F3,
kVK_F4,
kVK_F5,
kVK_F6,
kVK_F7,
kVK_F8,
kVK_F9,
kVK_F10,
kVK_F11,
kVK_F12,
kVK_F13,
kVK_F14,
kVK_F15,
kVK_F16,
kVK_F17,
kVK_F18,
kVK_F19,
kVK_F20];
{$ENDIF}
implementation
end.

177
demos/Delphi_FMX_Mac/FMXExternalPumpBrowser/uFMXMiscFunctions.pas → source/uCEFMacOSFunctions.pas
View File

@ -35,17 +35,37 @@
*
*)
unit uFMXMiscFunctions;
unit uCEFMacOSFunctions;
{$IFDEF FPC}
{$MODE OBJFPC}{$H+}
{$ENDIF}
{$IFNDEF CPUX64}{$ALIGN ON}{$ENDIF}
{$MINENUMSIZE 4}
{$I cef.inc}
interface
uses
System.UITypes,
uCEFMacOSConstants;
{$IFDEF MACOSX}
function KeyToMacOSKeyCode(aKey : Word): integer;
{$IFDEF FMX}
procedure CopyCEFFramework;
procedure CopyCEFHelpers(const aProjectName : string);
{$ENDIF}
{$ENDIF}
implementation
{$IFDEF MACOSX}
{$IFDEF FMX}
uses
System.SysUtils, System.Types, System.IOUtils, Posix.Stdio,
System.SysUtils, System.Types, System.IOUtils, Posix.Stdio, FMX.Types,
uCEFMiscFunctions;
const
@ -53,11 +73,144 @@ const
PRJ_GPU_SUBFIX = '_helper_gpu';
PRJ_PLUGIN_SUBFIX = '_helper_plugin';
PRJ_RENDERER_SUBFIX = '_helper_renderer';
HELPER_SUBFIX = ' Helper';
GPU_SUBFIX = ' Helper (GPU)';
PLUGIN_SUBFIX = ' Helper (Plugin)';
RENDERER_SUBFIX = ' Helper (Renderer)';
HELPER_SUBFIX = ' Helper';
GPU_SUBFIX = ' Helper (GPU)';
PLUGIN_SUBFIX = ' Helper (Plugin)';
RENDERER_SUBFIX = ' Helper (Renderer)';
{$ENDIF}
// 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
vkBack : Result := kVK_Delete;
vkTab : Result := kVK_Tab;
vkClear : Result := kVK_ANSI_KeypadClear;
vkReturn : Result := kVK_Return;
vkShift : Result := kVK_Shift;
vkControl : Result := kVK_Control;
vkMenu : Result := kVK_Option;
vkPause : Result := kVK_F15;
vkCapital : Result := kVK_CapsLock;
vkEscape : Result := kVK_Escape;
vkSpace : Result := kVK_Space;
vkPrior : Result := kVK_PageUp;
vkNext : Result := kVK_PageDown;
vkEnd : Result := kVK_End;
vkHome : Result := kVK_Home;
vkLeft : Result := kVK_LeftArrow;
vkUp : Result := kVK_UpArrow;
vkRight : Result := kVK_RightArrow;
vkDown : Result := kVK_DownArrow;
vkSnapshot : Result := kVK_F13;
vkHelp,
vkInsert : Result := kVK_Help;
vkDelete : Result := kVK_ForwardDelete;
vk0 : Result := kVK_ANSI_0;
vk1 : Result := kVK_ANSI_1;
vk2 : Result := kVK_ANSI_2;
vk3 : Result := kVK_ANSI_3;
vk4 : Result := kVK_ANSI_4;
vk5 : Result := kVK_ANSI_5;
vk6 : Result := kVK_ANSI_6;
vk7 : Result := kVK_ANSI_7;
vk8 : Result := kVK_ANSI_8;
vk9 : Result := kVK_ANSI_9;
vkA : Result := kVK_ANSI_A;
vkB : Result := kVK_ANSI_B;
vkC : Result := kVK_ANSI_C;
vkD : Result := kVK_ANSI_D;
vkE : Result := kVK_ANSI_E;
vkF : Result := kVK_ANSI_F;
vkG : Result := kVK_ANSI_G;
vkH : Result := kVK_ANSI_H;
vkI : Result := kVK_ANSI_I;
vkJ : Result := kVK_ANSI_J;
vkK : Result := kVK_ANSI_K;
vkL : Result := kVK_ANSI_L;
vkM : Result := kVK_ANSI_M;
vkN : Result := kVK_ANSI_N;
vkO : Result := kVK_ANSI_O;
vkP : Result := kVK_ANSI_P;
vkQ : Result := kVK_ANSI_Q;
vkR : Result := kVK_ANSI_R;
vkS : Result := kVK_ANSI_S;
vkT : Result := kVK_ANSI_T;
vkU : Result := kVK_ANSI_U;
vkV : Result := kVK_ANSI_V;
vkW : Result := kVK_ANSI_W;
vkX : Result := kVK_ANSI_X;
vkY : Result := kVK_ANSI_Y;
vkZ : Result := kVK_ANSI_Z;
vkLWin : Result := kVK_Option;
vkRWin : Result := kVK_RightOption;
vkNumpad0 : Result := kVK_ANSI_Keypad0;
vkNumpad1 : Result := kVK_ANSI_Keypad1;
vkNumpad2 : Result := kVK_ANSI_Keypad2;
vkNumpad3 : Result := kVK_ANSI_Keypad3;
vkNumpad4 : Result := kVK_ANSI_Keypad4;
vkNumpad5 : Result := kVK_ANSI_Keypad5;
vkNumpad6 : Result := kVK_ANSI_Keypad6;
vkNumpad7 : Result := kVK_ANSI_Keypad7;
vkNumpad8 : Result := kVK_ANSI_Keypad8;
vkNumpad9 : Result := kVK_ANSI_Keypad9;
vkMultiply : Result := kVK_ANSI_KeypadMultiply;
vkAdd : Result := kVK_ANSI_KeypadPlus;
vkSubtract : Result := kVK_ANSI_KeypadMinus;
vkDecimal : Result := kVK_ANSI_KeypadDecimal;
vkDivide : Result := kVK_ANSI_KeypadDivide;
vkF1 : Result := kVK_F1;
vkF2 : Result := kVK_F2;
vkF3 : Result := kVK_F3;
vkF4 : Result := kVK_F4;
vkF5 : Result := kVK_F5;
vkF6 : Result := kVK_F6;
vkF7 : Result := kVK_F7;
vkF8 : Result := kVK_F8;
vkF9 : Result := kVK_F9;
vkF10 : Result := kVK_F10;
vkF11 : Result := kVK_F11;
vkF12 : Result := kVK_F12;
vkF13 : Result := kVK_F13;
vkF14 : Result := kVK_F14;
vkF15 : Result := kVK_F15;
vkF16 : Result := kVK_F16;
vkF17 : Result := kVK_F17;
vkF18 : Result := kVK_F18;
vkF19 : Result := kVK_F19;
vkF20 : Result := kVK_F20;
vkNumLock : Result := kVK_ANSI_KeypadClear;
vkScroll : Result := kVK_F14;
vkLShift : Result := kVK_Shift;
vkRShift : Result := kVK_RightShift;
vkLControl : Result := kVK_Control;
vkRControl : Result := kVK_RightControl;
vkLMenu,
vkRMenu : Result := kVK_Command;
vkVolumeMute : Result := kVK_Mute;
vkVolumeDown : Result := kVK_VolumeDown;
vkVolumeUp : Result := kVK_VolumeUp;
vkSemicolon : Result := kVK_ANSI_Semicolon;
vkEqual : Result := kVK_ANSI_Equal;
vkComma : Result := kVK_ANSI_Comma;
vkMinus : Result := kVK_ANSI_Minus;
vkPeriod : Result := kVK_ANSI_Period;
vkSlash : Result := kVK_ANSI_Slash;
vkTilde : Result := kVK_ANSI_Grave;
vkLeftBracket : Result := kVK_ANSI_LeftBracket;
vkBackslash : Result := kVK_ANSI_Backslash;
vkRightBracket : Result := kVK_ANSI_RightBracket;
vkQuote : Result := kVK_ANSI_Quote;
vkOem102 : Result := kVK_ANSI_Backslash; // kVK_JIS_Yen in Japanese keyboards ?
vkOemClear : Result := kVK_ANSI_KeypadClear;
else Result := 0;
end;
end;
{$IFDEF FMX}
procedure CopyAllFiles(const aSrcPath, aDstPath: string);
var
TempDirectories, TempFiles : TStringDynArray;
@ -88,7 +241,7 @@ begin
end;
except
on e : exception do
WriteLn('CopyAllFiles error : ' + e.Message);
FMX.Types.Log.d('CopyAllFiles error : ' + e.Message);
end;
end;
@ -114,7 +267,7 @@ begin
end;
except
on e : exception do
WriteLn('CopyCEFFramework error : ' + e.Message);
FMX.Types.Log.d('CopyCEFFramework error : ' + e.Message);
end;
end;
@ -171,8 +324,8 @@ begin
RenameFile(aHelperPrjPath, appNewBundlePath);
end;
except
on e: exception do
WriteLn('RenameCEFHelper error : ' + e.Message);
on e : exception do
FMX.Types.Log.d('RenameCEFHelper error : ' + e.Message);
end;
end;
@ -212,7 +365,7 @@ begin
end;
end;
end;
{$ENDIF}
{$ENDIF}
end.

86
source/uCEFWorkScheduler.pas
View File

@ -46,13 +46,6 @@ unit uCEFWorkScheduler;
{$I cef.inc}
// Define this conditional to use TCEFWorkSchedulerQueueThread instead of using
// PostMessage, Application.QueueAsyncCall or TThread.Queue inside
// TCEFWorkScheduler.ScheduleMessagePumpWork
// TCEFWorkSchedulerQueueThread is just a new experimental way to handle the
// external message pump events for all platforms.
{.$DEFINE USEQUEUETHREAD}
interface
uses
@ -66,7 +59,7 @@ uses
Messages,
{$ENDIF}
{$ENDIF}
uCEFConstants, {$IFDEF USEQUEUETHREAD}uCEFWorkSchedulerQueueThread,{$ENDIF} uCEFWorkSchedulerThread;
uCEFConstants, uCEFWorkSchedulerQueueThread, uCEFWorkSchedulerThread;
type
@ -74,13 +67,12 @@ type
TCEFWorkScheduler = class(TComponent)
protected
FThread : TCEFWorkSchedulerThread;
{$IFDEF USEQUEUETHREAD}
FQueueThread : TCEFWorkSchedulerQueueThread;
{$ENDIF}
FDepleteWorkCycles : cardinal;
FDepleteWorkDelay : cardinal;
FDefaultInterval : integer;
FStopped : boolean;
FUseQueueThread : boolean;
{$IFDEF MSWINDOWS}
{$WARN SYMBOL_PLATFORM OFF}
FCompHandle : HWND;
@ -88,11 +80,9 @@ type
{$WARN SYMBOL_PLATFORM ON}
{$ENDIF}
{$IFDEF USEQUEUETHREAD}
procedure CreateQueueThread;
procedure DestroyQueueThread;
procedure QueueThread_OnPulse(Sender : TObject; aDelay : integer);
{$ENDIF}
procedure DestroyThread;
procedure DepleteWork;
@ -136,6 +126,7 @@ type
property DefaultInterval : integer read FDefaultInterval write SetDefaultInterval default CEF_TIMER_MAXDELAY;
property DepleteWorkCycles : cardinal read FDepleteWorkCycles write FDepleteWorkCycles default CEF_TIMER_DEPLETEWORK_CYCLES;
property DepleteWorkDelay : cardinal read FDepleteWorkDelay write FDepleteWorkDelay default CEF_TIMER_DEPLETEWORK_DELAY;
property UseQueueThread : boolean read FUseQueueThread write FUseQueueThread default False;
end;
var
@ -199,9 +190,7 @@ end;
destructor TCEFWorkScheduler.Destroy;
begin
DestroyThread;
{$IFDEF USEQUEUETHREAD}
DestroyQueueThread;
{$ENDIF}
{$IFDEF MSWINDOWS}
DeallocateWindowHandle;
{$ENDIF}
@ -210,10 +199,9 @@ end;
procedure TCEFWorkScheduler.Initialize;
begin
FUseQueueThread := False;
FThread := nil;
{$IFDEF USEQUEUETHREAD}
FQueueThread := nil;
{$ENDIF}
FStopped := False;
{$IFDEF MSWINDOWS}
{$WARN SYMBOL_PLATFORM OFF}
@ -246,12 +234,10 @@ begin
{$ENDIF}
{$ENDIF}
{$IFDEF USEQUEUETHREAD}
CreateQueueThread;
{$ENDIF}
end;
if FUseQueueThread then
CreateQueueThread;
end;
{$IFDEF USEQUEUETHREAD}
procedure TCEFWorkScheduler.CreateQueueThread;
begin
FQueueThread := TCEFWorkSchedulerQueueThread.Create;
@ -287,7 +273,6 @@ procedure TCEFWorkScheduler.QueueThread_OnPulse(Sender : TObject; aDelay : integ
begin
ScheduleWork(aDelay);
end;
{$ENDIF}
procedure TCEFWorkScheduler.DestroyThread;
begin
@ -322,6 +307,14 @@ begin
FCompHandle := 0;
end;
end;
{$WARN SYMBOL_PLATFORM OFF}
procedure TCEFWorkScheduler.SetPriority(aValue : TThreadPriority);
begin
FPriority := aValue;
if (FThread <> nil) then FThread.Priority := aValue;
end;
{$WARN SYMBOL_PLATFORM ON}
{$ENDIF}
procedure TCEFWorkScheduler.DoMessageLoopWork;
@ -335,16 +328,6 @@ begin
if (FThread <> nil) then FThread.DefaultInterval := aValue;
end;
{$IFDEF MSWINDOWS}
{$WARN SYMBOL_PLATFORM OFF}
procedure TCEFWorkScheduler.SetPriority(aValue : TThreadPriority);
begin
FPriority := aValue;
if (FThread <> nil) then FThread.Priority := aValue;
end;
{$WARN SYMBOL_PLATFORM ON}
{$ENDIF}
procedure TCEFWorkScheduler.DepleteWork;
var
i : cardinal;
@ -363,27 +346,24 @@ procedure TCEFWorkScheduler.ScheduleMessagePumpWork(const delay_ms : int64);
begin
if FStopped then exit;
{$IFDEF USEQUEUETHREAD}
if (FQueueThread <> nil) and FQueueThread.Ready then
begin
FQueueThread.EnqueueValue(integer(delay_ms));
exit;
end;
{$ENDIF}
{$IFDEF MSWINDOWS}
if (FCompHandle <> 0) then
PostMessage(FCompHandle, CEF_PUMPHAVEWORK, 0, LPARAM(delay_ms));
{$ELSE}
{$IFDEF FPC}
Application.QueueAsyncCall(@ScheduleWorkAsync, integer(delay_ms));
{$ELSE}
TThread.Queue(nil, procedure
begin
ScheduleWork(delay_ms);
end);
{$ENDIF}
{$ENDIF}
if FUseQueueThread and (FQueueThread <> nil) and FQueueThread.Ready then
FQueueThread.EnqueueValue(integer(delay_ms))
else
begin
{$IFDEF MSWINDOWS}
if (FCompHandle <> 0) then
PostMessage(FCompHandle, CEF_PUMPHAVEWORK, 0, LPARAM(delay_ms));
{$ELSE}
{$IFDEF FPC}
Application.QueueAsyncCall(@ScheduleWorkAsync, integer(delay_ms));
{$ELSE}
TThread.ForceQueue(nil, procedure
begin
ScheduleWork(delay_ms);
end);
{$ENDIF}
{$ENDIF}
end;
end;
{$IFNDEF MSWINDOWS}{$IFDEF FPC}

2
source/uCEFWorkSchedulerQueueThread.pas
View File

@ -91,7 +91,7 @@ type
procedure EnqueueValue(aValue : integer);
property Ready : boolean read FReady;
property OnPulse : TOnPulseEvent read FOnPulse write FOnPulse;
property OnPulse : TOnPulseEvent read FOnPulse write FOnPulse;
end;
implementation

4
source/uCEFWorkSchedulerThread.pas
View File

@ -176,7 +176,9 @@ begin
FPulsing := False;
finally
Unlock;
if not(Terminated) then Synchronize({$IFDEF FPC}self, @{$ENDIF}DoOnPulseEvent);
if not(Terminated) then
Synchronize({$IFDEF FPC}self, @{$ENDIF}DoOnPulseEvent);
end;
end;

2
update_CEF4Delphi.json
View File

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