You've already forked CEF4Delphi
mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2025-06-22 22:17:48 +02:00
Update to CEF 3.3202.1690.gcd6b88f
- Update to CEF 3.3202.1690.gcd6b88f - Bug fix #71 - Added the TCEFWorkScheduler class to handle the cef_do_message_loop_work calls when you use an external message pump. - Added 2 demos using the "external message pump" mode. - Added a TakeSnapshot function to the TChromium and TCEFWindowParent to take snapshots in non-OSR mode.
This commit is contained in:
Salvador Díaz Fau
@ -9,22 +9,23 @@ package CEF4Delphi;
|
||||
{$EXTENDEDSYNTAX ON}
|
||||
{$IMPORTEDDATA ON}
|
||||
{$IOCHECKS ON}
|
||||
{$LOCALSYMBOLS OFF}
|
||||
{$LOCALSYMBOLS ON}
|
||||
{$LONGSTRINGS ON}
|
||||
{$OPENSTRINGS ON}
|
||||
{$OPTIMIZATION ON}
|
||||
{$OPTIMIZATION OFF}
|
||||
{$OVERFLOWCHECKS OFF}
|
||||
{$RANGECHECKS OFF}
|
||||
{$REFERENCEINFO OFF}
|
||||
{$REFERENCEINFO ON}
|
||||
{$SAFEDIVIDE OFF}
|
||||
{$STACKFRAMES OFF}
|
||||
{$STACKFRAMES ON}
|
||||
{$TYPEDADDRESS OFF}
|
||||
{$VARSTRINGCHECKS ON}
|
||||
{$WRITEABLECONST OFF}
|
||||
{$MINENUMSIZE 1}
|
||||
{$IMAGEBASE $400000}
|
||||
{$DEFINE RELEASE}
|
||||
{$DEFINE DEBUG}
|
||||
{$ENDIF IMPLICITBUILDING}
|
||||
{$DESCRIPTION 'CEF4Delphi'}
|
||||
{$IMPLICITBUILD OFF}
|
||||
|
||||
requires
|
||||
@ -157,7 +158,8 @@ contains
|
||||
uCEFExtension in 'uCEFExtension.pas',
|
||||
uCEFExtensionHandler in 'uCEFExtensionHandler.pas',
|
||||
uBufferPanel in 'uBufferPanel.pas',
|
||||
uCEFApp in 'uCEFApp.pas';
|
||||
uCEFApp in 'uCEFApp.pas',
|
||||
uCEFWorkScheduler in 'uCEFWorkScheduler.pas';
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -250,6 +250,7 @@
|
||||
<DCCReference Include="uCEFExtensionHandler.pas"/>
|
||||
<DCCReference Include="uBufferPanel.pas"/>
|
||||
<DCCReference Include="uCEFApp.pas"/>
|
||||
<DCCReference Include="uCEFWorkScheduler.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
|
||||
@ -57,7 +57,7 @@ uses
|
||||
const
|
||||
CEF_SUPPORTED_VERSION_MAJOR = 3;
|
||||
CEF_SUPPORTED_VERSION_MINOR = 3202;
|
||||
CEF_SUPPORTED_VERSION_RELEASE = 1686;
|
||||
CEF_SUPPORTED_VERSION_RELEASE = 1690;
|
||||
CEF_SUPPORTED_VERSION_BUILD = 0;
|
||||
|
||||
CEF_CHROMEELF_VERSION_MAJOR = 62;
|
||||
@ -136,31 +136,32 @@ type
|
||||
FRenderProcessHandler : ICefRenderProcessHandler;
|
||||
|
||||
// ICefBrowserProcessHandler
|
||||
FOnContextInitializedEvent : TOnContextInitializedEvent;
|
||||
FOnBeforeChildProcessLaunchEvent : TOnBeforeChildProcessLaunchEvent;
|
||||
FOnRenderProcessThreadCreatedEvent : TOnRenderProcessThreadCreatedEvent;
|
||||
FOnScheduleMessagePumpWorkEvent : TOnScheduleMessagePumpWorkEvent;
|
||||
FOnContextInitialized : TOnContextInitializedEvent;
|
||||
FOnBeforeChildProcessLaunch : TOnBeforeChildProcessLaunchEvent;
|
||||
FOnRenderProcessThreadCreated : TOnRenderProcessThreadCreatedEvent;
|
||||
FOnScheduleMessagePumpWork : TOnScheduleMessagePumpWorkEvent;
|
||||
|
||||
// ICefResourceBundleHandler
|
||||
FOnGetLocalizedStringEvent : TOnGetLocalizedStringEvent;
|
||||
FOnGetDataResourceEvent : TOnGetDataResourceEvent;
|
||||
FOnGetDataResourceForScaleEvent : TOnGetDataResourceForScaleEvent;
|
||||
FOnGetLocalizedString : TOnGetLocalizedStringEvent;
|
||||
FOnGetDataResource : TOnGetDataResourceEvent;
|
||||
FOnGetDataResourceForScale : TOnGetDataResourceForScaleEvent;
|
||||
|
||||
// ICefRenderProcessHandler
|
||||
FOnRenderThreadCreated : TOnRenderThreadCreatedEvent;
|
||||
FOnWebKitInitialized : TOnWebKitInitializedEvent;
|
||||
FOnBrowserCreated : TOnBrowserCreatedEvent;
|
||||
FOnBrowserDestroyed : TOnBrowserDestroyedEvent;
|
||||
FOnBeforeNavigation : TOnBeforeNavigationEvent;
|
||||
FOnContextCreated : TOnContextCreatedEvent;
|
||||
FOnContextReleased : TOnContextReleasedEvent;
|
||||
FOnUncaughtException : TOnUncaughtExceptionEvent;
|
||||
FOnFocusedNodeChanged : TOnFocusedNodeChangedEvent;
|
||||
FOnProcessMessageReceived : TOnProcessMessageReceivedEvent;
|
||||
FOnRenderThreadCreated : TOnRenderThreadCreatedEvent;
|
||||
FOnWebKitInitialized : TOnWebKitInitializedEvent;
|
||||
FOnBrowserCreated : TOnBrowserCreatedEvent;
|
||||
FOnBrowserDestroyed : TOnBrowserDestroyedEvent;
|
||||
FOnBeforeNavigation : TOnBeforeNavigationEvent;
|
||||
FOnContextCreated : TOnContextCreatedEvent;
|
||||
FOnContextReleased : TOnContextReleasedEvent;
|
||||
FOnUncaughtException : TOnUncaughtExceptionEvent;
|
||||
FOnFocusedNodeChanged : TOnFocusedNodeChangedEvent;
|
||||
FOnProcessMessageReceived : TOnProcessMessageReceivedEvent;
|
||||
|
||||
procedure SetFrameworkDirPath(const aValue : ustring);
|
||||
procedure SetResourcesDirPath(const aValue : ustring);
|
||||
procedure SetLocalesDirPath(const aValue : ustring);
|
||||
procedure SetOsmodalLoop(aValue : boolean);
|
||||
|
||||
function GetChromeVersion : string;
|
||||
function GetLibCefPath : string;
|
||||
@ -235,6 +236,10 @@ type
|
||||
procedure AddCustomCommandLine(const aCommandLine : string; const aValue : string = '');
|
||||
function StartMainProcess : boolean;
|
||||
function StartSubProcess : boolean;
|
||||
|
||||
procedure DoMessageLoopWork;
|
||||
procedure RunMessageLoop;
|
||||
procedure QuitMessageLoop;
|
||||
procedure UpdateDeviceScaleFactor;
|
||||
|
||||
// Internal procedures. Only TInternalApp, TCefCustomBrowserProcessHandler,
|
||||
@ -332,19 +337,20 @@ type
|
||||
property ResourceBundleHandler : ICefResourceBundleHandler read FResourceBundleHandler write FResourceBundleHandler;
|
||||
property BrowserProcessHandler : ICefBrowserProcessHandler read FBrowserProcessHandler write FBrowserProcessHandler;
|
||||
property RenderProcessHandler : ICefRenderProcessHandler read FRenderProcessHandler write FRenderProcessHandler;
|
||||
property OsmodalLoop : boolean write SetOsmodalLoop;
|
||||
|
||||
property OnRegCustomSchemes : TOnRegisterCustomSchemes read FOnRegisterCustomSchemes write FOnRegisterCustomSchemes;
|
||||
|
||||
// ICefBrowserProcessHandler
|
||||
property OnContextInitialized : TOnContextInitializedEvent read FOnContextInitializedEvent write FOnContextInitializedEvent;
|
||||
property OnBeforeChildProcessLaunch : TOnBeforeChildProcessLaunchEvent read FOnBeforeChildProcessLaunchEvent write FOnBeforeChildProcessLaunchEvent;
|
||||
property OnRenderProcessThreadCreated : TOnRenderProcessThreadCreatedEvent read FOnRenderProcessThreadCreatedEvent write FOnRenderProcessThreadCreatedEvent;
|
||||
property OnScheduleMessagePumpWork : TOnScheduleMessagePumpWorkEvent read FOnScheduleMessagePumpWorkEvent write FOnScheduleMessagePumpWorkEvent;
|
||||
property OnContextInitialized : TOnContextInitializedEvent read FOnContextInitialized write FOnContextInitialized;
|
||||
property OnBeforeChildProcessLaunch : TOnBeforeChildProcessLaunchEvent read FOnBeforeChildProcessLaunch write FOnBeforeChildProcessLaunch;
|
||||
property OnRenderProcessThreadCreated : TOnRenderProcessThreadCreatedEvent read FOnRenderProcessThreadCreated write FOnRenderProcessThreadCreated;
|
||||
property OnScheduleMessagePumpWork : TOnScheduleMessagePumpWorkEvent read FOnScheduleMessagePumpWork write FOnScheduleMessagePumpWork;
|
||||
|
||||
// ICefResourceBundleHandler
|
||||
property OnGetLocalizedString : TOnGetLocalizedStringEvent read FOnGetLocalizedStringEvent write FOnGetLocalizedStringEvent;
|
||||
property OnGetDataResource : TOnGetDataResourceEvent read FOnGetDataResourceEvent write FOnGetDataResourceEvent;
|
||||
property OnGetDataResourceForScale : TOnGetDataResourceForScaleEvent read FOnGetDataResourceForScaleEvent write FOnGetDataResourceForScaleEvent;
|
||||
property OnGetLocalizedString : TOnGetLocalizedStringEvent read FOnGetLocalizedString write FOnGetLocalizedString;
|
||||
property OnGetDataResource : TOnGetDataResourceEvent read FOnGetDataResource write FOnGetDataResource;
|
||||
property OnGetDataResourceForScale : TOnGetDataResourceForScaleEvent read FOnGetDataResourceForScale write FOnGetDataResourceForScale;
|
||||
|
||||
// ICefRenderProcessHandler
|
||||
property OnRenderThreadCreated : TOnRenderThreadCreatedEvent read FOnRenderThreadCreated write FOnRenderThreadCreated;
|
||||
@ -440,27 +446,27 @@ begin
|
||||
FRenderProcessHandler := nil;
|
||||
|
||||
// ICefBrowserProcessHandler
|
||||
FOnContextInitializedEvent := nil;
|
||||
FOnBeforeChildProcessLaunchEvent := nil;
|
||||
FOnRenderProcessThreadCreatedEvent := nil;
|
||||
FOnScheduleMessagePumpWorkEvent := nil;
|
||||
FOnContextInitialized := nil;
|
||||
FOnBeforeChildProcessLaunch := nil;
|
||||
FOnRenderProcessThreadCreated := nil;
|
||||
FOnScheduleMessagePumpWork := nil;
|
||||
|
||||
// ICefResourceBundleHandler
|
||||
FOnGetLocalizedStringEvent := nil;
|
||||
FOnGetDataResourceEvent := nil;
|
||||
FOnGetDataResourceForScaleEvent := nil;
|
||||
FOnGetLocalizedString := nil;
|
||||
FOnGetDataResource := nil;
|
||||
FOnGetDataResourceForScale := nil;
|
||||
|
||||
// ICefRenderProcessHandler
|
||||
FOnRenderThreadCreated := nil;
|
||||
FOnWebKitInitialized := nil;
|
||||
FOnBrowserCreated := nil;
|
||||
FOnBrowserDestroyed := nil;
|
||||
FOnBeforeNavigation := nil;
|
||||
FOnContextCreated := nil;
|
||||
FOnContextReleased := nil;
|
||||
FOnUncaughtException := nil;
|
||||
FOnFocusedNodeChanged := nil;
|
||||
FOnProcessMessageReceived := nil;
|
||||
FOnRenderThreadCreated := nil;
|
||||
FOnWebKitInitialized := nil;
|
||||
FOnBrowserCreated := nil;
|
||||
FOnBrowserDestroyed := nil;
|
||||
FOnBeforeNavigation := nil;
|
||||
FOnContextCreated := nil;
|
||||
FOnContextReleased := nil;
|
||||
FOnUncaughtException := nil;
|
||||
FOnFocusedNodeChanged := nil;
|
||||
FOnProcessMessageReceived := nil;
|
||||
|
||||
UpdateDeviceScaleFactor;
|
||||
|
||||
@ -481,7 +487,14 @@ end;
|
||||
|
||||
destructor TCefApplication.Destroy;
|
||||
begin
|
||||
ShutDown;
|
||||
if FMustShutDown then ShutDown;
|
||||
|
||||
if (FLibHandle <> 0) then
|
||||
begin
|
||||
FreeLibrary(FLibHandle);
|
||||
FLibHandle := 0;
|
||||
FLibLoaded := False;
|
||||
end;
|
||||
|
||||
if (FCustomCommandLines <> nil) then FreeAndNil(FCustomCommandLines);
|
||||
if (FCustomCommandLineValues <> nil) then FreeAndNil(FCustomCommandLineValues);
|
||||
@ -615,78 +628,92 @@ function TCefApplication.CheckCEFLibrary : boolean;
|
||||
var
|
||||
TempString, TempPath : string;
|
||||
begin
|
||||
Result := False;
|
||||
if FCheckCEFFiles then
|
||||
Result := False
|
||||
else
|
||||
begin
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if not(FCheckCEFFiles) then
|
||||
|
||||
if not(CheckDLLs(FFrameworkDirPath)) then
|
||||
begin
|
||||
TempString := 'CEF framework files missing !' + CRLF + CRLF;
|
||||
|
||||
if GetAbsoluteDirPath(FFrameworkDirPath, TempPath) then
|
||||
begin
|
||||
if (length(TempPath) = 0) then TempPath := GetModulePath;
|
||||
TempString := TempString +
|
||||
'Make sure all the CEF framework files can be found in this directory :' +
|
||||
CRLF + SplitLongString(TempPath);
|
||||
end
|
||||
else
|
||||
TempString := TempString +
|
||||
'The CEF framework directory doesn' + #39 +'t exist!' +
|
||||
CRLF + SplitLongString(FFrameworkDirPath);
|
||||
|
||||
ShowErrorMessageDlg(TempString);
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
if not(CheckResources(FResourcesDirPath, FCheckDevToolsResources)) then
|
||||
begin
|
||||
TempString := 'CEF resources missing !' + CRLF + CRLF;
|
||||
|
||||
if GetAbsoluteDirPath(FResourcesDirPath, TempPath) then
|
||||
begin
|
||||
if (length(TempPath) = 0) then TempPath := GetModulePath;
|
||||
TempString := TempString +
|
||||
'Make sure all the CEF resources can be found in this directory :' +
|
||||
CRLF + SplitLongString(TempPath);
|
||||
end
|
||||
else
|
||||
TempString := TempString +
|
||||
'The CEF resources directory doesn' + #39 +'t exist!' +
|
||||
CRLF + SplitLongString(FResourcesDirPath);
|
||||
|
||||
ShowErrorMessageDlg(TempString);
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
if not(CheckLocales(FLocalesDirPath, FLocalesRequired)) then
|
||||
begin
|
||||
TempString := 'CEF locale files missing !' + CRLF + CRLF;
|
||||
|
||||
if GetAbsoluteDirPath(FLocalesDirPath, TempPath) then
|
||||
begin
|
||||
if (length(TempPath) = 0) then TempPath := GetModulePath + 'locales';
|
||||
TempString := TempString +
|
||||
'Make sure all the CEF locale files can be found in this directory :' +
|
||||
CRLF + SplitLongString(TempPath);
|
||||
end
|
||||
else
|
||||
TempString := TempString +
|
||||
'The CEF locales directory doesn' + #39 +'t exist!' +
|
||||
CRLF + SplitLongString(FLocalesDirPath);
|
||||
|
||||
ShowErrorMessageDlg(TempString);
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
if CheckDLLVersion(LibCefPath,
|
||||
CEF_SUPPORTED_VERSION_MAJOR,
|
||||
CEF_SUPPORTED_VERSION_MINOR,
|
||||
CEF_SUPPORTED_VERSION_RELEASE,
|
||||
CEF_SUPPORTED_VERSION_BUILD) then
|
||||
Result := True
|
||||
else
|
||||
begin
|
||||
if not(CheckDLLs(FFrameworkDirPath)) then
|
||||
begin
|
||||
TempString := 'CEF framework files missing !' + CRLF + CRLF;
|
||||
TempString := 'Unsupported CEF version !' +
|
||||
CRLF + CRLF +
|
||||
'Use only the CEF3 binaries specified in the CEF4Delphi Readme.md file at ' +
|
||||
CRLF + CEF4DELPHI_URL;
|
||||
|
||||
if GetAbsoluteDirPath(FFrameworkDirPath, TempPath) then
|
||||
begin
|
||||
if (length(TempPath) = 0) then TempPath := GetModulePath;
|
||||
TempString := TempString + 'Make sure all the CEF framework files can be found in this directory :' + CRLF + SplitLongString(TempPath);
|
||||
end
|
||||
else
|
||||
TempString := TempString + 'The CEF framework directory doesn' + #39 +'t exist!' + CRLF + SplitLongString(FFrameworkDirPath);
|
||||
|
||||
ShowErrorMessageDlg(TempString);
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
if not(CheckResources(FResourcesDirPath, FCheckDevToolsResources)) then
|
||||
begin
|
||||
TempString := 'CEF resources missing !' + CRLF + CRLF;
|
||||
|
||||
if GetAbsoluteDirPath(FResourcesDirPath, TempPath) then
|
||||
begin
|
||||
if (length(TempPath) = 0) then TempPath := GetModulePath;
|
||||
TempString := TempString + 'Make sure all the CEF resources can be found in this directory :' + CRLF + SplitLongString(TempPath);
|
||||
end
|
||||
else
|
||||
TempString := TempString + 'The CEF resources directory doesn' + #39 +'t exist!' + CRLF + SplitLongString(FResourcesDirPath);
|
||||
|
||||
ShowErrorMessageDlg(TempString);
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
if not(CheckLocales(FLocalesDirPath, FLocalesRequired)) then
|
||||
begin
|
||||
TempString := 'CEF locale files missing !' + CRLF + CRLF;
|
||||
|
||||
if GetAbsoluteDirPath(FLocalesDirPath, TempPath) then
|
||||
begin
|
||||
if (length(TempPath) = 0) then TempPath := GetModulePath + 'locales';
|
||||
TempString := TempString + 'Make sure all the CEF locale files can be found in this directory :' + CRLF + SplitLongString(TempPath);
|
||||
end
|
||||
else
|
||||
TempString := TempString + 'The CEF locales directory doesn' + #39 +'t exist!' + CRLF + SplitLongString(FLocalesDirPath);
|
||||
|
||||
ShowErrorMessageDlg(TempString);
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
if CheckDLLVersion(LibCefPath,
|
||||
CEF_SUPPORTED_VERSION_MAJOR,
|
||||
CEF_SUPPORTED_VERSION_MINOR,
|
||||
CEF_SUPPORTED_VERSION_RELEASE,
|
||||
CEF_SUPPORTED_VERSION_BUILD) then
|
||||
Result := True
|
||||
else
|
||||
begin
|
||||
TempString := 'Unsupported CEF version !' +
|
||||
CRLF + CRLF +
|
||||
'Use only the CEF3 binaries specified in the CEF4Delphi Readme.md file at ' +
|
||||
CRLF + CEF4DELPHI_URL;
|
||||
|
||||
ShowErrorMessageDlg(TempString);
|
||||
end;
|
||||
ShowErrorMessageDlg(TempString);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -716,6 +743,35 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCefApplication.DoMessageLoopWork;
|
||||
begin
|
||||
if FLibLoaded and
|
||||
not(FMultiThreadedMessageLoop) and
|
||||
FExternalMessagePump then
|
||||
cef_do_message_loop_work;
|
||||
end;
|
||||
|
||||
procedure TCefApplication.RunMessageLoop;
|
||||
begin
|
||||
if FLibLoaded and
|
||||
not(FMultiThreadedMessageLoop) and
|
||||
not(FExternalMessagePump) then
|
||||
cef_run_message_loop;
|
||||
end;
|
||||
|
||||
procedure TCefApplication.QuitMessageLoop;
|
||||
begin
|
||||
if FLibLoaded and
|
||||
not(FMultiThreadedMessageLoop) and
|
||||
FExternalMessagePump then
|
||||
cef_quit_message_loop;
|
||||
end;
|
||||
|
||||
procedure TCefApplication.SetOsmodalLoop(aValue : boolean);
|
||||
begin
|
||||
if FLibLoaded then cef_set_osmodal_loop(Ord(aValue));
|
||||
end;
|
||||
|
||||
procedure TCefApplication.UpdateDeviceScaleFactor;
|
||||
begin
|
||||
FDeviceScaleFactor := GetDeviceScaleFactor;
|
||||
@ -724,13 +780,7 @@ end;
|
||||
procedure TCefApplication.ShutDown;
|
||||
begin
|
||||
try
|
||||
if (FLibHandle <> 0) then
|
||||
begin
|
||||
if FMustShutDown then cef_shutdown;
|
||||
|
||||
FreeLibrary(FLibHandle);
|
||||
FLibHandle := 0;
|
||||
end;
|
||||
cef_shutdown;
|
||||
except
|
||||
on e : exception do
|
||||
if CustomExceptionHandler('TCefApplication.ShutDown', e) then raise;
|
||||
@ -948,43 +998,43 @@ begin
|
||||
InitializeCookies;
|
||||
FGlobalContextInitialized := True;
|
||||
|
||||
if assigned(FOnContextInitializedEvent) then FOnContextInitializedEvent;
|
||||
if assigned(FOnContextInitialized) then FOnContextInitialized;
|
||||
end;
|
||||
|
||||
procedure TCefApplication.Internal_OnBeforeChildProcessLaunch(const commandLine: ICefCommandLine);
|
||||
begin
|
||||
if assigned(FOnBeforeChildProcessLaunchEvent) then FOnBeforeChildProcessLaunchEvent(commandLine);
|
||||
if assigned(FOnBeforeChildProcessLaunch) then FOnBeforeChildProcessLaunch(commandLine);
|
||||
end;
|
||||
|
||||
procedure TCefApplication.Internal_OnRenderProcessThreadCreated(const extraInfo: ICefListValue);
|
||||
begin
|
||||
if assigned(FOnRenderProcessThreadCreatedEvent) then FOnRenderProcessThreadCreatedEvent(extraInfo);
|
||||
if assigned(FOnRenderProcessThreadCreated) then FOnRenderProcessThreadCreated(extraInfo);
|
||||
end;
|
||||
|
||||
procedure TCefApplication.Internal_OnScheduleMessagePumpWork(const delayMs: Int64);
|
||||
begin
|
||||
if assigned(FOnScheduleMessagePumpWorkEvent) then FOnScheduleMessagePumpWorkEvent(delayMs);
|
||||
if assigned(FOnScheduleMessagePumpWork) then FOnScheduleMessagePumpWork(delayMs);
|
||||
end;
|
||||
|
||||
function TCefApplication.Internal_GetLocalizedString(stringid: Integer; var stringVal: ustring) : boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if assigned(FOnGetLocalizedStringEvent) then FOnGetLocalizedStringEvent(stringId, stringVal, Result);
|
||||
if assigned(FOnGetLocalizedString) then FOnGetLocalizedString(stringId, stringVal, Result);
|
||||
end;
|
||||
|
||||
function TCefApplication.Internal_GetDataResource(resourceId: Integer; var data: Pointer; var dataSize: NativeUInt) : boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if assigned(FOnGetDataResourceEvent) then FOnGetDataResourceEvent(resourceId, data, dataSize, Result);
|
||||
if assigned(FOnGetDataResource) then FOnGetDataResource(resourceId, data, dataSize, Result);
|
||||
end;
|
||||
|
||||
function TCefApplication.Internal_GetDataResourceForScale(resourceId: Integer; scaleFactor: TCefScaleFactor; var data: Pointer; var dataSize: NativeUInt) : boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if assigned(FOnGetDataResourceForScaleEvent) then FOnGetDataResourceForScaleEvent(resourceId, scaleFactor, data, dataSize, Result);
|
||||
if assigned(FOnGetDataResourceForScale) then FOnGetDataResourceForScale(resourceId, scaleFactor, data, dataSize, Result);
|
||||
end;
|
||||
|
||||
procedure TCefApplication.Internal_OnRenderThreadCreated(const extraInfo: ICefListValue);
|
||||
@ -1155,9 +1205,9 @@ begin
|
||||
Result := not(HasResourceBundleHandler) and
|
||||
(FSingleProcess or
|
||||
((FProcessType = ptBrowser) and
|
||||
(assigned(FOnGetLocalizedStringEvent) or
|
||||
assigned(FOnGetDataResourceEvent) or
|
||||
assigned(FOnGetDataResourceForScaleEvent))));
|
||||
(assigned(FOnGetLocalizedString) or
|
||||
assigned(FOnGetDataResource) or
|
||||
assigned(FOnGetDataResourceForScale))));
|
||||
end;
|
||||
|
||||
function TCefApplication.GetMustCreateBrowserProcessHandler : boolean;
|
||||
|
||||
@ -445,6 +445,7 @@ type
|
||||
procedure SavePreferences(const aFileName : string);
|
||||
function SetNewBrowserParent(aNewParentHwnd : HWND) : boolean;
|
||||
procedure ResolveHost(const aURL : ustring);
|
||||
function TakeSnapshot(var aBitmap : TBitmap) : boolean;
|
||||
|
||||
procedure ShowDevTools(inspectElementAt: TPoint; const aDevTools : TWinControl);
|
||||
procedure CloseDevTools(const aDevTools : TWinControl = nil);
|
||||
@ -784,7 +785,7 @@ begin
|
||||
if (FHandler = nil) then
|
||||
begin
|
||||
FIsOSR := aIsOsr;
|
||||
FHandler := TVCLClientHandler.Create(Self, FIsOSR);
|
||||
FHandler := TCustomClientHandler.Create(Self, FIsOSR);
|
||||
Result := True;
|
||||
end;
|
||||
except
|
||||
@ -2023,6 +2024,42 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TChromium.TakeSnapshot(var aBitmap : TBitmap) : boolean;
|
||||
var
|
||||
TempHWND : HWND;
|
||||
TempDC : HDC;
|
||||
TempRect : TRect;
|
||||
TempWidth : Integer;
|
||||
TempHeight : Integer;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if not(FIsOSR) then
|
||||
begin
|
||||
TempHWND := GetWindowHandle;
|
||||
|
||||
if (TempHWND <> 0) then
|
||||
begin
|
||||
Winapi.Windows.GetClientRect(TempHWND, TempRect);
|
||||
|
||||
TempDC := GetDC(TempHWND);
|
||||
TempWidth := TempRect.Right - TempRect.Left;
|
||||
TempHeight := TempRect.Bottom - TempRect.Top;
|
||||
|
||||
if (aBitmap <> nil) then FreeAndNil(aBitmap);
|
||||
|
||||
aBitmap := TBitmap.Create;
|
||||
aBitmap.Height := TempHeight;
|
||||
aBitmap.Width := TempWidth;
|
||||
|
||||
Result := BitBlt(aBitmap.Canvas.Handle, 0, 0, TempWidth, TempHeight,
|
||||
TempDC, 0, 0, SRCCOPY);
|
||||
|
||||
ReleaseDC(TempHWND, TempDC);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChromium.SimulateMouseWheel(aDeltaX, aDeltaY : integer);
|
||||
var
|
||||
TempEvent : TCefMouseEvent;
|
||||
|
||||
@ -137,24 +137,6 @@ type
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TVCLClientHandler = class(TCustomClientHandler)
|
||||
protected
|
||||
function GetMultithreadApp : boolean;
|
||||
function GetExternalMessagePump : boolean;
|
||||
|
||||
public
|
||||
constructor Create(const crm: IChromiumEvents; renderer: Boolean); reintroduce;
|
||||
destructor Destroy; override;
|
||||
|
||||
property MultithreadApp : boolean read GetMultithreadApp;
|
||||
property ExternalMessagePump : boolean read GetExternalMessagePump;
|
||||
end;
|
||||
|
||||
var
|
||||
CefInstances : Integer = 0;
|
||||
|
||||
procedure CefDoMessageLoopWork;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@ -169,11 +151,8 @@ uses
|
||||
uCEFLifeSpanHandler, uCEFRequestHandler, uCEFRenderHandler, uCEFDragHandler,
|
||||
uCEFFindHandler, uCEFConstants, uCEFApplication;
|
||||
|
||||
var
|
||||
looping : Boolean = False;
|
||||
CefTimer : UINT = 0;
|
||||
|
||||
// ******************************************************
|
||||
// ******************************************************
|
||||
// ****************** TCefClientRef *********************
|
||||
// ******************************************************
|
||||
|
||||
@ -265,26 +244,6 @@ end;
|
||||
// ****************** TCefClientOwn *********************
|
||||
// ******************************************************
|
||||
|
||||
procedure CefDoMessageLoopWork;
|
||||
begin
|
||||
if looping then Exit;
|
||||
|
||||
if (CefInstances > 0) then
|
||||
begin
|
||||
looping := True;
|
||||
|
||||
try
|
||||
cef_do_message_loop_work;
|
||||
finally
|
||||
looping := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TimerProc(hwnd: HWND; uMsg: UINT; idEvent: Pointer; dwTime: DWORD); stdcall;
|
||||
begin
|
||||
CefDoMessageLoopWork;
|
||||
end;
|
||||
|
||||
function cef_client_own_get_context_menu_handler(self: PCefClient): PCefContextMenuHandler; stdcall;
|
||||
begin
|
||||
@ -607,68 +566,4 @@ begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
|
||||
// ******************************************************
|
||||
// **************** TVCLClientHandler *******************
|
||||
// ******************************************************
|
||||
|
||||
|
||||
constructor TVCLClientHandler.Create(const crm: IChromiumEvents; renderer : Boolean);
|
||||
begin
|
||||
inherited Create(crm, renderer);
|
||||
|
||||
if not(MultithreadApp) and not(ExternalMessagePump) then
|
||||
begin
|
||||
if (CefInstances = 0) then CefTimer := SetTimer(0, 0, CEF_USER_TIMER_MINIMUM, @TimerProc);
|
||||
InterlockedIncrement(CefInstances);
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TVCLClientHandler.Destroy;
|
||||
begin
|
||||
try
|
||||
try
|
||||
if not(MultithreadApp) and not(ExternalMessagePump) then
|
||||
begin
|
||||
InterlockedDecrement(CefInstances);
|
||||
|
||||
if (CefInstances = 0) and (CefTimer <> 0) then
|
||||
begin
|
||||
KillTimer(0, CefTimer);
|
||||
CefTimer := 0;
|
||||
end;
|
||||
end;
|
||||
except
|
||||
on e : exception do
|
||||
if CustomExceptionHandler('TVCLClientHandler.Destroy', e) then raise;
|
||||
end;
|
||||
finally
|
||||
inherited Destroy;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TVCLClientHandler.GetMultithreadApp : boolean;
|
||||
begin
|
||||
Result := True;
|
||||
|
||||
try
|
||||
if (GlobalCEFApp <> nil) then Result := GlobalCEFApp.MultiThreadedMessageLoop;
|
||||
except
|
||||
on e : exception do
|
||||
if CustomExceptionHandler('TVCLClientHandler.GetMultithreadApp', e) then raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TVCLClientHandler.GetExternalMessagePump : boolean;
|
||||
begin
|
||||
Result := True;
|
||||
|
||||
try
|
||||
if (GlobalCEFApp <> nil) then Result := GlobalCEFApp.ExternalMessagePump;
|
||||
except
|
||||
on e : exception do
|
||||
if CustomExceptionHandler('TVCLClientHandler.GetExternalMessagePump', e) then raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -361,9 +361,13 @@ const
|
||||
|
||||
// Used in the severity parameter of cef_log
|
||||
CEF_LOG_SEVERITY_INFO = 0;
|
||||
CEF_LOG_SEVERITY_WARNING = 1;
|
||||
CEF_LOG_SEVERITY_ERROR = 2;
|
||||
|
||||
CEF_LOG_SEVERITY_ERROR = 2;
|
||||
|
||||
ZOOM_STEP_25 = 0;
|
||||
ZOOM_STEP_33 = 1;
|
||||
ZOOM_STEP_50 = 2;
|
||||
ZOOM_STEP_67 = 3;
|
||||
ZOOM_STEP_75 = 4;
|
||||
ZOOM_STEP_90 = 5;
|
||||
ZOOM_STEP_100 = 6;
|
||||
|
||||
@ -301,7 +301,7 @@ type
|
||||
function IsReadOnly: Boolean;
|
||||
function HasExcludedElements: Boolean;
|
||||
function GetCount: NativeUInt;
|
||||
function GetElements(Count: NativeUInt): IInterfaceList; // ICefPostDataElement
|
||||
function GetElements(Count: NativeUInt): IInterfaceList; // list of ICefPostDataElement
|
||||
function RemoveElement(const element: ICefPostDataElement): Integer;
|
||||
function AddElement(const element: ICefPostDataElement): Integer;
|
||||
procedure RemoveElements;
|
||||
|
||||
@ -53,11 +53,11 @@ uses
|
||||
{$ELSE}
|
||||
Classes,
|
||||
{$ENDIF}
|
||||
uCEFChromium, uCEFWindowParent, uCEFChromiumWindow, uBufferPanel;
|
||||
uCEFChromium, uCEFWindowParent, uCEFChromiumWindow, uBufferPanel, uCEFWorkScheduler;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('Chromium', [TChromium, TCEFWindowParent, TChromiumWindow, TBufferPanel]);
|
||||
RegisterComponents('Chromium', [TChromium, TCEFWindowParent, TChromiumWindow, TBufferPanel, TCEFWorkScheduler]);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -48,9 +48,9 @@ interface
|
||||
|
||||
uses
|
||||
{$IFDEF DELPHI16_UP}
|
||||
WinApi.Windows, WinApi.Messages, System.Classes, Vcl.Controls,
|
||||
WinApi.Windows, WinApi.Messages, System.Classes, Vcl.Controls, Vcl.Graphics,
|
||||
{$ELSE}
|
||||
Windows, Messages, Classes, Controls,
|
||||
Windows, Messages, Classes, Controls, Graphics,
|
||||
{$ENDIF}
|
||||
uCEFTypes, uCEFInterfaces;
|
||||
|
||||
@ -64,6 +64,8 @@ type
|
||||
|
||||
public
|
||||
procedure UpdateSize;
|
||||
function TakeSnapshot(var aBitmap : TBitmap) : boolean;
|
||||
|
||||
property ChildWindowHandle : THandle read GetChildWindowHandle;
|
||||
|
||||
published
|
||||
@ -144,4 +146,33 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCEFWindowParent.TakeSnapshot(var aBitmap : TBitmap) : boolean;
|
||||
var
|
||||
TempHWND : HWND;
|
||||
TempDC : HDC;
|
||||
TempRect : TRect;
|
||||
TempWidth : Integer;
|
||||
TempHeight : Integer;
|
||||
begin
|
||||
Result := False;
|
||||
TempHWND := ChildWindowHandle;
|
||||
|
||||
if (TempHWND <> 0) then
|
||||
begin
|
||||
Winapi.Windows.GetClientRect(TempHWND, TempRect);
|
||||
TempDC := GetDC(TempHWND);
|
||||
TempWidth := TempRect.Right - TempRect.Left;
|
||||
TempHeight := TempRect.Bottom - TempRect.Top;
|
||||
|
||||
aBitmap := TBitmap.Create;
|
||||
aBitmap.Height := TempHeight;
|
||||
aBitmap.Width := TempWidth;
|
||||
|
||||
Result := BitBlt(aBitmap.Canvas.Handle, 0, 0, TempWidth, TempHeight,
|
||||
TempDC, 0, 0, SRCCOPY);
|
||||
|
||||
ReleaseDC(TempHWND, TempDC);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
266
source/uCEFWorkScheduler.pas
Normal file
266
source/uCEFWorkScheduler.pas
Normal file
@ -0,0 +1,266 @@
|
||||
// ************************************************************************
|
||||
// ***************************** 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 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.
|
||||
*
|
||||
*)
|
||||
|
||||
unit uCEFWorkScheduler;
|
||||
|
||||
{$IFNDEF CPUX64}
|
||||
{$ALIGN ON}
|
||||
{$MINENUMSIZE 4}
|
||||
{$ENDIF}
|
||||
|
||||
{$I cef.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{$IFDEF DELPHI16_UP}
|
||||
WinApi.Windows, WinApi.Messages, System.Classes, Vcl.Controls, Vcl.Graphics, Vcl.Forms,
|
||||
{$ELSE}
|
||||
Windows, Messages, Classes, Controls, Graphics, Forms,
|
||||
{$ENDIF}
|
||||
uCEFTypes, uCEFInterfaces, uCEFLibFunctions, uCEFMiscFunctions, uCEFConstants;
|
||||
|
||||
const
|
||||
TIMER_NIDEVENT = 1;
|
||||
TIMER_DEPLETEWORK_CYCLES = 10;
|
||||
TIMER_DEPLETEWORK_DELAY = 50;
|
||||
|
||||
type
|
||||
TCEFWorkScheduler = class(TComponent)
|
||||
protected
|
||||
FCompHandle : HWND;
|
||||
FDepleteWorkCycles : cardinal;
|
||||
FDepleteWorkDelay : cardinal;
|
||||
FTimerPending : boolean;
|
||||
FIsActive : boolean;
|
||||
FReentrancyDetected : boolean;
|
||||
FStopped : boolean;
|
||||
|
||||
procedure WndProc(var aMessage: TMessage);
|
||||
function SendCompMessage(aMsg, wParam : cardinal; lParam : integer) : boolean;
|
||||
procedure CreateTimer(const delay_ms : int64);
|
||||
procedure TimerTimeout;
|
||||
procedure DoWork;
|
||||
procedure ScheduleWork(const delay_ms : int64);
|
||||
procedure DoMessageLoopWork;
|
||||
function PerformMessageLoopWork : boolean;
|
||||
procedure DestroyTimer;
|
||||
procedure DeallocateWindowHandle;
|
||||
procedure DepleteWork;
|
||||
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure AfterConstruction; override;
|
||||
procedure ScheduleMessagePumpWork(const delay_ms : int64);
|
||||
procedure StopScheduler;
|
||||
|
||||
property IsTimerPending : boolean read FTimerPending;
|
||||
|
||||
published
|
||||
property DepleteWorkCycles : cardinal read FDepleteWorkCycles write FDepleteWorkCycles default TIMER_DEPLETEWORK_CYCLES;
|
||||
property DepleteWorkDelay : cardinal read FDepleteWorkDelay write FDepleteWorkDelay default TIMER_DEPLETEWORK_DELAY;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
{$IFDEF DELPHI16_UP}
|
||||
System.SysUtils, System.Math,
|
||||
{$ELSE}
|
||||
SysUtils, Math,
|
||||
{$ENDIF}
|
||||
uCEFApplication;
|
||||
|
||||
|
||||
constructor TCEFWorkScheduler.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
FCompHandle := 0;
|
||||
FTimerPending := False;
|
||||
FIsActive := False;
|
||||
FReentrancyDetected := False;
|
||||
FStopped := False;
|
||||
FDepleteWorkCycles := TIMER_DEPLETEWORK_CYCLES;
|
||||
FDepleteWorkDelay := TIMER_DEPLETEWORK_DELAY;
|
||||
end;
|
||||
|
||||
destructor TCEFWorkScheduler.Destroy;
|
||||
begin
|
||||
DestroyTimer;
|
||||
DeallocateWindowHandle;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCEFWorkScheduler.AfterConstruction;
|
||||
begin
|
||||
inherited AfterConstruction;
|
||||
|
||||
if not(csDesigning in ComponentState) then
|
||||
FCompHandle := AllocateHWnd(WndProc);
|
||||
end;
|
||||
|
||||
procedure TCEFWorkScheduler.WndProc(var aMessage: TMessage);
|
||||
begin
|
||||
case aMessage.Msg of
|
||||
WM_TIMER : TimerTimeout;
|
||||
CEF_PUMPHAVEWORK : ScheduleWork(aMessage.lParam);
|
||||
else aMessage.Result := DefWindowProc(FCompHandle, aMessage.Msg, aMessage.WParam, aMessage.LParam);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCEFWorkScheduler.SendCompMessage(aMsg, wParam : cardinal; lParam : integer) : boolean;
|
||||
begin
|
||||
Result := not(FStopped) and (FCompHandle <> 0) and PostMessage(FCompHandle, aMsg, wParam, lParam);
|
||||
end;
|
||||
|
||||
procedure TCEFWorkScheduler.CreateTimer(const delay_ms : int64);
|
||||
begin
|
||||
if not(FTimerPending) and
|
||||
not(FStopped) and
|
||||
(delay_ms > 0) and
|
||||
(SetTimer(FCompHandle, TIMER_NIDEVENT, cardinal(delay_ms), nil) <> 0) then
|
||||
FTimerPending := True;
|
||||
end;
|
||||
|
||||
procedure TCEFWorkScheduler.DestroyTimer;
|
||||
begin
|
||||
if FTimerPending and KillTimer(FCompHandle, TIMER_NIDEVENT) then FTimerPending := False;
|
||||
end;
|
||||
|
||||
procedure TCEFWorkScheduler.DeallocateWindowHandle;
|
||||
begin
|
||||
if (FCompHandle <> 0) then
|
||||
begin
|
||||
DeallocateHWnd(FCompHandle);
|
||||
FCompHandle := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCEFWorkScheduler.DepleteWork;
|
||||
var
|
||||
i : cardinal;
|
||||
begin
|
||||
i := FDepleteWorkCycles;
|
||||
|
||||
while (i > 0) do
|
||||
begin
|
||||
DoMessageLoopWork;
|
||||
Sleep(FDepleteWorkDelay);
|
||||
dec(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCEFWorkScheduler.ScheduleMessagePumpWork(const delay_ms : int64);
|
||||
begin
|
||||
SendCompMessage(CEF_PUMPHAVEWORK, 0, LPARAM(delay_ms));
|
||||
end;
|
||||
|
||||
procedure TCEFWorkScheduler.StopScheduler;
|
||||
begin
|
||||
FStopped := True;
|
||||
DestroyTimer;
|
||||
DepleteWork;
|
||||
DeallocateWindowHandle;
|
||||
end;
|
||||
|
||||
procedure TCEFWorkScheduler.TimerTimeout;
|
||||
begin
|
||||
if not(FStopped) then
|
||||
begin
|
||||
DestroyTimer;
|
||||
DoWork;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCEFWorkScheduler.DoWork;
|
||||
var
|
||||
TempWasReentrant : boolean;
|
||||
begin
|
||||
TempWasReentrant := PerformMessageLoopWork;
|
||||
|
||||
if TempWasReentrant then
|
||||
ScheduleMessagePumpWork(0)
|
||||
else
|
||||
if not(IsTimerPending) then
|
||||
ScheduleMessagePumpWork(CEF_TIMER_DELAY_PLACEHOLDER);
|
||||
end;
|
||||
|
||||
procedure TCEFWorkScheduler.ScheduleWork(const delay_ms : int64);
|
||||
begin
|
||||
if FStopped or
|
||||
((delay_ms = CEF_TIMER_DELAY_PLACEHOLDER) and IsTimerPending) then
|
||||
exit;
|
||||
|
||||
DestroyTimer;
|
||||
|
||||
if (delay_ms <= 0) then
|
||||
DoWork
|
||||
else
|
||||
if (delay_ms > CEF_TIMER_MAXDELAY) then
|
||||
CreateTimer(CEF_TIMER_MAXDELAY)
|
||||
else
|
||||
CreateTimer(delay_ms);
|
||||
end;
|
||||
|
||||
procedure TCEFWorkScheduler.DoMessageLoopWork;
|
||||
begin
|
||||
if (GlobalCEFApp <> nil) then GlobalCEFApp.DoMessageLoopWork;
|
||||
end;
|
||||
|
||||
function TCEFWorkScheduler.PerformMessageLoopWork : boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if FIsActive then
|
||||
begin
|
||||
FReentrancyDetected := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
FReentrancyDetected := False;
|
||||
|
||||
FIsActive := True;
|
||||
DoMessageLoopWork;
|
||||
FIsActive := False;
|
||||
|
||||
Result := FReentrancyDetected;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user