/
uCEFApplication.pas
360 lines (318 loc) · 12.5 KB
/
uCEFApplication.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
// ************************************************************************
// ***************************** 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 © 2023 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 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
TCefApplication = class(TCefApplicationCore)
protected
FDestroyApplicationObject : boolean;
FDestroyAppWindows : boolean;
{$IFDEF FPC}
FContextInitializedHandlers : TMethodList;
procedure CallContextInitializedHandlers(Data: PtrInt);
{$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 Internal_OnContextInitialized; override; // In UI thread
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.Internal_OnContextInitialized;
begin
inherited Internal_OnContextInitialized;
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.