CEF4Delphi/source/uCEFApplication.pas
salvadordf ca8bc9dff4 Added cef4delphi.chm help file
Added the PDS file to extract the HTML Help files using PasDoc
Added more XML documentation
Fixed some XML errors.
Removed the license copy from the pas units.
Updated the LICENSE.md file
2023-08-09 19:38:57 +02:00

326 lines
11 KiB
ObjectPascal

unit uCEFApplication;
{$IFDEF FPC}
{$MODE OBJFPC}{$H+}
{$ENDIF}
{$I cef.inc}
{$IFNDEF TARGET_64BITS}{$ALIGN ON}{$ENDIF}
{$MINENUMSIZE 4}
interface
uses
{$IFDEF DELPHI16_UP}
{$IFDEF MSWINDOWS}
WinApi.Windows, WinApi.ActiveX,
{$IFDEF FMX}
FMX.Forms,
{$ELSE}
Vcl.Forms,
{$ENDIF}
{$ENDIF}
System.Classes, System.UITypes,
{$ELSE}
Forms,
{$IFDEF MSWINDOWS}Windows, ActiveX,{$ENDIF} Classes, Controls, {$IFDEF FPC}dynlibs,{$ENDIF}
{$ENDIF}
{$IFDEF FPC}
LCLProc,
{$ENDIF}
uCEFApplicationCore, uCEFTypes;
const
CEF_SUPPORTED_VERSION_MAJOR = uCefApplicationCore.CEF_SUPPORTED_VERSION_MAJOR;
CEF_SUPPORTED_VERSION_MINOR = uCefApplicationCore.CEF_SUPPORTED_VERSION_MINOR;
CEF_SUPPORTED_VERSION_RELEASE = uCefApplicationCore.CEF_SUPPORTED_VERSION_RELEASE;
CEF_SUPPORTED_VERSION_BUILD = uCefApplicationCore.CEF_SUPPORTED_VERSION_BUILD;
CEF_CHROMEELF_VERSION_MAJOR = uCefApplicationCore.CEF_CHROMEELF_VERSION_MAJOR;
CEF_CHROMEELF_VERSION_MINOR = uCefApplicationCore.CEF_CHROMEELF_VERSION_MINOR;
CEF_CHROMEELF_VERSION_RELEASE = uCefApplicationCore.CEF_CHROMEELF_VERSION_RELEASE;
CEF_CHROMEELF_VERSION_BUILD = uCefApplicationCore.CEF_CHROMEELF_VERSION_BUILD;
LIBCEF_DLL = uCefApplicationCore.LIBCEF_DLL;
CHROMEELF_DLL = uCefApplicationCore.CHROMEELF_DLL;
type
/// <summary>
/// Main class used to simplify the CEF initialization and destruction.
/// </summary>
TCefApplication = class(TCefApplicationCore)
protected
FDestroyApplicationObject : boolean;
FDestroyAppWindows : boolean;
{$IFDEF FPC}
FContextInitializedHandlers : TMethodList;
procedure CallContextInitializedHandlers(Data: PtrInt);
procedure doOnContextInitialized; override;
{$ENDIF}
procedure BeforeInitSubProcess; override;
public
constructor Create;
destructor Destroy; override;
procedure UpdateDeviceScaleFactor; override;
property DestroyApplicationObject : boolean read FDestroyApplicationObject write FDestroyApplicationObject;
property DestroyAppWindows : boolean read FDestroyAppWindows write FDestroyAppWindows;
{$IFDEF FPC}
Procedure AddContextInitializedHandler(AHandler: TNotifyEvent);
Procedure RemoveContextInitializedHandler(AHandler: TNotifyEvent);
{$ENDIF}
end;
TCEFDirectoryDeleterThread = uCEFApplicationCore.TCEFDirectoryDeleterThread;
var
GlobalCEFApp : TCefApplication = nil;
function CefCursorToWindowsCursor(aCefCursor : TCefCursorType) : TCursor;
procedure DestroyGlobalCEFApp;
// *********************************************************
// ********************** ATTENTION ! **********************
// *********************************************************
// ** **
// ** MANY OF THE EVENTS IN CEF4DELPHI COMPONENTS LIKE **
// ** TCHROMIUM, TFMXCHROMIUM OR TCEFAPPLICATION ARE **
// ** EXECUTED IN A CEF THREAD BY DEFAULT. **
// ** **
// ** WINDOWS CONTROLS MUST BE CREATED AND DESTROYED IN **
// ** THE SAME THREAD TO AVOID ERRORS. **
// ** SOME OF THEM RECREATE THE HANDLERS IF THEY ARE **
// ** MODIFIED AND CAN CAUSE THE SAME ERRORS. **
// ** **
// ** DON'T CREATE, MODIFY OR DESTROY WINDOWS CONTROLS **
// ** INSIDE THE CEF4DELPHI EVENTS AND USE **
// ** SYNCHRONIZATION OBJECTS TO PROTECT VARIABLES AND **
// ** FIELDS IF THEY ARE ALSO USED IN THE MAIN THREAD. **
// ** **
// ** READ THIS FOR MORE INFORMATION : **
// ** https://www.briskbard.com/index.php?pageid=cef **
// ** **
// ** USE OUR FORUMS FOR MORE QUESTIONS : **
// ** https://www.briskbard.com/forum/ **
// ** **
// *********************************************************
// *********************************************************
implementation
uses
{$IFDEF DELPHI16_UP}
System.Math, System.IOUtils, System.SysUtils, {$IFDEF MSWINDOWS}WinApi.TlHelp32, WinApi.PSAPI,{$ENDIF}
{$ELSE}
Math, {$IFDEF DELPHI14_UP}IOUtils,{$ENDIF} SysUtils,
{$IFDEF FPC}
{$IFDEF MSWINDOWS}jwatlhelp32, jwapsapi,{$ENDIF}
{$ELSE}
TlHelp32, {$IFDEF MSWINDOWS}PSAPI,{$ENDIF}
{$ENDIF}
{$ENDIF}
uCEFConstants, uCEFMiscFunctions;
function CefCursorToWindowsCursor(aCefCursor : TCefCursorType) : TCursor;
begin
case aCefCursor of
CT_POINTER : Result := crArrow;
CT_CROSS : Result := crCross;
CT_HAND : Result := crHandPoint;
CT_IBEAM : Result := crIBeam;
CT_WAIT : Result := crHourGlass;
CT_HELP : Result := crHelp;
CT_EASTRESIZE : Result := crSizeWE;
CT_NORTHRESIZE : Result := crSizeNS;
CT_NORTHEASTRESIZE : Result := crSizeNESW;
CT_NORTHWESTRESIZE : Result := crSizeNWSE;
CT_SOUTHRESIZE : Result := crSizeNS;
CT_SOUTHEASTRESIZE : Result := crSizeNWSE;
CT_SOUTHWESTRESIZE : Result := crSizeNESW;
CT_WESTRESIZE : Result := crSizeWE;
CT_NORTHSOUTHRESIZE : Result := crSizeNS;
CT_EASTWESTRESIZE : Result := crSizeWE;
CT_NORTHEASTSOUTHWESTRESIZE : Result := crSizeNESW;
CT_NORTHWESTSOUTHEASTRESIZE : Result := crSizeNWSE;
CT_COLUMNRESIZE : Result := crHSplit;
CT_ROWRESIZE : Result := crVSplit;
CT_MOVE : Result := crSizeAll;
CT_PROGRESS : Result := crAppStart;
CT_NONE : Result := crNone;
CT_NODROP,
CT_NOTALLOWED : Result := crNo;
CT_GRAB,
CT_GRABBING : Result := crDrag;
else Result := crDefault;
end;
end;
procedure DestroyGlobalCEFApp;
begin
if (GlobalCEFApp <> nil) then FreeAndNil(GlobalCEFApp);
end;
constructor TCefApplication.Create;
begin
{$IFDEF FPC}
FContextInitializedHandlers := TMethodList.Create;
{$ENDIF}
inherited Create;
if (GlobalCEFApp = nil) then
GlobalCEFApp := Self;
FDestroyApplicationObject := False;
FDestroyAppWindows := True;
end;
destructor TCefApplication.Destroy;
begin
if (GlobalCEFApp = Self) then
GlobalCEFApp := nil;
{$IFDEF FPC}
FreeAndNil(FContextInitializedHandlers);
{$ENDIF}
inherited Destroy;
end;
procedure TCefApplication.UpdateDeviceScaleFactor;
{$IFDEF MSWINDOWS}
{$IFNDEF FMX}
var
TempHandle : HWND;
TempDPI : UINT;
{$ENDIF}
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
{$IFNDEF FMX}
if RunningWindows10OrNewer then
begin
if assigned(screen.ActiveForm) and
screen.ActiveForm.HandleAllocated then
TempHandle := screen.ActiveForm.Handle
else
if assigned(Application.MainForm) and
Application.MainForm.HandleAllocated then
TempHandle := Application.MainForm.Handle
else
TempHandle := Application.Handle;
if GetDPIForHandle(TempHandle, TempDPI) then
FDeviceScaleFactor := TempDPI / USER_DEFAULT_SCREEN_DPI
else
inherited UpdateDeviceScaleFactor;
end
else
{$ENDIF}
inherited UpdateDeviceScaleFactor;
{$ELSE}
inherited UpdateDeviceScaleFactor;
{$ENDIF}
end;
{$IFDEF FPC}
procedure TCefApplication.doOnContextInitialized;
begin
inherited doOnContextInitialized;
Application.QueueAsyncCall(@CallContextInitializedHandlers, 0);
end;
procedure TCefApplication.AddContextInitializedHandler(AHandler: TNotifyEvent);
begin
if FGlobalContextInitialized then
AHandler(Self)
else
if (FContextInitializedHandlers <> nil) then
FContextInitializedHandlers.Add(TMethod(AHandler));
end;
procedure TCefApplication.RemoveContextInitializedHandler(AHandler: TNotifyEvent);
begin
if (FContextInitializedHandlers <> nil) then
FContextInitializedHandlers.Remove(TMethod(AHandler));
end;
procedure TCefApplication.CallContextInitializedHandlers(Data: PtrInt);
begin
if (FContextInitializedHandlers <> nil) then
FContextInitializedHandlers.CallNotifyEvents(Self);
end;
{$ENDIF}
procedure TCefApplication.BeforeInitSubProcess;
{$IFNDEF FPC}
{$IFNDEF FMX}
var
AppDestroy: procedure(Obj: TApplication; ReleaseMemoryFlag: Byte);
{$ENDIF}
{$ENDIF}
begin
{$IFNDEF FPC}
{$IFNDEF FMX}
if (Application <> nil) then
begin
if FDestroyApplicationObject then
begin
// Call the destructor in "inherited Destroy" mode. This makes it possible to undo
// all the code that TApplication.Create did without actually releasing the Application
// object so that TControl.Destroy and DoneApplication dont't crash.
//
// Undoing also includes destroying the "AppWindows" and calling OleUninitialize what
// allows CEF to initialize the COM thread model the way it is required in the
// sub-processes (debug assertion).
AppDestroy := @TApplication.Destroy;
AppDestroy(Application, 0);
// Set all sub-objects to nil (we destroyed them already). This prevents the second
// TApplication.Destroy call in DoneApplication from trying to release already released
// objects.
TApplication.InitInstance(Application);
end
else
begin
if FDestroyAppWindows then
begin
// This is the fix for the issue #139
// https://github.com/salvadordf/CEF4Delphi/issues/139
// Subprocesses will never use these window handles but TApplication creates them
// before executing the code in the DPR file. Any other application trying to
// initiate a DDE conversation will use SendMessage or SendMessageTimeout to
// broadcast the WM_DDE_INITIATE to all top-level windows. The subprocesses never
// call Application.Run so the SendMessage freezes the other applications.
if (Application.Handle <> 0) then DestroyWindow(Application.Handle);
{$IFDEF DELPHI9_UP}
if (Application.PopupControlWnd <> 0) then DeallocateHWnd(Application.PopupControlWnd);
{$ENDIF}
end;
if not(IsLibrary) then
begin
// Undo the OleInitialize from TApplication.Create. The sub-processes want a different
// COM thread model and fail with an assertion if the Debug-DLLs are used.
OleUninitialize;
end;
end;
end;
{$ELSE} // FMX
{$IFDEF MSWINDOWS}
// Undo the OleInitialize from FMX.Platform.Win::initialization. The sub-processes want a different
// COM thread model and fail with an assertion if the Debug-DLLs are used.
OleUninitialize;
{$ENDIF MSWINDOWS}
{$ENDIF}
{$ENDIF}
end;
end.