mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2024-11-15 07:45:56 +01:00
Added an experimental TCEFLinuxEventPipe class for Linux in Lazarus
This commit is contained in:
parent
67d3e5e528
commit
65aa181694
@ -45,6 +45,7 @@ contains
|
|||||||
uCEFMacOSInterfaces in '..\source\uCEFMacOSInterfaces.pas',
|
uCEFMacOSInterfaces in '..\source\uCEFMacOSInterfaces.pas',
|
||||||
uCEFLinuxConstants in '..\source\uCEFLinuxConstants.pas',
|
uCEFLinuxConstants in '..\source\uCEFLinuxConstants.pas',
|
||||||
uCEFLinuxFunctions in '..\source\uCEFLinuxFunctions.pas',
|
uCEFLinuxFunctions in '..\source\uCEFLinuxFunctions.pas',
|
||||||
uCEFLinuxTypes in '..\source\uCEFLinuxTypes.pas';
|
uCEFLinuxTypes in '..\source\uCEFLinuxTypes.pas',
|
||||||
|
uCEFTimerWorkScheduler in '..\source\uCEFTimerWorkScheduler.pas';
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
@ -158,6 +158,7 @@
|
|||||||
<DCCReference Include="..\source\uCEFLinuxConstants.pas"/>
|
<DCCReference Include="..\source\uCEFLinuxConstants.pas"/>
|
||||||
<DCCReference Include="..\source\uCEFLinuxFunctions.pas"/>
|
<DCCReference Include="..\source\uCEFLinuxFunctions.pas"/>
|
||||||
<DCCReference Include="..\source\uCEFLinuxTypes.pas"/>
|
<DCCReference Include="..\source\uCEFLinuxTypes.pas"/>
|
||||||
|
<DCCReference Include="..\source\uCEFTimerWorkScheduler.pas"/>
|
||||||
<BuildConfiguration Include="Base">
|
<BuildConfiguration Include="Base">
|
||||||
<Key>Base</Key>
|
<Key>Base</Key>
|
||||||
</BuildConfiguration>
|
</BuildConfiguration>
|
||||||
|
@ -22,7 +22,7 @@
|
|||||||
<Description Value="CEF4Delphi is an open source project created by Salvador Díaz Fau to embed Chromium-based browsers in applications made with Delphi or Lazarus/FPC."/>
|
<Description Value="CEF4Delphi is an open source project created by Salvador Díaz Fau to embed Chromium-based browsers in applications made with Delphi or Lazarus/FPC."/>
|
||||||
<License Value="MPL 1.1"/>
|
<License Value="MPL 1.1"/>
|
||||||
<Version Major="102" Release="9"/>
|
<Version Major="102" Release="9"/>
|
||||||
<Files Count="202">
|
<Files Count="203">
|
||||||
<Item1>
|
<Item1>
|
||||||
<Filename Value="..\source\uCEFAccessibilityHandler.pas"/>
|
<Filename Value="..\source\uCEFAccessibilityHandler.pas"/>
|
||||||
<UnitName Value="uCEFAccessibilityHandler"/>
|
<UnitName Value="uCEFAccessibilityHandler"/>
|
||||||
@ -849,6 +849,10 @@
|
|||||||
<Filename Value="..\source\uCEFCommandHandler.pas"/>
|
<Filename Value="..\source\uCEFCommandHandler.pas"/>
|
||||||
<UnitName Value="uCEFCommandHandler"/>
|
<UnitName Value="uCEFCommandHandler"/>
|
||||||
</Item202>
|
</Item202>
|
||||||
|
<Item203>
|
||||||
|
<Filename Value="..\source\uCEFLinuxEventPipe.pas"/>
|
||||||
|
<UnitName Value="uCEFLinuxEventPipe"/>
|
||||||
|
</Item203>
|
||||||
</Files>
|
</Files>
|
||||||
<CompatibilityMode Value="True"/>
|
<CompatibilityMode Value="True"/>
|
||||||
<RequiredPkgs Count="5">
|
<RequiredPkgs Count="5">
|
||||||
|
@ -66,7 +66,7 @@ uses
|
|||||||
uCEFWorkSchedulerQueueThread, uCEFLinkedWinControlBase, uCEFLazarusCocoa,
|
uCEFWorkSchedulerQueueThread, uCEFLinkedWinControlBase, uCEFLazarusCocoa,
|
||||||
uCEFBrowserWindow, uCEFOsrBrowserWindow, uCEFTimerWorkScheduler,
|
uCEFBrowserWindow, uCEFOsrBrowserWindow, uCEFTimerWorkScheduler,
|
||||||
uCEFFrameHandler, uCEFOverlayController, uCEFFileDialogInfo, uCEFArgCopy,
|
uCEFFrameHandler, uCEFOverlayController, uCEFFileDialogInfo, uCEFArgCopy,
|
||||||
uCEFCommandHandler, LazarusPackageIntf;
|
uCEFCommandHandler, uCEFLinuxEventPipe, LazarusPackageIntf;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
423
source/uCEFLinuxEventPipe.pas
Normal file
423
source/uCEFLinuxEventPipe.pas
Normal file
@ -0,0 +1,423 @@
|
|||||||
|
// ************************************************************************
|
||||||
|
// ***************************** 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 © 2022 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 uCEFLinuxEventPipe;
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$MODE OBJFPC}{$H+}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$I cef.inc}
|
||||||
|
|
||||||
|
{$IFNDEF TARGET_64BITS}{$ALIGN ON}{$ENDIF}
|
||||||
|
{$MINENUMSIZE 4}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, Forms, Unix;
|
||||||
|
|
||||||
|
type
|
||||||
|
gint = integer;
|
||||||
|
pgint = ^gint;
|
||||||
|
guint = longword;
|
||||||
|
gushort = word;
|
||||||
|
gboolean = boolean32;
|
||||||
|
gpointer = Pointer;
|
||||||
|
Pgpointer = ^gpointer;
|
||||||
|
PGMainContext = Pointer;
|
||||||
|
PGSource = ^TGSource;
|
||||||
|
PGSourceFunc = ^TGSourceFunc;
|
||||||
|
PGSourceFuncs = ^TGSourceFuncs;
|
||||||
|
PGSList = ^TGSList;
|
||||||
|
|
||||||
|
TGSList = record
|
||||||
|
data : gpointer;
|
||||||
|
next : PGSList;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TGSourceFunc = function (data:gpointer):gboolean;cdecl;
|
||||||
|
|
||||||
|
TGSourceDummyMarshal = procedure;cdecl;
|
||||||
|
|
||||||
|
TGSourceFuncs = record
|
||||||
|
prepare : function (source:PGSource; timeout:pgint):gboolean; cdecl;
|
||||||
|
check : function (source:PGSource):gboolean; cdecl;
|
||||||
|
dispatch : function (source:PGSource; callback:TGSourceFunc; user_data:gpointer):gboolean; cdecl;
|
||||||
|
finalize : procedure (source:PGSource); cdecl;
|
||||||
|
closure_callback : TGSourceFunc;
|
||||||
|
closure_marshal : TGSourceDummyMarshal;
|
||||||
|
end;
|
||||||
|
|
||||||
|
PGSourceCallbackFuncs = ^TGSourceCallbackFuncs;
|
||||||
|
TGSourceCallbackFuncs = record
|
||||||
|
ref : procedure (cb_data:gpointer); cdecl;
|
||||||
|
unref : procedure (cb_data:gpointer); cdecl;
|
||||||
|
get : procedure (cb_data:gpointer; source:PGSource; func:PGSourceFunc; data:Pgpointer); cdecl;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TGSource = record
|
||||||
|
callback_data : gpointer;
|
||||||
|
callback_funcs : PGSourceCallbackFuncs;
|
||||||
|
source_funcs : PGSourceFuncs;
|
||||||
|
ref_count : guint;
|
||||||
|
context : PGMainContext;
|
||||||
|
priority : gint;
|
||||||
|
flags : guint;
|
||||||
|
source_id : guint;
|
||||||
|
poll_fds : PGSList;
|
||||||
|
prev : PGSource;
|
||||||
|
next : PGSource;
|
||||||
|
reserved1 : gpointer;
|
||||||
|
reserved2 : gpointer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TCEFLinuxEventPipe = class;
|
||||||
|
|
||||||
|
PCustomGSource = ^TCustomGSource;
|
||||||
|
TCustomGSource = record
|
||||||
|
base : TGSource;
|
||||||
|
parent : TCEFLinuxEventPipe;
|
||||||
|
end;
|
||||||
|
|
||||||
|
PGPollFD = ^TGPollFD;
|
||||||
|
TGPollFD = record
|
||||||
|
fd : gint;
|
||||||
|
events : gushort;
|
||||||
|
revents : gushort;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOnPrepareEvent = procedure(Sender: TObject; var aTimeout: integer) of object;
|
||||||
|
TOnCheckEvent = procedure(Sender: TObject; var aMustDispatch: boolean) of object;
|
||||||
|
|
||||||
|
TCEFLinuxEventPipe = class
|
||||||
|
protected
|
||||||
|
FLibHandle : {$IFDEF FPC}TLibHandle{$ELSE}THandle{$ENDIF};
|
||||||
|
FWakeupGPollFD : TGPollFD;
|
||||||
|
FWorkSource : PCustomGSource;
|
||||||
|
FSourceFuncs : TGSourceFuncs;
|
||||||
|
FWakeupPipeRead : integer;
|
||||||
|
FWakeupPipeWrite : integer;
|
||||||
|
FPendingRead : integer;
|
||||||
|
FLibName : string;
|
||||||
|
FOnPrepare : TOnPrepareEvent;
|
||||||
|
FOnCheck : TOnCheckEvent;
|
||||||
|
FOnDispatch : TNotifyEvent;
|
||||||
|
|
||||||
|
function GetInitialized : boolean;
|
||||||
|
function GetHasData : boolean;
|
||||||
|
function GetHasPendingData : boolean;
|
||||||
|
|
||||||
|
function DoOnPrepare : integer;
|
||||||
|
function DoOnCheck : boolean;
|
||||||
|
procedure DoOnDispatch;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure InitializePipe;
|
||||||
|
function ReadAll(var aValue : integer) : boolean;
|
||||||
|
function Read(var aValue : integer) : boolean;
|
||||||
|
function Write(aValue : integer) : boolean;
|
||||||
|
|
||||||
|
property Initialized : boolean read GetInitialized;
|
||||||
|
property HasData : boolean read GetHasData;
|
||||||
|
property HasPendingData : boolean read GetHasPendingData;
|
||||||
|
property LibName : string read FLibName write FLibName;
|
||||||
|
property OnPrepare : TOnPrepareEvent read FOnPrepare write FOnPrepare;
|
||||||
|
property OnCheck : TOnCheckEvent read FOnCheck write FOnCheck;
|
||||||
|
property OnDispatch : TNotifyEvent read FOnDispatch write FOnDispatch;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
const
|
||||||
|
G_IO_IN = 1;
|
||||||
|
G_PRIORITY_DEFAULT_IDLE = 200;
|
||||||
|
|
||||||
|
var
|
||||||
|
g_main_context_default : function:PGMainContext;cdecl;
|
||||||
|
g_source_new : function(source_funcs:PGSourceFuncs; struct_size:guint):PGSource;cdecl;
|
||||||
|
g_source_add_poll : procedure(source:PGSource; fd:PGPollFD);cdecl;
|
||||||
|
g_source_set_priority : procedure(source:PGSource; priority:gint);cdecl;
|
||||||
|
g_source_set_can_recurse : procedure(source:PGSource; can_recurse:gboolean);cdecl;
|
||||||
|
g_source_attach : function(source:PGSource; context:PGMainContext):guint;cdecl;
|
||||||
|
g_source_destroy : procedure(source:PGSource);cdecl;
|
||||||
|
g_source_unref : procedure(source:PGSource);cdecl;
|
||||||
|
|
||||||
|
function WorkSourcePrepare(source:PGSource; timeout:pgint):gboolean; cdecl;
|
||||||
|
begin
|
||||||
|
timeout^ := PCustomGSource(source)^.parent.DoOnPrepare();
|
||||||
|
|
||||||
|
// We always return FALSE, so that our timeout is honored. If we were
|
||||||
|
// to return TRUE, the timeout would be considered to be 0 and the poll
|
||||||
|
// would never block. Once the poll is finished, Check will be called.
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function WorkSourceCheck(source:PGSource):gboolean; cdecl;
|
||||||
|
begin
|
||||||
|
// Only return TRUE if Dispatch should be called.
|
||||||
|
Result := PCustomGSource(source)^.parent.DoOnCheck();
|
||||||
|
end;
|
||||||
|
|
||||||
|
function WorkSourceDispatch(source:PGSource; callback:TGSourceFunc; user_data:gpointer):gboolean; cdecl;
|
||||||
|
begin
|
||||||
|
PCustomGSource(source)^.parent.DoOnDispatch();
|
||||||
|
|
||||||
|
// Always return TRUE so our source stays registered.
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
constructor TCEFLinuxEventPipe.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FLibName := 'libglib-2.0.so';
|
||||||
|
FLibHandle := 0;
|
||||||
|
FPendingRead := 0;
|
||||||
|
FWorkSource := nil;
|
||||||
|
FWakeupPipeRead := 0;
|
||||||
|
FWakeupPipeWrite := 0;
|
||||||
|
FOnPrepare := nil;
|
||||||
|
FOnCheck := nil;
|
||||||
|
FOnDispatch := nil;
|
||||||
|
|
||||||
|
FWakeupGPollFD.fd := 0;
|
||||||
|
FWakeupGPollFD.events := 0;
|
||||||
|
FWakeupGPollFD.revents := 0;
|
||||||
|
|
||||||
|
FSourceFuncs.prepare := nil;
|
||||||
|
FSourceFuncs.check := nil;
|
||||||
|
FSourceFuncs.dispatch := nil;
|
||||||
|
FSourceFuncs.finalize := nil;
|
||||||
|
FSourceFuncs.closure_callback := nil;
|
||||||
|
FSourceFuncs.closure_marshal := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TCEFLinuxEventPipe.Destroy;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
if assigned(FWorkSource) then
|
||||||
|
begin
|
||||||
|
g_source_destroy(PGSource(FWorkSource));
|
||||||
|
g_source_unref(PGSource(FWorkSource));
|
||||||
|
FWorkSource := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (FWakeupPipeRead <> 0) then
|
||||||
|
begin
|
||||||
|
FileClose(FWakeupPipeRead);
|
||||||
|
FWakeupPipeRead := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (FWakeupPipeWrite <> 0) then
|
||||||
|
begin
|
||||||
|
FileClose(FWakeupPipeWrite);
|
||||||
|
FWakeupPipeWrite := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (FLibHandle <> 0) then
|
||||||
|
begin
|
||||||
|
FreeLibrary(FLibHandle);
|
||||||
|
FLibHandle := 0;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCEFLinuxEventPipe.InitializePipe;
|
||||||
|
var
|
||||||
|
TempContext : PGMainContext;
|
||||||
|
begin
|
||||||
|
{$IFDEF FPC}
|
||||||
|
FLibHandle := LoadLibrary(FLibName);
|
||||||
|
{$ELSE}
|
||||||
|
FLibHandle := LoadLibrary(PChar(FLibName));
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
if FLibHandle = 0 then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
{$IFDEF FPC}Pointer({$ENDIF}g_main_context_default{$IFDEF FPC}){$ENDIF} := GetProcAddress(FLibHandle, 'g_main_context_default');
|
||||||
|
{$IFDEF FPC}Pointer({$ENDIF}g_source_new{$IFDEF FPC}){$ENDIF} := GetProcAddress(FLibHandle, 'g_source_new');
|
||||||
|
{$IFDEF FPC}Pointer({$ENDIF}g_source_add_poll{$IFDEF FPC}){$ENDIF} := GetProcAddress(FLibHandle, 'g_source_add_poll');
|
||||||
|
{$IFDEF FPC}Pointer({$ENDIF}g_source_set_priority{$IFDEF FPC}){$ENDIF} := GetProcAddress(FLibHandle, 'g_source_set_priority');
|
||||||
|
{$IFDEF FPC}Pointer({$ENDIF}g_source_set_can_recurse{$IFDEF FPC}){$ENDIF} := GetProcAddress(FLibHandle, 'g_source_set_can_recurse');
|
||||||
|
{$IFDEF FPC}Pointer({$ENDIF}g_source_attach{$IFDEF FPC}){$ENDIF} := GetProcAddress(FLibHandle, 'g_source_attach');
|
||||||
|
{$IFDEF FPC}Pointer({$ENDIF}g_source_destroy{$IFDEF FPC}){$ENDIF} := GetProcAddress(FLibHandle, 'g_source_destroy');
|
||||||
|
{$IFDEF FPC}Pointer({$ENDIF}g_source_unref{$IFDEF FPC}){$ENDIF} := GetProcAddress(FLibHandle, 'g_source_unref');
|
||||||
|
|
||||||
|
if assigned(g_main_context_default) and
|
||||||
|
assigned(g_source_new) and
|
||||||
|
assigned(g_source_add_poll) and
|
||||||
|
assigned(g_source_set_priority) and
|
||||||
|
assigned(g_source_set_can_recurse) and
|
||||||
|
assigned(g_source_attach) and
|
||||||
|
assigned(g_source_destroy) and
|
||||||
|
assigned(g_source_unref) and
|
||||||
|
(AssignPipe(FWakeupPipeRead, FWakeupPipeWrite) <> -1) then
|
||||||
|
begin
|
||||||
|
TempContext := g_main_context_default();
|
||||||
|
|
||||||
|
FWakeupGPollFD.fd := FWakeupPipeRead;
|
||||||
|
FWakeupGPollFD.events := G_IO_IN;
|
||||||
|
|
||||||
|
FSourceFuncs.check := {$IFDEF FPC}@{$ENDIF}WorkSourceCheck;
|
||||||
|
FSourceFuncs.dispatch := {$IFDEF FPC}@{$ENDIF}WorkSourceDispatch;
|
||||||
|
FSourceFuncs.prepare := {$IFDEF FPC}@{$ENDIF}WorkSourcePrepare;
|
||||||
|
|
||||||
|
FWorkSource := PCustomGSource(g_source_new(@FSourceFuncs, SizeOf(TCustomGSource)));
|
||||||
|
FWorkSource^.parent := self;
|
||||||
|
|
||||||
|
g_source_add_poll(PGSource(FWorkSource), @FWakeupGPollFD);
|
||||||
|
g_source_set_priority(PGSource(FWorkSource), G_PRIORITY_DEFAULT_IDLE);
|
||||||
|
g_source_set_can_recurse(PGSource(FWorkSource), True);
|
||||||
|
|
||||||
|
if (g_source_attach(PGSource(FWorkSource), TempContext) <= 0) then
|
||||||
|
FWorkSource := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCEFLinuxEventPipe.GetInitialized : boolean;
|
||||||
|
begin
|
||||||
|
Result := (FLibHandle <> 0) and
|
||||||
|
(FWakeupPipeRead <> 0) and
|
||||||
|
(FWakeupPipeWrite <> 0) and
|
||||||
|
assigned(FWorkSource);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCEFLinuxEventPipe.GetHasData : boolean;
|
||||||
|
begin
|
||||||
|
Result := ((FWakeupGPollFD.revents and G_IO_IN) <> 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCEFLinuxEventPipe.GetHasPendingData : boolean;
|
||||||
|
begin
|
||||||
|
Result := (FPendingRead > 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCEFLinuxEventPipe.DoOnPrepare : integer;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
|
||||||
|
if assigned(FOnPrepare) then
|
||||||
|
FOnPrepare(self, Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCEFLinuxEventPipe.DoOnCheck : boolean;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
|
||||||
|
if assigned(FOnCheck) then
|
||||||
|
FOnCheck(self, Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCEFLinuxEventPipe.DoOnDispatch;
|
||||||
|
begin
|
||||||
|
if assigned(FOnDispatch) then
|
||||||
|
FOnDispatch(self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCEFLinuxEventPipe.ReadAll(var aValue : integer) : boolean;
|
||||||
|
var
|
||||||
|
TempValues : array of integer;
|
||||||
|
TempRead : Longint;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
aValue := 0;
|
||||||
|
|
||||||
|
if Initialized and (FPendingRead > 0) then
|
||||||
|
try
|
||||||
|
SetLength(TempValues, FPendingRead);
|
||||||
|
|
||||||
|
TempRead := FileRead(FWakeupPipeRead, TempValues[0], SizeOf(integer) * FPendingRead);
|
||||||
|
TempRead := pred(TempRead div SizeOf(integer));
|
||||||
|
|
||||||
|
if (TempRead >= 0) then
|
||||||
|
begin
|
||||||
|
aValue := TempValues[TempRead];
|
||||||
|
FPendingRead := 0;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
Finalize(TempValues);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCEFLinuxEventPipe.Read(var aValue : integer) : boolean;
|
||||||
|
var
|
||||||
|
TempValue : integer;
|
||||||
|
TempRead : Longint;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
aValue := 0;
|
||||||
|
|
||||||
|
if Initialized and HasPendingData then
|
||||||
|
begin
|
||||||
|
TempRead := FileRead(FWakeupPipeRead, TempValue, SizeOf(integer));
|
||||||
|
|
||||||
|
if (TempRead >= 0) then
|
||||||
|
begin
|
||||||
|
dec(FPendingRead);
|
||||||
|
|
||||||
|
aValue := TempValue;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCEFLinuxEventPipe.Write(aValue : integer) : boolean;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
|
||||||
|
if Initialized and
|
||||||
|
(FileWrite(FWakeupPipeWrite, aValue, SizeOf(integer)) > 0) then
|
||||||
|
begin
|
||||||
|
inc(FPendingRead);
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -43,6 +43,8 @@ unit uCEFTimerWorkScheduler;
|
|||||||
|
|
||||||
{$I cef.inc}
|
{$I cef.inc}
|
||||||
|
|
||||||
|
{.$DEFINE USEEVENTPIPE}
|
||||||
|
|
||||||
{$IFNDEF TARGET_64BITS}{$ALIGN ON}{$ENDIF}
|
{$IFNDEF TARGET_64BITS}{$ALIGN ON}{$ENDIF}
|
||||||
{$MINENUMSIZE 4}
|
{$MINENUMSIZE 4}
|
||||||
|
|
||||||
@ -64,7 +66,8 @@ uses
|
|||||||
Messages,
|
Messages,
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
uCEFTypes, uCEFConstants, uCEFApplicationCore;
|
{$IFDEF USEEVENTPIPE}uCEFLinuxEventPipe,{$ENDIF} uCEFTypes, uCEFConstants,
|
||||||
|
uCEFApplicationCore;
|
||||||
|
|
||||||
type
|
type
|
||||||
TOnAllowEvent = procedure(Sender: TObject; var allow : boolean) of object;
|
TOnAllowEvent = procedure(Sender: TObject; var allow : boolean) of object;
|
||||||
@ -78,6 +81,10 @@ type
|
|||||||
FIsActive : boolean;
|
FIsActive : boolean;
|
||||||
FReentrancyDetected : boolean;
|
FReentrancyDetected : boolean;
|
||||||
FOnAllowDoWork : TOnAllowEvent;
|
FOnAllowDoWork : TOnAllowEvent;
|
||||||
|
{$IFDEF USEEVENTPIPE}
|
||||||
|
FEventPipe : TCEFLinuxEventPipe;
|
||||||
|
FDelayedWorkTime : TCefTime;
|
||||||
|
{$ENDIF}
|
||||||
{$IFDEF MSWINDOWS}
|
{$IFDEF MSWINDOWS}
|
||||||
FCompHandle : HWND;
|
FCompHandle : HWND;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
@ -85,6 +92,11 @@ type
|
|||||||
function GetIsTimerPending : boolean;
|
function GetIsTimerPending : boolean;
|
||||||
|
|
||||||
procedure Timer_OnTimer(Sender: TObject);
|
procedure Timer_OnTimer(Sender: TObject);
|
||||||
|
{$IFDEF USEEVENTPIPE}
|
||||||
|
procedure FEventPipe_OnPrepare(Sender: TObject; var aTimeout: integer);
|
||||||
|
procedure FEventPipe_OnCheck(Sender: TObject; var aMustDispatch: boolean);
|
||||||
|
procedure FEventPipe_OnDispatch(Sender: TObject);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
procedure Initialize;
|
procedure Initialize;
|
||||||
procedure CreateTimer;
|
procedure CreateTimer;
|
||||||
@ -127,14 +139,16 @@ implementation
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF DELPHI16_UP}
|
{$IFDEF DELPHI16_UP}
|
||||||
System.SysUtils, System.Math {$IFDEF MACOS}, System.RTTI, FMX.Forms, FMX.Platform{$ENDIF};
|
System.SysUtils, System.Math, {$IFDEF MACOS}System.RTTI, FMX.Forms, FMX.Platform,{$ENDIF}
|
||||||
{$ELSE}
|
{$ELSE}
|
||||||
SysUtils, Math;
|
SysUtils, Math,
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
uCEFMiscFunctions;
|
||||||
|
|
||||||
procedure DestroyGlobalCEFTimerWorkScheduler;
|
procedure DestroyGlobalCEFTimerWorkScheduler;
|
||||||
begin
|
begin
|
||||||
if (GlobalCEFTimerWorkScheduler <> nil) then FreeAndNil(GlobalCEFTimerWorkScheduler);
|
if (GlobalCEFTimerWorkScheduler <> nil) then
|
||||||
|
FreeAndNil(GlobalCEFTimerWorkScheduler);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
constructor TCEFTimerWorkScheduler.Create;
|
constructor TCEFTimerWorkScheduler.Create;
|
||||||
@ -146,6 +160,14 @@ begin
|
|||||||
{$IFDEF MSWINDOWS}
|
{$IFDEF MSWINDOWS}
|
||||||
AllocateWindowHandle;
|
AllocateWindowHandle;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF USEEVENTPIPE}
|
||||||
|
FEventPipe := TCEFLinuxEventPipe.Create;
|
||||||
|
FEventPipe.OnPrepare := {$IFDEF FPC}@{$ENDIF}FEventPipe_OnPrepare;
|
||||||
|
FEventPipe.OnCheck := {$IFDEF FPC}@{$ENDIF}FEventPipe_OnCheck;
|
||||||
|
FEventPipe.OnDispatch := {$IFDEF FPC}@{$ENDIF}FEventPipe_OnDispatch;
|
||||||
|
FEventPipe.InitializePipe;
|
||||||
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TCEFTimerWorkScheduler.Destroy;
|
destructor TCEFTimerWorkScheduler.Destroy;
|
||||||
@ -156,14 +178,25 @@ begin
|
|||||||
DeallocateWindowHandle;
|
DeallocateWindowHandle;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF USEEVENTPIPE}
|
||||||
|
if assigned(FEventPipe) then
|
||||||
|
FreeAndNil(FEventPipe);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCEFTimerWorkScheduler.Initialize;
|
procedure TCEFTimerWorkScheduler.Initialize;
|
||||||
begin
|
begin
|
||||||
{$IFDEF MSWINDOWS}
|
{$IFDEF MSWINDOWS}
|
||||||
FCompHandle := 0;
|
FCompHandle := 0;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF USEEVENTPIPE}
|
||||||
|
FEventPipe := nil;
|
||||||
|
InitializeCefTime(FDelayedWorkTime);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
FOnAllowDoWork := nil;
|
FOnAllowDoWork := nil;
|
||||||
FTimer := nil;
|
FTimer := nil;
|
||||||
FStopped := False;
|
FStopped := False;
|
||||||
@ -199,6 +232,33 @@ begin
|
|||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF USEEVENTPIPE}
|
||||||
|
procedure TCEFTimerWorkScheduler.FEventPipe_OnPrepare(Sender: TObject; var aTimeout: integer);
|
||||||
|
begin
|
||||||
|
aTimeout := GetTimeIntervalMilliseconds(FDelayedWorkTime);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCEFTimerWorkScheduler.FEventPipe_OnCheck(Sender: TObject; var aMustDispatch: boolean);
|
||||||
|
var
|
||||||
|
TempValue : integer;
|
||||||
|
begin
|
||||||
|
if FEventPipe.HasData or FEventPipe.HasPendingData then
|
||||||
|
begin
|
||||||
|
TempValue := 0;
|
||||||
|
FEventPipe.Read(TempValue);
|
||||||
|
OnScheduleWork(TempValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
aMustDispatch := GetTimeIntervalMilliseconds(FDelayedWorkTime) = 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCEFTimerWorkScheduler.FEventPipe_OnDispatch(Sender: TObject);
|
||||||
|
begin
|
||||||
|
KillTimer;
|
||||||
|
DoWork;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
procedure TCEFTimerWorkScheduler.StopScheduler;
|
procedure TCEFTimerWorkScheduler.StopScheduler;
|
||||||
begin
|
begin
|
||||||
FStopped := True;
|
FStopped := True;
|
||||||
@ -249,22 +309,34 @@ end;
|
|||||||
|
|
||||||
procedure TCEFTimerWorkScheduler.KillTimer;
|
procedure TCEFTimerWorkScheduler.KillTimer;
|
||||||
begin
|
begin
|
||||||
|
{$IFDEF USEEVENTPIPE}
|
||||||
|
InitializeCefTime(FDelayedWorkTime);
|
||||||
|
{$ELSE}
|
||||||
if (FTimer <> nil) then
|
if (FTimer <> nil) then
|
||||||
FTimer.Enabled := False;
|
FTimer.Enabled := False;
|
||||||
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCEFTimerWorkScheduler.SetTimer(aInterval : integer);
|
procedure TCEFTimerWorkScheduler.SetTimer(aInterval : integer);
|
||||||
begin
|
begin
|
||||||
|
{$IFDEF USEEVENTPIPE}
|
||||||
|
FDelayedWorkTime := DoubleToCefTime((DoubleTimeNow + aInterval) / 1000);
|
||||||
|
{$ELSE}
|
||||||
if (FTimer = nil) then
|
if (FTimer = nil) then
|
||||||
CreateTimer;
|
CreateTimer;
|
||||||
|
|
||||||
FTimer.Interval := aInterval;
|
FTimer.Interval := aInterval;
|
||||||
FTimer.Enabled := True;
|
FTimer.Enabled := True;
|
||||||
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TCEFTimerWorkScheduler.GetIsTimerPending : boolean;
|
function TCEFTimerWorkScheduler.GetIsTimerPending : boolean;
|
||||||
begin
|
begin
|
||||||
|
{$IFDEF USEEVENTPIPE}
|
||||||
|
Result := GetTimeIntervalMilliseconds(FDelayedWorkTime) > 0;
|
||||||
|
{$ELSE}
|
||||||
Result := (FTimer <> nil) and FTimer.Enabled;
|
Result := (FTimer <> nil) and FTimer.Enabled;
|
||||||
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCEFTimerWorkScheduler.OnScheduleWork(delay_ms : integer);
|
procedure TCEFTimerWorkScheduler.OnScheduleWork(delay_ms : integer);
|
||||||
@ -336,7 +408,25 @@ begin
|
|||||||
{$IFDEF MSWINDOWS}
|
{$IFDEF MSWINDOWS}
|
||||||
if (FCompHandle <> 0) then
|
if (FCompHandle <> 0) then
|
||||||
PostMessage(FCompHandle, CEF_PUMPHAVEWORK, 0, LPARAM(delay_ms));
|
PostMessage(FCompHandle, CEF_PUMPHAVEWORK, 0, LPARAM(delay_ms));
|
||||||
{$ELSE}
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$IFDEF USEEVENTPIPE}
|
||||||
|
if assigned(FEventPipe) then
|
||||||
|
FEventPipe.Write(integer(delay_ms));
|
||||||
|
{$ELSE}
|
||||||
|
Application.QueueAsyncCall(@OnScheduleWorkAsync, integer(delay_ms));
|
||||||
|
{$ENDIF}
|
||||||
|
{$ELSE}
|
||||||
|
TThread.ForceQueue(nil, procedure
|
||||||
|
begin
|
||||||
|
OnScheduleWork(integer(delay_ms));
|
||||||
|
end);
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF MACOS}
|
||||||
{$IFDEF FPC}
|
{$IFDEF FPC}
|
||||||
Application.QueueAsyncCall(@OnScheduleWorkAsync, integer(delay_ms));
|
Application.QueueAsyncCall(@OnScheduleWorkAsync, integer(delay_ms));
|
||||||
{$ELSE}
|
{$ELSE}
|
||||||
|
@ -2,7 +2,7 @@
|
|||||||
"UpdateLazPackages" : [
|
"UpdateLazPackages" : [
|
||||||
{
|
{
|
||||||
"ForceNotify" : true,
|
"ForceNotify" : true,
|
||||||
"InternalVersion" : 401,
|
"InternalVersion" : 402,
|
||||||
"Name" : "cef4delphi_lazarus.lpk",
|
"Name" : "cef4delphi_lazarus.lpk",
|
||||||
"Version" : "102.0.9.0"
|
"Version" : "102.0.9.0"
|
||||||
}
|
}
|
||||||
|
Loading…
Reference in New Issue
Block a user