pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-12-03 21:44:45 +02:00
Code Issues Actions 1 Releases Activity

Added an experimental TCEFLinuxEventPipe class for Linux in Lazarus

Browse Source
This commit is contained in:
salvadordf
2022-06-14 15:22:50 +02:00
parent 67d3e5e528
commit 65aa181694
7 changed files with 531 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

106
source/uCEFTimerWorkScheduler.pas
View File

@@ -43,6 +43,8 @@ unit uCEFTimerWorkScheduler;
{$I cef.inc}
{.$DEFINE USEEVENTPIPE}
{$IFNDEF TARGET_64BITS}{$ALIGN ON}{$ENDIF}
{$MINENUMSIZE 4}
@@ -64,7 +66,8 @@ uses
Messages,
{$ENDIF}
{$ENDIF}
uCEFTypes, uCEFConstants, uCEFApplicationCore;
{$IFDEF USEEVENTPIPE}uCEFLinuxEventPipe,{$ENDIF} uCEFTypes, uCEFConstants,
uCEFApplicationCore;
type
TOnAllowEvent = procedure(Sender: TObject; var allow : boolean) of object;
@@ -78,6 +81,10 @@ type
FIsActive : boolean;
FReentrancyDetected : boolean;
FOnAllowDoWork : TOnAllowEvent;
{$IFDEF USEEVENTPIPE}
FEventPipe : TCEFLinuxEventPipe;
FDelayedWorkTime : TCefTime;
{$ENDIF}
{$IFDEF MSWINDOWS}
FCompHandle : HWND;
{$ENDIF}
@@ -85,6 +92,11 @@ type
function GetIsTimerPending : boolean;
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 CreateTimer;
@@ -127,14 +139,16 @@ implementation
uses
{$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}
SysUtils, Math;
SysUtils, Math,
{$ENDIF}
uCEFMiscFunctions;
procedure DestroyGlobalCEFTimerWorkScheduler;
begin
if (GlobalCEFTimerWorkScheduler <> nil) then FreeAndNil(GlobalCEFTimerWorkScheduler);
if (GlobalCEFTimerWorkScheduler <> nil) then
FreeAndNil(GlobalCEFTimerWorkScheduler);
end;
constructor TCEFTimerWorkScheduler.Create;
@@ -146,6 +160,14 @@ begin
{$IFDEF MSWINDOWS}
AllocateWindowHandle;
{$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;
destructor TCEFTimerWorkScheduler.Destroy;
@@ -156,14 +178,25 @@ begin
DeallocateWindowHandle;
{$ENDIF}
{$IFDEF USEEVENTPIPE}
if assigned(FEventPipe) then
FreeAndNil(FEventPipe);
{$ENDIF}
inherited Destroy;
end;
procedure TCEFTimerWorkScheduler.Initialize;
begin
{$IFDEF MSWINDOWS}
FCompHandle := 0;
FCompHandle := 0;
{$ENDIF}
{$IFDEF USEEVENTPIPE}
FEventPipe := nil;
InitializeCefTime(FDelayedWorkTime);
{$ENDIF}
FOnAllowDoWork := nil;
FTimer := nil;
FStopped := False;
@@ -199,6 +232,33 @@ begin
end;
{$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;
begin
FStopped := True;
@@ -249,22 +309,34 @@ end;
procedure TCEFTimerWorkScheduler.KillTimer;
begin
{$IFDEF USEEVENTPIPE}
InitializeCefTime(FDelayedWorkTime);
{$ELSE}
if (FTimer <> nil) then
FTimer.Enabled := False;
{$ENDIF}
end;
procedure TCEFTimerWorkScheduler.SetTimer(aInterval : integer);
begin
{$IFDEF USEEVENTPIPE}
FDelayedWorkTime := DoubleToCefTime((DoubleTimeNow + aInterval) / 1000);
{$ELSE}
if (FTimer = nil) then
CreateTimer;
FTimer.Interval := aInterval;
FTimer.Enabled := True;
FTimer.Interval := aInterval;
FTimer.Enabled := True;
{$ENDIF}
end;
function TCEFTimerWorkScheduler.GetIsTimerPending : boolean;
begin
{$IFDEF USEEVENTPIPE}
Result := GetTimeIntervalMilliseconds(FDelayedWorkTime) > 0;
{$ELSE}
Result := (FTimer <> nil) and FTimer.Enabled;
{$ENDIF}
end;
procedure TCEFTimerWorkScheduler.OnScheduleWork(delay_ms : integer);
@@ -336,7 +408,25 @@ begin
{$IFDEF MSWINDOWS}
if (FCompHandle <> 0) then
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}
Application.QueueAsyncCall(@OnScheduleWorkAsync, integer(delay_ms));
{$ELSE}