pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-10-30 23:07:52 +02:00
Code Issues Actions 1 Releases Activity

FPC compatibility with all missing MSWINDOWS features (Drag&Drop, OnBrowserCompMsg/OnWidgetCompMsg/OnRenderCompMsg) that VCL/FMX already had

Browse Source 
Some Linux support (compiles and can load the libcef.so but still crashes when calling CreateBrowser)
This commit is contained in:
Andreas Hausladen
2019-11-10 18:23:39 +01:00
parent d897a1d815
commit eb0d04f1b5
25 changed files with 525 additions and 345 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
demos/Lazarus/MiniBrowser/uMiniBrowser.lfm
View File

@@ -198,6 +198,7 @@ object MiniBrowserFrm: TMiniBrowserFrm
Top = 0
Width = 25
Caption = '►'
Default = True
Font.CharSet = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -17
@@ -244,6 +245,7 @@ object MiniBrowserFrm: TMiniBrowserFrm
OnNavigationVisitorResultAvailable = Chromium1NavigationVisitorResultAvailable
OnDownloadImageFinished = Chromium1DownloadImageFinished
OnCookiesFlushed = Chromium1CookiesFlushed
OnRenderCompMsg = Chromium1RenderCompMsg
OnLoadEnd = Chromium1LoadEnd
OnLoadError = Chromium1LoadError
OnLoadingStateChange = Chromium1LoadingStateChange

5
packages/CEF4Delphi.dpk
View File

@@ -22,7 +22,7 @@ package CEF4Delphi;
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$IMAGEBASE $54C00000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$DESCRIPTION 'CEF4Delphi'}
@@ -102,7 +102,7 @@ contains
uCEFZipReader in '..\source\uCEFZipReader.pas',
uCEFResponse in '..\source\uCEFResponse.pas',
uCEFCookieVisitor in '..\source\uCEFCookieVisitor.pas',
uCEFV8Exception in '..\source\uCEFV8Exception.pas',
uCEFv8Exception in '..\source\uCEFv8Exception.pas',
uCEFResourceBundleHandler in '..\source\uCEFResourceBundleHandler.pas',
uCEFSetCookieCallback in '..\source\uCEFSetCookieCallback.pas',
uCEFDeleteCookiesCallback in '..\source\uCEFDeleteCookiesCallback.pas',
@@ -131,6 +131,7 @@ contains
uCEFImage in '..\source\uCEFImage.pas',
uCEFMenuModelDelegate in '..\source\uCEFMenuModelDelegate.pas',
uCEFWindowParent in '..\source\uCEFWindowParent.pas',
uCEFChromiumCore in '..\source\uCEFChromiumCore.pas',
uCEFChromium in '..\source\uCEFChromium.pas',
uCEFChromiumEvents in '..\source\uCEFChromiumEvents.pas',
uCEFChromiumOptions in '..\source\uCEFChromiumOptions.pas',

3
packages/CEF4Delphi.dproj
View File

@@ -196,7 +196,7 @@
<DCCReference Include="..\source\uCEFZipReader.pas"/>
<DCCReference Include="..\source\uCEFResponse.pas"/>
<DCCReference Include="..\source\uCEFCookieVisitor.pas"/>
<DCCReference Include="..\source\uCEFV8Exception.pas"/>
<DCCReference Include="..\source\uCEFv8Exception.pas"/>
<DCCReference Include="..\source\uCEFResourceBundleHandler.pas"/>
<DCCReference Include="..\source\uCEFSetCookieCallback.pas"/>
<DCCReference Include="..\source\uCEFDeleteCookiesCallback.pas"/>
@@ -225,6 +225,7 @@
<DCCReference Include="..\source\uCEFImage.pas"/>
<DCCReference Include="..\source\uCEFMenuModelDelegate.pas"/>
<DCCReference Include="..\source\uCEFWindowParent.pas"/>
<DCCReference Include="..\source\uCEFChromiumCore.pas"/>
<DCCReference Include="..\source\uCEFChromium.pas"/>
<DCCReference Include="..\source\uCEFChromiumEvents.pas"/>
<DCCReference Include="..\source\uCEFChromiumOptions.pas"/>

2
packages/CEF4Delphi_D7.cfg
View File

@@ -30,7 +30,7 @@
-W+
-M
-$M16384,1048576
-K$00400000
-K$54C00000
-N"dcu\"
-LE"c:\program files\borland\delphi7\Projects\Bpl"
-LN"c:\program files\borland\delphi7\Projects\Bpl"

5
packages/CEF4Delphi_D7.dpk
View File

@@ -21,7 +21,7 @@ package CEF4Delphi_D7;
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$IMAGEBASE $54C00000}
{$DESCRIPTION 'CEF4Delphi'}
{$IMPLICITBUILD OFF}
{$DEFINE DEBUG}
@@ -100,7 +100,7 @@ contains
uCEFZipReader in '..\source\uCEFZipReader.pas',
uCEFResponse in '..\source\uCEFResponse.pas',
uCEFCookieVisitor in '..\source\uCEFCookieVisitor.pas',
uCEFV8Exception in '..\source\uCEFV8Exception.pas',
uCEFv8Exception in '..\source\uCEFv8Exception.pas',
uCEFResourceBundleHandler in '..\source\uCEFResourceBundleHandler.pas',
uCEFSetCookieCallback in '..\source\uCEFSetCookieCallback.pas',
uCEFDeleteCookiesCallback in '..\source\uCEFDeleteCookiesCallback.pas',
@@ -130,6 +130,7 @@ contains
uCEFMenuModelDelegate in '..\source\uCEFMenuModelDelegate.pas',
uCEFWindowParent in '..\source\uCEFWindowParent.pas',
uCEFChromium in '..\source\uCEFChromium.pas',
uCEFChromiumCore in '..\source\uCEFChromiumCore.pas',
uCEFChromiumEvents in '..\source\uCEFChromiumEvents.pas',
uCEFChromiumOptions in '..\source\uCEFChromiumOptions.pas',
uCEFChromiumFontOptions in '..\source\uCEFChromiumFontOptions.pas',

5
packages/CEF4Delphi_FMX.dpk
View File

@@ -22,7 +22,7 @@ package CEF4Delphi_FMX;
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$IMAGEBASE $54C00000}
{$DEFINE $(FrameworkType)}
{$ENDIF IMPLICITBUILDING}
{$DESCRIPTION 'CEF4Delphi'}
@@ -103,7 +103,7 @@ contains
uCEFZipReader in '..\source\uCEFZipReader.pas',
uCEFResponse in '..\source\uCEFResponse.pas',
uCEFCookieVisitor in '..\source\uCEFCookieVisitor.pas',
uCEFV8Exception in '..\source\uCEFV8Exception.pas',
uCEFv8Exception in '..\source\uCEFv8Exception.pas',
uCEFResourceBundleHandler in '..\source\uCEFResourceBundleHandler.pas',
uCEFSetCookieCallback in '..\source\uCEFSetCookieCallback.pas',
uCEFDeleteCookiesCallback in '..\source\uCEFDeleteCookiesCallback.pas',
@@ -132,6 +132,7 @@ contains
uCEFImage in '..\source\uCEFImage.pas',
uCEFMenuModelDelegate in '..\source\uCEFMenuModelDelegate.pas',
uCEFWindowParent in '..\source\uCEFWindowParent.pas',
uCEFChromiumCore in '..\source\uCEFChromiumCore.pas',
uCEFChromium in '..\source\uCEFChromium.pas',
uCEFChromiumEvents in '..\source\uCEFChromiumEvents.pas',
uCEFChromiumOptions in '..\source\uCEFChromiumOptions.pas',

3
packages/CEF4Delphi_FMX.dproj
View File

@@ -218,7 +218,7 @@
<DCCReference Include="..\source\uCEFZipReader.pas"/>
<DCCReference Include="..\source\uCEFResponse.pas"/>
<DCCReference Include="..\source\uCEFCookieVisitor.pas"/>
<DCCReference Include="..\source\uCEFV8Exception.pas"/>
<DCCReference Include="..\source\uCEFv8Exception.pas"/>
<DCCReference Include="..\source\uCEFResourceBundleHandler.pas"/>
<DCCReference Include="..\source\uCEFSetCookieCallback.pas"/>
<DCCReference Include="..\source\uCEFDeleteCookiesCallback.pas"/>
@@ -247,6 +247,7 @@
<DCCReference Include="..\source\uCEFImage.pas"/>
<DCCReference Include="..\source\uCEFMenuModelDelegate.pas"/>
<DCCReference Include="..\source\uCEFWindowParent.pas"/>
<DCCReference Include="..\source\uCEFChromiumCore.pas"/>
<DCCReference Include="..\source\uCEFChromium.pas"/>
<DCCReference Include="..\source\uCEFChromiumEvents.pas"/>
<DCCReference Include="..\source\uCEFChromiumOptions.pas"/>

94
packages/cef4delphi_lazarus.lpk
View File

@@ -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."/>
<License Value="MPL 1.1"/>
<Version Major="78" Minor="3" Release="1"/>
<Files Count="145">
<Files Count="146">
<Item1>
<Filename Value="..\source\uCEFAccessibilityHandler.pas"/>
<UnitName Value="uCEFAccessibilityHandler"/>
@@ -433,8 +433,8 @@
<UnitName Value="uCEFv8Context"/>
</Item102>
<Item103>
<Filename Value="..\source\uCEFV8Exception.pas"/>
<UnitName Value="uCEFV8Exception"/>
<Filename Value="..\source\uCEFv8Exception.pas"/>
<UnitName Value="uCEFv8Exception"/>
</Item103>
<Item104>
<Filename Value="..\source\uCEFv8Handler.pas"/>
@@ -511,107 +511,111 @@
<UnitName Value="uCEFZipReader"/>
</Item121>
<Item122>
<Filename Value="..\source\uCEFChromiumCore.pas"/>
<UnitName Value="uCEFChromiumCore"/>
</Item122>
<Item123>
<Filename Value="..\source\uCEFChromium.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="uCEFChromium"/>
</Item122>
<Item123>
</Item123>
<Item124>
<Filename Value="..\source\uCEFBufferPanel.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="uCEFBufferPanel"/>
</Item123>
<Item124>
<Filename Value="..\source\uCEFServer.pas"/>
<UnitName Value="uCEFServer"/>
</Item124>
<Item125>
<Filename Value="..\source\uCEFServer.pas"/>
<UnitName Value="uCEFServer"/>
</Item125>
<Item126>
<Filename Value="..\source\uCEFServerComponent.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="uCEFServerComponent"/>
</Item125>
<Item126>
<Filename Value="..\source\uCEFServerEvents.pas"/>
<UnitName Value="uCEFServerEvents"/>
</Item126>
<Item127>
<Filename Value="..\source\uCEFServerHandler.pas"/>
<UnitName Value="uCEFServerHandler"/>
<Filename Value="..\source\uCEFServerEvents.pas"/>
<UnitName Value="uCEFServerEvents"/>
</Item127>
<Item128>
<Filename Value="..\source\res\tbufferpanel.lrs"/>
<Type Value="LRS"/>
<Filename Value="..\source\uCEFServerHandler.pas"/>
<UnitName Value="uCEFServerHandler"/>
</Item128>
<Item129>
<Filename Value="..\source\res\tcefservercomponent.lrs"/>
<Filename Value="..\source\res\tbufferpanel.lrs"/>
<Type Value="LRS"/>
</Item129>
<Item130>
<Filename Value="..\source\res\tcefwindowparent.lrs"/>
<Filename Value="..\source\res\tcefservercomponent.lrs"/>
<Type Value="LRS"/>
</Item130>
<Item131>
<Filename Value="..\source\res\tcefworkscheduler.lrs"/>
<Filename Value="..\source\res\tcefwindowparent.lrs"/>
<Type Value="LRS"/>
</Item131>
<Item132>
<Filename Value="..\source\res\tchromium.lrs"/>
<Filename Value="..\source\res\tcefworkscheduler.lrs"/>
<Type Value="LRS"/>
</Item132>
<Item133>
<Filename Value="..\source\res\tchromiumwindow.lrs"/>
<Filename Value="..\source\res\tchromium.lrs"/>
<Type Value="LRS"/>
</Item133>
<Item134>
<Filename Value="..\source\uCEFWinControl.pas"/>
<UnitName Value="uCEFWinControl"/>
<Filename Value="..\source\res\tchromiumwindow.lrs"/>
<Type Value="LRS"/>
</Item134>
<Item135>
<Filename Value="..\source\uCEFWinControl.pas"/>
<UnitName Value="uCEFWinControl"/>
</Item135>
<Item136>
<Filename Value="..\source\uCEFLinkedWindowParent.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="uCEFLinkedWindowParent"/>
</Item135>
<Item136>
<Filename Value="..\source\uCEFUrlRequestClientEvents.pas"/>
<UnitName Value="uCEFUrlRequestClientEvents"/>
</Item136>
<Item137>
<Filename Value="..\source\uCEFUrlRequestClientEvents.pas"/>
<UnitName Value="uCEFUrlRequestClientEvents"/>
</Item137>
<Item138>
<Filename Value="..\source\uCEFUrlRequestClientComponent.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="uCEFUrlRequestClientComponent"/>
</Item137>
<Item138>
<Filename Value="..\source\uCEFOSRIMEHandler.pas"/>
<UnitName Value="uCEFOSRIMEHandler"/>
</Item138>
<Item139>
<Filename Value="..\source\uCEFCookieAccessFilter.pas"/>
<UnitName Value="uCEFCookieAccessFilter"/>
<Filename Value="..\source\uCEFOSRIMEHandler.pas"/>
<UnitName Value="uCEFOSRIMEHandler"/>
</Item139>
<Item140>
<Filename Value="..\source\uCEFResourceReadCallback.pas"/>
<UnitName Value="uCEFResourceReadCallback"/>
<Filename Value="..\source\uCEFCookieAccessFilter.pas"/>
<UnitName Value="uCEFCookieAccessFilter"/>
</Item140>
<Item141>
<Filename Value="..\source\uCEFResourceRequestHandler.pas"/>
<UnitName Value="uCEFResourceRequestHandler"/>
<Filename Value="..\source\uCEFResourceReadCallback.pas"/>
<UnitName Value="uCEFResourceReadCallback"/>
</Item141>
<Item142>
<Filename Value="..\source\uCEFResourceSkipCallback.pas"/>
<UnitName Value="uCEFResourceSkipCallback"/>
<Filename Value="..\source\uCEFResourceRequestHandler.pas"/>
<UnitName Value="uCEFResourceRequestHandler"/>
</Item142>
<Item143>
<Filename Value="..\source\res\tcefsentinel.lrs"/>
<Type Value="LRS"/>
<Filename Value="..\source\uCEFResourceSkipCallback.pas"/>
<UnitName Value="uCEFResourceSkipCallback"/>
</Item143>
<Item144>
<Filename Value="..\source\res\tcefsentinel.lrs"/>
<Type Value="LRS"/>
</Item144>
<Item145>
<Filename Value="..\source\uCEFSentinel.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="uCEFSentinel"/>
</Item144>
<Item145>
</Item145>
<Item146>
<Filename Value="..\source\uCEFApplicationCore.pas"/>
<UnitName Value="uCEFApplicationCore"/>
</Item145>
</Item146>
</Files>
<RequiredPkgs Count="3">
<Item1>

7
packages/cef4delphi_lazarus.pas
View File

@@ -39,17 +39,18 @@ uses
uCEFStringMap, uCEFStringMultimap, uCEFStringVisitor, uCEFTask,
uCEFTaskRunner, uCEFThread, uCEFTypes, uCEFUrlRequest, uCEFUrlrequestClient,
uCEFv8Accessor, uCEFv8ArrayBufferReleaseCallback, uCEFv8Context,
uCEFV8Exception, uCEFv8Handler, uCEFv8Interceptor, uCEFv8StackFrame,
uCEFv8Exception, uCEFv8Handler, uCEFv8Interceptor, uCEFv8StackFrame,
uCEFv8StackTrace, uCEFv8Value, uCEFValue, uCEFWaitableEvent,
uCEFWebPluginInfo, uCEFWebPluginInfoVisitor, uCEFWebPluginUnstableCallback,
uCEFWindowParent, uCEFWorkScheduler, uCEFWorkSchedulerThread,
uCEFWriteHandler, uCEFX509Certificate, uCEFX509CertPrincipal, uCEFXmlReader,
uCEFZipReader, uCEFChromium, uCEFBufferPanel, uCEFServer,
uCEFZipReader, uCEFChromiumCore, uCEFChromium, uCEFBufferPanel, uCEFServer,
uCEFServerComponent, uCEFServerEvents, uCEFServerHandler, uCEFWinControl,
uCEFLinkedWindowParent, uCEFUrlRequestClientEvents,
uCEFUrlRequestClientComponent, uCEFOSRIMEHandler, uCEFCookieAccessFilter,
uCEFResourceReadCallback, uCEFResourceRequestHandler,
uCEFResourceSkipCallback, uCEFSentinel, LazarusPackageIntf;
uCEFResourceSkipCallback, uCEFSentinel, uCEFApplicationCore,
LazarusPackageIntf;
implementation

181
source/uCEFApplicationCore.pas
View File

@@ -884,12 +884,11 @@ function TCefApplicationCore.CheckCEFLibrary : boolean;
var
TempString, TempOldDir : string;
TempMissingFrm, TempMissingRsc, TempMissingLoc, TempMissingSubProc : boolean;
{$IFDEF MSWINDOWS}
TempMachine : integer;
TempVersionInfo : TFileVersionInfo;
{$ENDIF}
begin
{$IFNDEF MSWINDOWS}
Result := True;
{$ELSE}
Result := False;
if not(FCheckCEFFiles) or (FProcessType <> ptBrowser) then
@@ -901,93 +900,99 @@ begin
TempOldDir := GetCurrentDir;
chdir(GetModulePath);
end;
try
TempMissingSubProc := not(CheckSubprocessPath(FBrowserSubprocessPath, FMissingLibFiles));
TempMissingFrm := not(CheckDLLs(FFrameworkDirPath, FMissingLibFiles));
TempMissingRsc := not(CheckResources(FResourcesDirPath, FMissingLibFiles, FCheckDevToolsResources, not(FDisableExtensions)));
TempMissingLoc := not(CheckLocales(FLocalesDirPath, FMissingLibFiles, FLocalesRequired));
TempMissingSubProc := not(CheckSubprocessPath(FBrowserSubprocessPath, FMissingLibFiles));
TempMissingFrm := not(CheckDLLs(FFrameworkDirPath, FMissingLibFiles));
TempMissingRsc := not(CheckResources(FResourcesDirPath, FMissingLibFiles, FCheckDevToolsResources, not(FDisableExtensions)));
TempMissingLoc := not(CheckLocales(FLocalesDirPath, FMissingLibFiles, FLocalesRequired));
if TempMissingFrm or TempMissingRsc or TempMissingLoc or TempMissingSubProc then
begin
FStatus := asErrorMissingFiles;
TempString := 'CEF binaries missing !';
if (length(FMissingLibFiles) > 0) then
TempString := TempString + CRLF + CRLF +
'The missing files are :' + CRLF +
trim(FMissingLibFiles);
ShowErrorMessageDlg(TempString);
end
else
if CheckDLLVersion(LibCefPath,
CEF_SUPPORTED_VERSION_MAJOR,
CEF_SUPPORTED_VERSION_MINOR,
CEF_SUPPORTED_VERSION_RELEASE,
CEF_SUPPORTED_VERSION_BUILD) then
if TempMissingFrm or TempMissingRsc or TempMissingLoc or TempMissingSubProc then
begin
if GetDLLHeaderMachine(LibCefPath, TempMachine) then
case TempMachine of
CEF_IMAGE_FILE_MACHINE_I386 :
if Is32BitProcess then
Result := True
else
begin
FStatus := asErrorDLLVersion;
TempString := 'Wrong CEF binaries !' +
CRLF + CRLF +
'Use the 32 bit CEF binaries with 32 bits applications only.';
FStatus := asErrorMissingFiles;
TempString := 'CEF binaries missing !';
ShowErrorMessageDlg(TempString);
end;
CEF_IMAGE_FILE_MACHINE_AMD64 :
if not(Is32BitProcess) then
Result := True
else
begin
FStatus := asErrorDLLVersion;
TempString := 'Wrong CEF binaries !' +
CRLF + CRLF +
'Use the 64 bit CEF binaries with 64 bits applications only.';
ShowErrorMessageDlg(TempString);
end;
else
begin
FStatus := asErrorDLLVersion;
TempString := 'Unknown CEF binaries !' +
CRLF + CRLF +
'Use only the CEF binaries specified in the CEF4Delphi Readme.md file at ' +
CEF4DELPHI_URL;
ShowErrorMessageDlg(TempString);
end;
end
else
Result := True;
end
else
begin
FStatus := asErrorDLLVersion;
TempString := 'Unsupported CEF version !' +
CRLF + CRLF +
'Use only the CEF binaries specified in the CEF4Delphi Readme.md file at ' +
CEF4DELPHI_URL;
if GetDLLVersion(LibCefPath, TempVersionInfo) then
if (length(FMissingLibFiles) > 0) then
TempString := TempString + CRLF + CRLF +
'Expected ' + LIBCEF_DLL + ' version : ' + LibCefVersion + CRLF +
'Found ' + LIBCEF_DLL + ' version : ' + FileVersionInfoToString(TempVersionInfo);
'The missing files are :' + CRLF +
trim(FMissingLibFiles);
ShowErrorMessageDlg(TempString);
end;
end
else
{$IFDEF MSWINDOWS}
if CheckDLLVersion(LibCefPath,
CEF_SUPPORTED_VERSION_MAJOR,
CEF_SUPPORTED_VERSION_MINOR,
CEF_SUPPORTED_VERSION_RELEASE,
CEF_SUPPORTED_VERSION_BUILD) then
begin
if GetDLLHeaderMachine(LibCefPath, TempMachine) then
case TempMachine of
CEF_IMAGE_FILE_MACHINE_I386 :
if Is32BitProcess then
Result := True
else
begin
FStatus := asErrorDLLVersion;
TempString := 'Wrong CEF binaries !' +
CRLF + CRLF +
'Use the 32 bit CEF binaries with 32 bits applications only.';
if FSetCurrentDir then chdir(TempOldDir);
ShowErrorMessageDlg(TempString);
end;
CEF_IMAGE_FILE_MACHINE_AMD64 :
if not(Is32BitProcess) then
Result := True
else
begin
FStatus := asErrorDLLVersion;
TempString := 'Wrong CEF binaries !' +
CRLF + CRLF +
'Use the 64 bit CEF binaries with 64 bits applications only.';
ShowErrorMessageDlg(TempString);
end;
else
begin
FStatus := asErrorDLLVersion;
TempString := 'Unknown CEF binaries !' +
CRLF + CRLF +
'Use only the CEF binaries specified in the CEF4Delphi Readme.md file at ' +
CEF4DELPHI_URL;
ShowErrorMessageDlg(TempString);
end;
end
else
Result := True;
end
else
begin
FStatus := asErrorDLLVersion;
TempString := 'Unsupported CEF version !' +
CRLF + CRLF +
'Use only the CEF binaries specified in the CEF4Delphi Readme.md file at ' +
CEF4DELPHI_URL;
if GetDLLVersion(LibCefPath, TempVersionInfo) then
TempString := TempString + CRLF + CRLF +
'Expected ' + LIBCEF_DLL + ' version : ' + LibCefVersion + CRLF +
'Found ' + LIBCEF_DLL + ' version : ' + FileVersionInfoToString(TempVersionInfo);
ShowErrorMessageDlg(TempString);
end;
{$ELSE}
begin
Result := True;
end;
{$ENDIF}
finally
if FSetCurrentDir then chdir(TempOldDir);
end;
end;
{$ENDIF}
end;
function TCefApplicationCore.StartMainProcess : boolean;
@@ -1269,7 +1274,11 @@ begin
{$IFDEF DELPHI14_UP}
TempThread.Start;
{$ELSE}
{$IFNDEF FPC}
TempThread.Resume;
{$ELSE}
TempThread.Start;
{$ENDIF}
{$ENDIF}
end
else
@@ -1527,8 +1536,10 @@ procedure TCefApplicationCore.Internal_OnBeforeCommandLineProcessing(const proce
const commandLine : ICefCommandLine);
var
i : integer;
{$IFDEF MSWINDOWS}
TempVersionInfo : TFileVersionInfo;
TempFileName : string;
{$ENDIF}
begin
if (commandLine <> nil) and (FProcessType = ptBrowser) and (processType = '') then
begin
@@ -1867,11 +1878,7 @@ begin
ZeroMemory(@TempMemCtrs, SizeOf(TProcessMemoryCounters));
TempMemCtrs.cb := SizeOf(TProcessMemoryCounters);
{$IFDEF FPC}
if GetProcessMemoryInfo(TempProcHWND, TempMemCtrs, TempMemCtrs.cb) then inc(Result, TempMemCtrs.WorkingSetSize);
{$ELSE}
if GetProcessMemoryInfo(TempProcHWND, @TempMemCtrs, TempMemCtrs.cb) then inc(Result, TempMemCtrs.WorkingSetSize);
{$ENDIF}
if GetProcessMemoryInfo(TempProcHWND, {$IFNDEF FPC}@{$ENDIF}TempMemCtrs, TempMemCtrs.cb) then inc(Result, TempMemCtrs.WorkingSetSize);
CloseHandle(TempProcHWND);
end;

4
source/uCEFChromium.pas
View File

@@ -68,7 +68,9 @@ type
function GetParentForm : TCustomForm;
procedure InitializeDevToolsWindowInfo(aDevTools : TWinControl); virtual;
public
{$IFDEF MSWINDOWS}
procedure InitializeDragAndDrop(const aDropTargetCtrl : TWinControl);
{$ENDIF MSWINDOWS}
procedure ShowDevTools(inspectElementAt: TPoint; const aDevTools : TWinControl = nil);
procedure CloseDevTools(const aDevTools : TWinControl = nil);
@@ -126,11 +128,13 @@ uses
{ TChromium }
{$IFDEF MSWINDOWS}
procedure TChromium.InitializeDragAndDrop(const aDropTargetCtrl: TWinControl);
begin
if aDropTargetCtrl <> nil then
inherited InitializeDragAndDrop(aDropTargetCtrl.Handle);
end;
{$ENDIF MSWINDOWS}
procedure TChromium.InitializeDevToolsWindowInfo(aDevTools: TWinControl);
begin

251
source/uCEFChromiumCore.pas
View File

@@ -50,9 +50,9 @@ interface
uses
{$IFDEF DELPHI16_UP}
{$IFDEF MSWINDOWS}WinApi.Windows, WinApi.Messages, WinApi.ActiveX,{$ENDIF} System.Classes,
{$IFDEF MSWINDOWS}WinApi.Windows, WinApi.Messages, WinApi.ActiveX, WinApi.CommCtrl,{$ENDIF} System.Classes,
{$ELSE}
{$IFDEF MSWINDOWS}Windows, ActiveX,{$ENDIF} Classes,
{$IFDEF MSWINDOWS}Windows, ActiveX, CommCtrl,{$ENDIF} Classes,
{$IFDEF FPC}
LCLProc, LCLType, LCLIntf, LResources, LMessages, InterfaceBase,
{$ELSE}
@@ -61,7 +61,7 @@ uses
{$ENDIF}
uCEFTypes, uCEFInterfaces, uCEFLibFunctions, uCEFMiscFunctions, uCEFClient,
uCEFConstants, uCEFTask, uCEFDomVisitor, uCEFChromiumEvents,
{$IFDEF MSWINDOWS}{$IFNDEF FPC}uCEFDragAndDropMgr,{$ENDIF}{$ENDIF}
{$IFDEF MSWINDOWS}uCEFDragAndDropMgr,{$ENDIF}
uCEFChromiumOptions, uCEFChromiumFontOptions, uCEFPDFPrintOptions;
type
@@ -116,9 +116,7 @@ type
FDevBrowserSettings : TCefBrowserSettings;
FDragOperations : TCefDragOperations;
{$IFDEF MSWINDOWS}
{$IFNDEF FPC}
FDragDropManager : TCEFDragAndDropMgr;
{$ENDIF}
FDropTargetWnd : HWND;
{$ENDIF}
FDragAndDropInitialized : boolean;
@@ -127,7 +125,6 @@ type
FWebRTCNonProxiedUDP : TCefState;
{$IFDEF MSWINDOWS}
{$IFNDEF FPC}
FOldBrowserCompWndPrc : TFNWndProc;
FOldWidgetCompWndPrc : TFNWndProc;
FOldRenderCompWndPrc : TFNWndProc;
@@ -135,7 +132,6 @@ type
FWidgetCompStub : Pointer;
FRenderCompStub : Pointer;
{$ENDIF}
{$ENDIF}
FBrowserCompHWND : THandle;
FWidgetCompHWND : THandle;
FRenderCompHWND : THandle;
@@ -266,12 +262,10 @@ type
FOnCookieVisitorDestroyed : TOnCookieVisitorDestroyed;
FOnCookieSet : TOnCookieSet;
{$IFDEF MSWINDOWS}
{$IFNDEF FPC}
FOnBrowserCompMsg : TOnCompMsgEvent;
FOnWidgetCompMsg : TOnCompMsgEvent;
FOnRenderCompMsg : TOnCompMsgEvent;
{$ENDIF}
{$ENDIF}
function GetIsLoading : boolean;
function GetMultithreadApp : boolean;
@@ -375,15 +369,15 @@ type
procedure DefaultInitializeDevToolsWindowInfo(aDevToolsWnd: TCefWindowHandle; const aClientRect: TRect; const aWindowName: ustring);
{$IFDEF MSWINDOWS}
procedure WndProc(var aMessage: TMessage);
{$IFNDEF FPC}
procedure CreateStub(const aMethod : TWndMethod; var aStub : Pointer);
procedure FreeAndNilStub(var aStub : pointer);
function InstallCompWndProc(aWnd: THandle; aStub: Pointer): TFNWndProc;
procedure RestoreCompWndProc(var aOldWnd: THandle; aNewWnd: THandle; var aProc: TFNWndProc);
procedure CallOldCompWndProc(aProc: TFNWndProc; aWnd: THandle; var aMessage: TMessage);
procedure BrowserCompWndProc(var aMessage: TMessage);
procedure WidgetCompWndProc(var aMessage: TMessage);
procedure RenderCompWndProc(var aMessage: TMessage);
{$ENDIF}
{$ENDIF}
procedure DragDropManager_OnDragEnter(Sender: TObject; const aDragData : ICefDragData; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint);
procedure DragDropManager_OnDragOver(Sender: TObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint);
@@ -602,10 +596,7 @@ type
function FlushCookieStore(aFlushImmediately : boolean = True) : boolean;
procedure ShowDevTools(const inspectElementAt: TPoint; aWindowInfo: PCefWindowInfo);
{$IFDEF MSWINDOWS}
procedure CloseDevTools(const aDevToolsWnd : THandle); overload;
{$ENDIF}
procedure CloseDevTools; overload;
procedure CloseDevTools(const aDevToolsWnd : TCefWindowHandle = 0);
procedure Find(aIdentifier : integer; const aSearchText : ustring; aForward, aMatchCase, aFindNext : Boolean);
procedure StopFinding(aClearSelection : Boolean);
@@ -747,12 +738,10 @@ type
property OnCookieVisitorDestroyed : TOnCookieVisitorDestroyed read FOnCookieVisitorDestroyed write FOnCookieVisitorDestroyed;
property OnCookieSet : TOnCookieSet read FOnCookieSet write FOnCookieSet;
{$IFDEF MSWINDOWS}
{$IFNDEF FPC}
property OnBrowserCompMsg : TOnCompMsgEvent read FOnBrowserCompMsg write FOnBrowserCompMsg;
property OnWidgetCompMsg : TOnCompMsgEvent read FOnWidgetCompMsg write FOnWidgetCompMsg;
property OnRenderCompMsg : TOnCompMsgEvent read FOnRenderCompMsg write FOnRenderCompMsg;
{$ENDIF}
{$ENDIF}
// ICefClient
property OnProcessMessageReceived : TOnProcessMessageReceived read FOnProcessMessageReceived write FOnProcessMessageReceived;
@@ -864,10 +853,6 @@ type
property OnGetResourceRequestHandler_ReqCtxHdlr : TOnGetResourceRequestHandler read FOnGetResourceRequestHandler_ReqCtxHdlr write FOnGetResourceRequestHandler_ReqCtxHdlr;
end;
{$IFDEF FPC}
procedure Register;
{$ENDIF}
// *********************************************************
// ********************** ATTENTION ! **********************
// *********************************************************
@@ -905,7 +890,7 @@ uses
{$ENDIF}
uCEFBrowser, uCEFValue, uCEFDictionaryValue, uCEFStringMultimap, uCEFFrame,
uCEFApplicationCore, uCEFProcessMessage, uCEFRequestContext,
{$IFDEF MSWINDOWS}{$IFNDEF FPC}uCEFOLEDragAndDrop,{$ENDIF}{$ENDIF}
{$IFDEF MSWINDOWS}uCEFOLEDragAndDrop,{$ENDIF}
uCEFPDFPrintCallback, uCEFResolveCallback, uCEFDeleteCookiesCallback, uCEFStringVisitor,
uCEFListValue, uCEFNavigationEntryVisitor, uCEFDownloadImageCallBack, uCEFCookieManager,
uCEFRequestContextHandler, uCEFCookieVisitor, uCEFSetCookieCallback, uCEFResourceRequestHandler;
@@ -946,23 +931,21 @@ begin
FYouTubeRestrict := YOUTUBE_RESTRICT_OFF;
FPrintingEnabled := True;
{$IFNDEF FPC}
{$IFDEF MSWINDOWS}
FOldBrowserCompWndPrc := nil;
FOldWidgetCompWndPrc := nil;
FOldRenderCompWndPrc := nil;
FBrowserCompStub := nil;
FWidgetCompStub := nil;
FRenderCompStub := nil;
{$ENDIF}
{$ENDIF MSWINDOWS}
FBrowserCompHWND := 0;
FWidgetCompHWND := 0;
FRenderCompHWND := 0;
FDragOperations := DRAG_OPERATION_NONE;
{$IFDEF MSWINDOWS}
{$IFNDEF FPC}
FDragDropManager := nil;
{$ENDIF}
FDropTargetWnd := 0;
{$ENDIF MSWINDOWS}
FDragAndDropInitialized := False;
@@ -996,11 +979,9 @@ destructor TChromiumCore.Destroy;
begin
try
try
{$IFNDEF FPC}
if (FDragDropManager <> nil) then FreeAndNil(FDragDropManager);
{$ENDIF}
{$IFDEF MSWINDOWS}
if (FDragDropManager <> nil) then FreeAndNil(FDragDropManager);
if (FCompHandle <> 0) then
begin
DeallocateHWnd(FCompHandle);
@@ -1025,7 +1006,6 @@ end;
procedure TChromiumCore.BeforeDestruction;
begin
{$IFDEF MSWINDOWS}
{$IFNDEF FPC}
RestoreCompWndProc(FBrowserCompHWND, 0, FOldBrowserCompWndPrc);
FreeAndNilStub(FBrowserCompStub);
@@ -1035,7 +1015,6 @@ begin
RestoreCompWndProc(FRenderCompHWND, 0, FOldRenderCompWndPrc);
FreeAndNilStub(FRenderCompStub);
{$ENDIF}
{$ENDIF}
DestroyClientHandler;
DestroyReqContextHandler;
@@ -1052,6 +1031,27 @@ end;
{$IFDEF MSWINDOWS}
{$IFNDEF FPC}
// Windows XP and newer (older Delphi version < XE don't have them and newer
// require a call to InitCommonControl what isn't necessary.
{type
SUBCLASSPROC = function(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM;
uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall;
TSubClassProc = SUBCLASSPROC;
function SetWindowSubclass(hWnd: HWND; pfnSubclass: SUBCLASSPROC; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): BOOL; stdcall;
external comctl32 name 'SetWindowSubclass';
//function GetWindowSubclass(hWnd: HWND; pfnSubclass: SUBCLASSPROC; uIdSubclass: UINT_PTR; var pdwRefData: DWORD_PTR): BOOL; stdcall;
// external comctl32 name 'GetWindowSubclass';
function RemoveWindowSubclass(hWnd: HWND; pfnSubclass: SUBCLASSPROC; uIdSubclass: UINT_PTR): BOOL; stdcall;
external comctl32 name 'RemoveWindowSubclass';
function DefSubclassProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
external comctl32 name 'DefSubclassProc';
// We stick with the original implementation because the WndProc stub is a lot
// faster than the WindowSubClass stub that uses the slow GetProp(hWnd). Which
// is extremly slow in Windows 10 1809 and newer.
}
procedure TChromiumCore.CreateStub(const aMethod : TWndMethod; var aStub : Pointer);
begin
if (aStub = nil) then aStub := MakeObjectInstance(aMethod);
@@ -1066,6 +1066,11 @@ begin
end;
end;
function TChromiumCore.InstallCompWndProc(aWnd: THandle; aStub: Pointer): TFNWndProc;
begin
Result := TFNWndProc(SetWindowLongPtr(aWnd, GWLP_WNDPROC, NativeInt(aStub)));
end;
procedure TChromiumCore.RestoreCompWndProc(var aOldWnd: THandle; aNewWnd: THandle; var aProc: TFNWndProc);
begin
if (aOldWnd <> 0) and (aOldWnd <> aNewWnd) and (aProc <> nil) then
@@ -1075,6 +1080,74 @@ begin
aOldWnd := 0;
end;
end;
procedure TChromiumCore.CallOldCompWndProc(aProc: TFNWndProc; aWnd: THandle; var aMessage: TMessage);
begin
if (aProc <> nil) and (aWnd <> 0) then
aMessage.Result := CallWindowProc(aProc, aWnd, aMessage.Msg, aMessage.wParam, aMessage.lParam);
end;
{$ELSE}
procedure TChromiumCore.CreateStub(const aMethod : TWndMethod; var aStub : Pointer);
begin
if (aStub = nil) then
begin
GetMem(aStub, SizeOf(TWndMethod));
TWndMethod(aStub^) := aMethod;
end;
end;
procedure TChromiumCore.FreeAndNilStub(var aStub : pointer);
begin
if (aStub <> nil) then
begin
FreeMem(aStub);
aStub := nil;
end;
end;
function CompSubClassProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM;
uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall;
var
m: TWndMethod;
Msg: TMessage;
begin
Msg.msg := uMsg;
Msg.wParam := wparam;
Msg.lParam := lParam;
Msg.Result := 0;
m := TWndMethod(Pointer(dwRefData)^);
m(Msg);
Result := Msg.Result;
end;
function TChromiumCore.InstallCompWndProc(aWnd: THandle; aStub: Pointer): TFNWndProc;
begin
Result := nil;
if (aWnd <> 0) and (aStub <> nil) then
begin
SetWindowSubclass(aWnd, @CompSubClassProc, 1, NativeInt(aStub));
Result := TFNWndProc(1); // IdSubClass
end;
end;
procedure TChromiumCore.RestoreCompWndProc(var aOldWnd: THandle; aNewWnd: THandle; var aProc: TFNWndProc);
begin
if (aOldWnd <> 0) and (aOldWnd <> aNewWnd) and (aProc <> nil) then
begin
RemoveWindowSubclass(aOldWnd, @CompSubClassProc, 1);
aProc := nil;
aOldWnd := 0;
end;
end;
procedure TChromiumCore.CallOldCompWndProc(aProc: TFNWndProc; aWnd: THandle; var aMessage: TMessage);
begin
if (aProc <> nil) and (aWnd <> 0) then
aMessage.Result := DefSubclassProc(aWnd, aMessage.Msg, aMessage.wParam, aMessage.lParam);
end;
{$ENDIF}
{$ENDIF}
@@ -1135,10 +1208,6 @@ begin
end;
procedure TChromiumCore.AfterConstruction;
{$IFDEF FPC}
var
TempWndMethod : TWndMethod;
{$ENDIF}
begin
inherited AfterConstruction;
@@ -1146,12 +1215,7 @@ begin
if not(csDesigning in ComponentState) then
begin
{$IFDEF MSWINDOWS}
{$IFDEF FPC}
TempWndMethod := @WndProc;
FCompHandle := AllocateHWnd(TempWndMethod);
{$ELSE}
FCompHandle := AllocateHWnd(WndProc);
{$ENDIF}
FCompHandle := AllocateHWnd({$IFDEF FPC}@{$ENDIF}WndProc);
{$ENDIF}
FOptions := TChromiumOptions.Create;
FFontOptions := TChromiumFontOptions.Create;
@@ -1318,7 +1382,8 @@ begin
FOnCookiesVisited := nil;
FOnCookieVisitorDestroyed := nil;
FOnCookieSet := nil;
{$IFNDEF FPC}
{$IFDEF MSWINDOWS}
FOnBrowserCompMsg := nil;
FOnWidgetCompMsg := nil;
FOnRenderCompMsg := nil;
@@ -1434,12 +1499,9 @@ end;
{$IFDEF MSWINDOWS}
procedure TChromiumCore.InitializeDragAndDrop(const aDropTargetWnd : HWND);
{$IFNDEF FPC}
var
TempDropTarget : IDropTarget;
{$ENDIF}
begin
{$IFNDEF FPC}
if FIsOSR and
not(FDragAndDropInitialized) and
(FDragDropManager = nil) and
@@ -1448,10 +1510,10 @@ begin
FDropTargetWnd := aDropTargetWnd;
FDragDropManager := TCEFDragAndDropMgr.Create;
FDragDropManager.OnDragEnter := DragDropManager_OnDragEnter;
FDragDropManager.OnDragOver := DragDropManager_OnDragOver;
FDragDropManager.OnDragLeave := DragDropManager_OnDragLeave;
FDragDropManager.OnDrop := DragDropManager_OnDrop;
FDragDropManager.OnDragEnter := {$IFDEF FPC}@{$ENDIF}DragDropManager_OnDragEnter;
FDragDropManager.OnDragOver := {$IFDEF FPC}@{$ENDIF}DragDropManager_OnDragOver;
FDragDropManager.OnDragLeave := {$IFDEF FPC}@{$ENDIF}DragDropManager_OnDragLeave;
FDragDropManager.OnDrop := {$IFDEF FPC}@{$ENDIF}DragDropManager_OnDrop;
TempDropTarget := TOLEDropTarget.Create(FDragDropManager);
@@ -1459,18 +1521,15 @@ begin
FDragAndDropInitialized := True;
end;
{$ENDIF}
end;
procedure TChromiumCore.ShutdownDragAndDrop;
begin
{$IFNDEF FPC}
if FDragAndDropInitialized and (FDropTargetWnd <> 0) then
begin
RevokeDragDrop(FDropTargetWnd);
FDragAndDropInitialized := False;
end;
{$ENDIF}
end;
procedure TChromiumCore.ToMouseEvent(grfKeyState : Longint; pt : TPoint; var aMouseEvent : TCefMouseEvent);
@@ -1486,9 +1545,11 @@ end;
{$ENDIF}
procedure TChromiumCore.DragDropManager_OnDragEnter(Sender: TObject; const aDragData : ICefDragData; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint);
{$IFDEF MSWINDOWS}
var
TempMouseEvent : TCefMouseEvent;
TempAllowedOps : TCefDragOperations;
{$ENDIF}
begin
if (GlobalCEFApp <> nil) then
begin
@@ -1506,9 +1567,11 @@ begin
end;
procedure TChromiumCore.DragDropManager_OnDragOver(Sender: TObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint);
{$IFDEF MSWINDOWS}
var
TempMouseEvent : TCefMouseEvent;
TempAllowedOps : TCefDragOperations;
{$ENDIF}
begin
if (GlobalCEFApp <> nil) then
begin
@@ -1530,9 +1593,11 @@ begin
end;
procedure TChromiumCore.DragDropManager_OnDrop(Sender: TObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint);
{$IFDEF MSWINDOWS}
var
TempMouseEvent : TCefMouseEvent;
TempAllowedOps : TCefDragOperations;
{$ENDIF}
begin
if (GlobalCEFApp <> nil) then
begin
@@ -2802,8 +2867,10 @@ begin
end;
function TChromiumCore.SetNewBrowserParent(aNewParentHwnd : HWND) : boolean;
{$IFDEF MSWINDOWS}
var
TempHandle : HWND;
{$ENDIF}
begin
Result := False;
@@ -3415,9 +3482,11 @@ begin
end;
function TChromiumCore.doSavePreferences : boolean;
{$IFDEF MSWINDOWS}
var
TempDict : ICefDictionaryValue;
TempPrefs : TStringList;
{$ENDIF}
begin
Result := False;
{$IFDEF MSWINDOWS}
@@ -3751,23 +3820,18 @@ begin
end;
end;
{$IFDEF MSWINDOWS}
procedure TChromiumCore.CloseDevTools(const aDevToolsWnd : THandle);
procedure TChromiumCore.CloseDevTools(const aDevToolsWnd : TCefWindowHandle);
begin
if Initialized then
begin
{$IFDEF MSWINDOWS}
if (aDevToolsWnd <> 0) then
SetParent(GetWindow(aDevToolsWnd, GW_CHILD), 0);
{$ENDIF}
CloseDevTools;
if Initialized and (FBrowser <> nil) then FBrowser.Host.CloseDevTools;
end;
end;
{$ENDIF MSWINDOWS}
procedure TChromiumCore.CloseDevTools;
begin
if Initialized and (FBrowser <> nil) then FBrowser.Host.CloseDevTools;
end;
{$IFDEF MSWINDOWS}
procedure TChromiumCore.WndProc(var aMessage: TMessage);
@@ -3780,7 +3844,6 @@ begin
end;
end;
{$IFNDEF FPC}
procedure TChromiumCore.BrowserCompWndProc(var aMessage: TMessage);
var
TempHandled : boolean;
@@ -3792,14 +3855,8 @@ begin
if assigned(FOnBrowserCompMsg) then
FOnBrowserCompMsg(aMessage, TempHandled);
if not(TempHandled) and
(FOldBrowserCompWndPrc <> nil) and
(FBrowserCompHWND <> 0) then
aMessage.Result := CallWindowProc(FOldBrowserCompWndPrc,
FBrowserCompHWND,
aMessage.Msg,
aMessage.wParam,
aMessage.lParam);
if not(TempHandled) then
CallOldCompWndProc(FOldBrowserCompWndPrc, FBrowserCompHWND, aMessage);
finally
if aMessage.Msg = WM_DESTROY then
RestoreCompWndProc(FBrowserCompHWND, 0, FOldBrowserCompWndPrc);
@@ -3821,14 +3878,8 @@ begin
if assigned(FOnWidgetCompMsg) then
FOnWidgetCompMsg(aMessage, TempHandled);
if not(TempHandled) and
(FOldWidgetCompWndPrc <> nil) and
(FWidgetCompHWND <> 0) then
aMessage.Result := CallWindowProc(FOldWidgetCompWndPrc,
FWidgetCompHWND,
aMessage.Msg,
aMessage.wParam,
aMessage.lParam);
if not(TempHandled) then
CallOldCompWndProc(FOldWidgetCompWndPrc, FWidgetCompHWND, aMessage);
finally
if aMessage.Msg = WM_DESTROY then
RestoreCompWndProc(FWidgetCompHWND, 0, FOldWidgetCompWndPrc);
@@ -3850,14 +3901,8 @@ begin
if assigned(FOnRenderCompMsg) then
FOnRenderCompMsg(aMessage, TempHandled);
if not(TempHandled) and
(FOldRenderCompWndPrc <> nil) and
(FRenderCompHWND <> 0) then
aMessage.Result := CallWindowProc(FOldRenderCompWndPrc,
FRenderCompHWND,
aMessage.Msg,
aMessage.wParam,
aMessage.lParam);
if not(TempHandled) then
CallOldCompWndProc(FOldRenderCompWndPrc, FRenderCompHWND, aMessage);
finally
if aMessage.Msg = WM_DESTROY then
RestoreCompWndProc(FRenderCompHWND, 0, FOldRenderCompWndPrc);
@@ -3868,7 +3913,6 @@ begin
end;
end;
{$ENDIF}
{$ENDIF}
function TChromiumCore.doOnClose(const browser: ICefBrowser): Boolean;
var
@@ -4465,23 +4509,19 @@ end;
procedure TChromiumCore.doOnRenderViewReady(const browser: ICefBrowser);
{$IFDEF MSWINDOWS}
{$IFNDEF FPC}
var
OldBrowserCompHWND, OldWidgetCompHWND, OldRenderCompHWND: THandle;
{$ENDIF}
{$ENDIF}
begin
if (browser <> nil) and
(browser.Host <> nil) and
(browser.Identifier = FBrowserId) then
begin
{$IFDEF MSWINDOWS}
{$IFNDEF FPC}
OldBrowserCompHWND := FBrowserCompHWND;
OldWidgetCompHWND := FWidgetCompHWND;
OldRenderCompHWND := FRenderCompHWND;
{$ENDIF}
{$ENDIF}
FBrowserCompHWND := browser.Host.WindowHandle;
{$IFDEF MSWINDOWS}
@@ -4490,35 +4530,28 @@ begin
if (FWidgetCompHWND <> 0) then
FRenderCompHWND := FindWindowEx(FWidgetCompHWND, 0, 'Chrome_RenderWidgetHostHWND', 'Chrome Legacy Window');
{$IFNDEF FPC}
RestoreCompWndProc(OldBrowserCompHWND, FBrowserCompHWND, FOldBrowserCompWndPrc);
if assigned(FOnBrowserCompMsg) and (FBrowserCompHWND <> 0) and (FOldBrowserCompWndPrc = nil) then
begin
CreateStub(BrowserCompWndProc, FBrowserCompStub);
FOldBrowserCompWndPrc := TFNWndProc(SetWindowLongPtr(FBrowserCompHWND,
GWLP_WNDPROC,
NativeInt(FBrowserCompStub)));
CreateStub({$IFDEF FPC}@{$ENDIF}BrowserCompWndProc, FBrowserCompStub);
FOldBrowserCompWndPrc := InstallCompWndProc(FBrowserCompHWND, FBrowserCompStub);
end;
RestoreCompWndProc(OldWidgetCompHWND, FWidgetCompHWND, FOldWidgetCompWndPrc);
if assigned(FOnWidgetCompMsg) and (FWidgetCompHWND <> 0) and (FOldWidgetCompWndPrc = nil) then
begin
CreateStub(WidgetCompWndProc, FWidgetCompStub);
FOldWidgetCompWndPrc := TFNWndProc(SetWindowLongPtr(FWidgetCompHWND,
GWLP_WNDPROC,
NativeInt(FWidgetCompStub)));
CreateStub({$IFDEF FPC}@{$ENDIF}WidgetCompWndProc, FWidgetCompStub);
FOldWidgetCompWndPrc := InstallCompWndProc(FWidgetCompHWND, FWidgetCompStub);
end;
RestoreCompWndProc(OldRenderCompHWND, FRenderCompHWND, FOldRenderCompWndPrc);
if assigned(FOnRenderCompMsg) and (FRenderCompHWND <> 0) and (FOldRenderCompWndPrc = nil) then
begin
CreateStub(RenderCompWndProc, FRenderCompStub);
FOldRenderCompWndPrc := TFNWndProc(SetWindowLongPtr(FRenderCompHWND,
GWLP_WNDPROC,
NativeInt(FRenderCompStub)));
CreateStub({$IFDEF FPC}@{$ENDIF}RenderCompWndProc, FRenderCompStub);
FOldRenderCompWndPrc := InstallCompWndProc(FRenderCompHWND, FRenderCompStub);
end;
{$ENDIF}
{$ENDIF}
end;
if Assigned(FOnRenderViewReady) then FOnRenderViewReady(Self, browser);
@@ -4614,7 +4647,7 @@ function TChromiumCore.doOnStartDragging(const browser : ICefBrowser;
y : Integer): Boolean;
begin
Result := False;
{$IFNDEF FPC}
{$IFDEF MSWINDOWS}
if FDragAndDropInitialized and
FDragDropManager.CloneDragData(dragData, allowedOps) then
begin
@@ -4627,13 +4660,13 @@ begin
end;
procedure TChromiumCore.DelayedDragging;
{$IFNDEF FPC}
{$IFDEF MSWINDOWS}
var
TempOperation : TCefDragOperation;
TempPoint : TPoint;
{$ENDIF}
begin
{$IFNDEF FPC}
{$IFDEF MSWINDOWS}
if FDragAndDropInitialized and (FDropTargetWnd <> 0) and (GlobalCEFApp <> nil) then
begin
FDragOperations := DRAG_OPERATION_NONE;

16
source/uCEFDragAndDropMgr.pas
View File

@@ -116,6 +116,14 @@ implementation
uses
uCEFMiscFunctions, uCEFWriteHandler, uCEFStreamWriter, uCEFConstants;
{$IFDEF FPC}
const
//CFSTR_FILEDESCRIPTORA = 'FileGroupDescriptor'; // CF_FILEGROUPDESCRIPTORA
CFSTR_FILEDESCRIPTORW = 'FileGroupDescriptorW'; // CF_FILEGROUPDESCRIPTORW
CFSTR_FILEDESCRIPTOR = CFSTR_FILEDESCRIPTORW;
CFSTR_FILECONTENTS = 'FileContents'; // CF_FILECONTENTS
{$ENDIF}
// *****************************************************
// **************** TCEFDragAndDropMgr *****************
// *****************************************************
@@ -667,7 +675,11 @@ begin
while (TempEnumFrmt.Next(1, TempFormat, nil) = S_OK) and not(TempUsed) do
begin
try
{$IFNDEF FPC}
TempMedium.unkForRelease := nil;
{$ELSE}
TempMedium.PUnkForRelease := nil;
{$ENDIF}
if ((TempFormat.tymed and TYMED_HGLOBAL) <> 0) and
(aDataObject.GetData(TempFormat, TempMedium) = S_OK) then
@@ -722,7 +734,11 @@ begin
TempResEffect := DROPEFFECT_NONE;
TempDataObject := TOLEDataObject.Create(TempFormatArray, TempMediumArray, i);
TempDropSource := TOLEDropSource.Create;
{$IFNDEF FPC}
TempResult := DoDragDrop(TempDataObject, TempDropSource, FOLEEffect, TempResEffect);
{$ELSE}
TempResult := DoDragDrop(TempDataObject, TempDropSource, DWORD(FOLEEffect), LPDWORD(TempResEffect));
{$ENDIF}
if (TempResult <> DRAGDROP_S_DROP) then TempResEffect := DROPEFFECT_NONE;
FCurrentDragData := nil;

2
source/uCEFExtension.pas
View File

@@ -70,7 +70,7 @@ type
implementation
uses
uCEFMiscFunctions, uCEFLibFunctions, uCEFDictionaryValue, uCEFRequestContext, uCefExtensionHandler;
uCEFMiscFunctions, uCEFLibFunctions, uCEFDictionaryValue, uCEFRequestContext, uCEFExtensionHandler;
function TCefExtensionRef.GetIdentifier : ustring;
begin

2
source/uCEFFMXChromium.pas
View File

@@ -116,7 +116,7 @@ begin
DefaultInitializeDevToolsWindowInfo(0, Rect(0, 0, 0, 0), '');
end;
procedure TFMXChromium.ShowDevTools(inspectElementAt: TPoint; const aDevTools : TControl = nil);
procedure TFMXChromium.ShowDevTools(inspectElementAt: TPoint);
begin
if Initialized then
begin

38
source/uCEFMiscFunctions.pas
View File

@@ -53,7 +53,7 @@ uses
{$IFDEF MSWINDOWS}WinApi.Windows, WinApi.ActiveX,{$ENDIF} System.IOUtils, System.Classes, System.SysUtils, System.UITypes, System.Math,
{$ELSE}
{$IFDEF MSWINDOWS}Windows, ActiveX,{$ENDIF} {$IFDEF DELPHI14_UP}IOUtils,{$ENDIF} Classes, SysUtils, Math,
{$IFDEF FPC}LCLType,{$IFNDEF MSWINDOWS}InterfaceBase,{$ENDIF}{$ENDIF}
{$IFDEF FPC}LCLType,{$IFNDEF MSWINDOWS}InterfaceBase, Forms,{$ENDIF}{$ENDIF}
{$ENDIF}
uCEFTypes, uCEFInterfaces, uCEFLibFunctions, uCEFResourceHandler,
uCEFRegisterCDMCallback, uCEFConstants;
@@ -136,6 +136,8 @@ function PathIsURLAnsi(pszPath: LPCSTR): BOOL; stdcall; external SHLWAPIDLL name
function PathIsURLUnicode(pszPath: LPCWSTR): BOOL; stdcall; external SHLWAPIDLL name 'PathIsURLW';
{$IFNDEF DELPHI12_UP}
const
GWLP_WNDPROC = GWL_WNDPROC;
{$IFDEF WIN64}
function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: int64): int64; stdcall; external user32 name 'SetWindowLongPtrW';
{$ELSE}
@@ -879,9 +881,10 @@ function SplitLongString(aSrcString : string) : string;
const
MAXLINELENGTH = 50;
begin
Result := '';
while (length(aSrcString) > 0) do
begin
if (length(Result) > 0) then
if (Result <> '') then
Result := Result + CRLF + copy(aSrcString, 1, MAXLINELENGTH)
else
Result := Result + copy(aSrcString, 1, MAXLINELENGTH);
@@ -972,7 +975,7 @@ begin
if (length(aLocalesDirPath) > 0) then
TempDir := IncludeTrailingPathDelimiter(aLocalesDirPath)
else
TempDir := 'locales\';
TempDir := 'locales' + PathDelim;
TempList := TStringList.Create;
@@ -1071,11 +1074,19 @@ begin
TempList := TStringList.Create;
TempList.Add(TempDir + CHROMEELF_DLL);
TempList.Add(TempDir + LIBCEF_DLL);
{$IFDEF MSWINDOWS}
TempList.Add(TempDir + 'd3dcompiler_47.dll');
TempList.Add(TempDir + 'libEGL.dll');
TempList.Add(TempDir + 'libGLESv2.dll');
TempList.Add(TempDir + 'swiftshader\libEGL.dll');
TempList.Add(TempDir + 'swiftshader\libGLESv2.dll');
{$ENDIF}
{$IFDEF LINUX}
TempList.Add(TempDir + 'libEGL.so');
TempList.Add(TempDir + 'libGLESv2.so');
TempList.Add(TempDir + 'swiftshader/libEGL.so');
TempList.Add(TempDir + 'swiftshader/libGLESv2.so');
{$ENDIF}
TempList.Add(TempDir + 'icudtl.dat');
if TempExists then
@@ -1491,7 +1502,7 @@ begin
end;
function CustomAbsolutePath(const aPath : string; aMustExist : boolean) : string;
var
var
TempNewPath, TempOldPath : string;
begin
if (length(aPath) > 0) then
@@ -1505,8 +1516,8 @@ begin
TempNewPath := TempOldPath;
if aMustExist and not(DirectoryExists(TempNewPath)) then
Result := ''
else
Result := ''
else
Result := TempNewPath;
end
else
@@ -1515,7 +1526,12 @@ end;
function GetModulePath : string;
begin
{$IFDEF MSWINDOWS}
Result := IncludeTrailingPathDelimiter(ExtractFileDir(GetModuleName(HINSTANCE{$IFDEF FPC}(){$ENDIF})));
{$ELSE}
// DLL filename not supported
Result := IncludeTrailingPathDelimiter(ExtractFileDir(ParamStr(0)));
{$ENDIF MSWINDOWS}
end;
function CefParseUrl(const url: ustring; var parts: TUrlParts): Boolean;
@@ -2080,8 +2096,8 @@ begin
try
if (aFileList <> nil) and
(length(aSrcDirectory) > 0) and
(length(aDstDirectory) > 0) and
DirectoryExists(aSrcDirectory) and
(length(aDstDirectory) > 0) and
DirectoryExists(aSrcDirectory) and
(DirectoryExists(aDstDirectory) or CreateDir(aDstDirectory)) then
begin
i := 0;
@@ -2089,9 +2105,9 @@ begin
while (i < aFileList.Count) do
begin
TempSrcPath := IncludeTrailingPathDelimiter(aSrcDirectory) + aFileList[i];
TempDstPath := IncludeTrailingPathDelimiter(aDstDirectory) + aFileList[i];
TempSrcPath := IncludeTrailingPathDelimiter(aSrcDirectory) + aFileList[i];
TempDstPath := IncludeTrailingPathDelimiter(aDstDirectory) + aFileList[i];
if FileExists(TempSrcPath) and RenameFile(TempSrcPath, TempDstPath) then inc(TempCount);
inc(i);

2
source/uCEFNavigationEntry.pas
View File

@@ -72,7 +72,7 @@ type
implementation
uses
uCEFMiscFunctions, uCefSSLStatus;
uCEFMiscFunctions, uCEFSSLStatus;
function TCefNavigationEntryRef.IsValid: Boolean;
begin

157
source/uCEFOLEDragAndDrop.pas
View File

@@ -88,8 +88,13 @@ type
destructor Destroy; override;
// IEnumFormatEtc
function Next(Celt: LongInt; out Elt; pCeltFetched: pLongInt): HRESULT; stdcall;
{$IFNDEF FPC}
function Next(Celt: LongInt; out Rgelt; pCeltFetched: pLongInt): HRESULT; stdcall;
function Skip(Celt: Longint): HRESULT; stdcall;
{$ELSE}
function Next(Celt: ULONG; out Rgelt: FormatEtc; pceltFetched: PULONG = nil): HRESULT; stdcall;
function Skip(Celt: ULONG): HRESULT; stdcall;
{$ENDIF}
function Reset: HRESULT; stdcall;
function Clone(out Enum: IEnumFormatEtc): HRESULT; stdcall;
end;
@@ -97,8 +102,13 @@ type
TOLEDropSource = class(TInterfacedObject, IDropSource)
public
// IDropSource
{$IFNDEF FPC}
function QueryContinueDrag(fEscapePressed: bool; grfKeyState: LongInt): HRESULT; stdcall;
function GiveFeedback(dwEffect: LongInt): HRESULT; stdcall;
{$ELSE}
function QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: DWORD): HRESULT; stdcall;
function GiveFeedback(dwEffect: DWORD): HRESULT; stdcall;
{$ENDIF}
end;
TOLEDataObject = class(TInterfacedObject, IDataObject)
@@ -120,11 +130,19 @@ type
function GetDataHere(const FormatEtc: TFormatEtc; out Medium: TStgMedium):HRESULT; stdcall;
function QueryGetData(const FormatEtc: TFormatEtc): HRESULT; stdcall;
function GetCanonicalFormatEtc(const FormatEtc: TFormatEtc; out FormatEtcout: TFormatEtc): HRESULT; stdcall;
{$IFNDEF FPC}
function SetData(const FormatEtc: TFormatEtc; var Medium: TStgMedium; fRelease: Bool): HRESULT; stdcall;
function EnumFormatEtc(dwDirection: LongInt; out aEnumFormatEtc: IEnumFormatEtc): HRESULT; stdcall;
function dAdvise(const FormatEtc: TFormatEtc; advf: LongInt; const advsink: IAdviseSink; out dwConnection: LongInt): HRESULT; stdcall;
function dUnadvise(dwConnection: LongInt): HRESULT; stdcall;
{$ELSE}
function SetData(const pformatetc: FORMATETC; const medium: STGMEDIUM; FRelease: BOOL): HRESULT; stdcall;
function EnumFormatEtc(dwDirection: DWORD; out aEnumFormatEtc: IENUMFORMATETC): HRESULT; stdcall;
function DAdvise(const formatetc: FORMATETC; advf: DWORD; const AdvSink: IAdviseSink; out dwConnection: DWORD): HRESULT; stdcall;
function DUnadvise(dwconnection: DWORD): HRESULT; stdcall;
{$ENDIF}
function EnumdAdvise(out EnumAdvise: IEnumStatData): HRESULT; stdcall;
end;
TOLEDropTarget = class(TInterfacedObject, IDropTarget)
@@ -135,10 +153,17 @@ type
constructor Create(const aManager : TOLEDragAndDropMgr); reintroduce;
// IDropTarget
{$IFNDEF FPC}
function DragEnter(const DataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall;
function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall;
function DragLeave: HRESULT; stdcall;
function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall;
{$ELSE}
function DragEnter(const dataObj: IDataObject; grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HRESULT; stdcall;
function DragOver(grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HRESULT; stdcall;
function Drop(const dataObj: IDataObject; grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HRESULT; stdcall;
{$ENDIF}
function DragLeave: HRESULT; stdcall;
end;
implementation
@@ -168,7 +193,11 @@ begin
aMedium.hGlobal := TempHandle;
aMedium.tymed := TYMED_HGLOBAL;
{$IFNDEF FPC}
aMedium.unkForRelease := nil;
{$ELSE}
aMedium.PUnkForRelease := nil;
{$ENDIF}
GlobalUnlock(TempHandle);
@@ -207,6 +236,10 @@ begin
end;
function TOLEDragAndDropMgr.GetStorageForFileDescriptor(var aMedium : TStgMedium; const aFileName : string) : boolean;
{$IFDEF FPC}
const
FD_LINKUI = $8000;
{$ENDIF}
var
TempHandle : HGLOBAL;
TempDescriptor : TFileGroupDescriptor;
@@ -243,7 +276,11 @@ begin
aMedium.tymed := TYMED_HGLOBAL;
aMedium.hGlobal := TempHandle;
{$IFNDEF FPC}
aMedium.unkForRelease := nil;
{$ELSE}
aMedium.PUnkForRelease := nil;
{$ENDIF}
GlobalUnlock(TempHandle);
@@ -330,6 +367,8 @@ begin
end;
procedure TOLEEnumFormatEtc.CopyFormatEtc(var aDstFormatEtc : TFormatEtc; const aSrcFormatEtc : TFormatEtc);
var
Size: Integer;
begin
aDstFormatEtc.cfFormat := aSrcFormatEtc.cfFormat;
aDstFormatEtc.dwAspect := aSrcFormatEtc.dwAspect;
@@ -340,27 +379,28 @@ begin
aDstFormatEtc.ptd := nil
else
begin
aDstFormatEtc.ptd := CoTaskMemAlloc(SizeOf(TDVTargetDevice));
aDstFormatEtc.ptd.tdSize := aSrcFormatEtc.ptd.tdSize;
aDstFormatEtc.ptd.tdDriverNameOffset := aSrcFormatEtc.ptd.tdDriverNameOffset;
aDstFormatEtc.ptd.tdDeviceNameOffset := aSrcFormatEtc.ptd.tdDeviceNameOffset;
aDstFormatEtc.ptd.tdPortNameOffset := aSrcFormatEtc.ptd.tdPortNameOffset;
aDstFormatEtc.ptd.tdExtDevmodeOffset := aSrcFormatEtc.ptd.tdExtDevmodeOffset;
aDstFormatEtc.ptd.tdData := aSrcFormatEtc.ptd.tdData;
Size := Max(aSrcFormatEtc.ptd^.tdSize, SizeOf(DVTARGETDEVICE));
aDstFormatEtc.ptd := CoTaskMemAlloc(Size);
Move(aSrcFormatEtc.ptd^, aDstFormatEtc.ptd^, Size);
end;
end;
function TOLEEnumFormatEtc.Next(Celt: LongInt; out Elt; pCeltFetched: pLongInt): HRESULT;
function TOLEEnumFormatEtc.Next
{$IFNDEF FPC}
(Celt: LongInt; out Rgelt; pCeltFetched: pLongInt): HRESULT; stdcall;
{$ELSE}
(Celt: ULONG; out Rgelt: FormatEtc; pceltFetched: PULONG): HRESULT; stdcall;
{$ENDIF}
var
i : integer;
TempArray : TOLEFormatArray absolute Elt;
TempArray : ^TOLEFormatArray;
begin
i := 0;
TempArray := @Rgelt;
while (i < Celt) and (FIndex < FNumFormats) do
begin
CopyFormatEtc(TempArray[i], FFormatArray[FIndex]);
CopyFormatEtc(TempArray^[i], FFormatArray[FIndex]);
inc(i);
inc(FIndex);
end;
@@ -373,7 +413,12 @@ begin
Result := S_FALSE;
end;
function TOLEEnumFormatEtc.Skip(Celt: Longint): HRESULT;
function TOLEEnumFormatEtc.Skip
{$IFNDEF FPC}
(Celt: Longint): HRESULT; stdcall;
{$ELSE}
(Celt: ULONG): HRESULT; stdcall;
{$ENDIF}
begin
FIndex := FIndex + Celt;
@@ -383,13 +428,13 @@ begin
Result := S_FALSE;
end;
function TOLEEnumFormatEtc.Reset: HRESULT;
function TOLEEnumFormatEtc.Reset: HRESULT; stdcall;
begin
FIndex := 0;
Result := S_OK;
end;
function TOLEEnumFormatEtc.Clone(out Enum: IEnumFormatEtc): HRESULT;
function TOLEEnumFormatEtc.Clone(out Enum: IEnumFormatEtc): HRESULT; stdcall;
begin
Enum := TOLEEnumFormatEtc.Create(FFormatArray, FNumFormats, FIndex);
Result := S_OK;
@@ -407,14 +452,24 @@ begin
FManager := aManager;
end;
function TOLEDropTarget.DragEnter(const DataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall;
function TOLEDropTarget.DragEnter
{$IFNDEF FPC}
(const DataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall;
{$ELSE}
(const dataObj: IDataObject; grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HRESULT; stdcall;
{$ENDIF}
begin
Result := FManager.DragEnter(DataObj, grfKeyState, pt, dwEffect);
Result := FManager.DragEnter(DataObj, grfKeyState, pt, Longint(dwEffect));
end;
function TOLEDropTarget.DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall;
function TOLEDropTarget.DragOver
{$IFNDEF FPC}
(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall;
{$ELSE}
(grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HRESULT; stdcall;
{$ENDIF}
begin
Result := FManager.DragOver(grfKeyState, pt, dwEffect);
Result := FManager.DragOver(grfKeyState, pt, Longint(dwEffect));
end;
function TOLEDropTarget.DragLeave: HRESULT; stdcall;
@@ -422,9 +477,14 @@ begin
Result := FManager.DragLeave;
end;
function TOLEDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall;
function TOLEDropTarget.Drop
{$IFNDEF FPC}
(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall;
{$ELSE}
(const dataObj: IDataObject; grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HRESULT; stdcall;
{$ENDIF}
begin
Result := FManager.Drop(dataObj, grfKeyState, pt, dwEffect);
Result := FManager.Drop(dataObj, grfKeyState, pt, Longint(dwEffect));
end;
@@ -432,7 +492,12 @@ end;
// ****************** TOLEDropSource *******************
// *****************************************************
function TOLEDropSource.QueryContinueDrag(fEscapePressed: bool; grfKeyState: LongInt): HRESULT; stdcall;
function TOLEDropSource.QueryContinueDrag
{$IFNDEF FPC}
(fEscapePressed: bool; grfKeyState: LongInt): HRESULT; stdcall;
{$ELSE}
(fEscapePressed: BOOL; grfKeyState: DWORD): HRESULT; stdcall;
{$ENDIF}
begin
if fEscapePressed then
Result := DRAGDROP_S_CANCEL
@@ -443,7 +508,12 @@ begin
Result := S_OK;
end;
function TOLEDropSource.GiveFeedback(dwEffect: LongInt): HRESULT; stdcall;
function TOLEDropSource.GiveFeedback
{$IFNDEF FPC}
(dwEffect: LongInt): HRESULT; stdcall;
{$ELSE}
(dwEffect: DWORD): HRESULT; stdcall;
{$ENDIF}
begin
Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;
@@ -542,14 +612,22 @@ begin
if (i < 0) or ((FFormatArray[i].tymed and TYMED_HGLOBAL) = 0) then
begin
Medium.tymed := TYMED_NULL;
{$IFNDEF FPC}
Medium.unkForRelease := nil;
{$ELSE}
Medium.PUnkForRelease := nil;
{$ENDIF}
Medium.hGlobal := 0;
Result := DV_E_FORMATETC;
end
else
begin
Medium.tymed := FFormatArray[i].tymed;
{$IFNDEF FPC}
Medium.unkForRelease := nil;
{$ELSE}
Medium.PUnkForRelease := nil;
{$ENDIF}
Medium.hGlobal := DupGlobalMem(FMediumArray[i].hGlobal);
Result := S_OK;
end;
@@ -579,12 +657,22 @@ begin
Result := E_NOTIMPL;
end;
function TOLEDataObject.SetData(const FormatEtc: TFormatEtc; var Medium: TStgMedium; fRelease: Bool): HRESULT; stdcall;
function TOLEDataObject.SetData
{$IFNDEF FPC}
(const FormatEtc: TFormatEtc; var Medium: TStgMedium; fRelease: Bool): HRESULT; stdcall;
{$ELSE}
(const pformatetc: FORMATETC; const medium: STGMEDIUM; FRelease: BOOL): HRESULT; stdcall;
{$ENDIF}
begin
Result := E_NOTIMPL;
end;
function TOLEDataObject.EnumFormatEtc(dwDirection: LongInt; out aEnumFormatEtc: IEnumFormatEtc): HRESULT; stdcall;
function TOLEDataObject.EnumFormatEtc
{$IFNDEF FPC}
(dwDirection: LongInt; out aEnumFormatEtc: IEnumFormatEtc): HRESULT; stdcall;
{$ELSE}
(dwDirection: DWORD; out aEnumFormatEtc: IENUMFORMATETC): HRESULT; stdcall;
{$ENDIF}
begin
if (dwDirection = DATADIR_GET) then
begin
@@ -602,15 +690,22 @@ begin
end;
end;
function TOLEDataObject.dAdvise(const FormatEtc: TFormatEtc;
advf: LongInt;
const advsink: IAdviseSink;
out dwConnection: LongInt): HRESULT; stdcall;
function TOLEDataObject.dAdvise
{$IFNDEF FPC}
(const FormatEtc: TFormatEtc; advf: LongInt; const advsink: IAdviseSink; out dwConnection: LongInt): HRESULT; stdcall;
{$ELSE}
(const formatetc: FORMATETC; advf: DWORD; const AdvSink: IAdviseSink; out dwConnection: DWORD): HRESULT; stdcall;
{$ENDIF}
begin
Result := OLE_E_ADVISENOTSUPPORTED;
end;
function TOLEDataObject.dUnadvise(dwConnection: LongInt): HRESULT; stdcall;
function TOLEDataObject.dUnadvise
{$IFNDEF FPC}
(dwConnection: LongInt): HRESULT; stdcall;
{$ELSE}
(dwconnection: DWORD): HRESULT; stdcall;
{$ENDIF}
begin
Result := OLE_E_ADVISENOTSUPPORTED;
end;

25
source/uCEFSentinel.pas
View File

@@ -80,7 +80,9 @@ type
{$IFNDEF FPC}{$IFDEF DELPHI16_UP}[ComponentPlatformsAttribute(pidWin32 or pidWin64)]{$ENDIF}{$ENDIF}
TCEFSentinel = class(TComponent)
protected
{$IFDEF MSWINDOWS}
FCompHandle : HWND;
{$ENDIF}
FStatus : TSentinelStatus;
FStatusCS : TCriticalSection;
FDelayPerProcMs : cardinal;
@@ -99,8 +101,8 @@ type
procedure WndProc(var aMessage: TMessage);
procedure doStartMsg(var aMessage : TMessage); virtual;
procedure doCloseMsg(var aMessage : TMessage); virtual;
{$ENDIF}
function SendCompMessage(aMsg : cardinal) : boolean;
{$ENDIF}
function CanClose : boolean; virtual;
procedure Timer_OnTimer(Sender: TObject); virtual;
@@ -137,7 +139,9 @@ constructor TCEFSentinel.Create(AOwner: TComponent);
begin
inherited Create(aOwner);
{$IFDEF MSWINDOWS}
FCompHandle := 0;
{$ENDIF}
FDelayPerProcMs := CEFSENTINEL_DEFAULT_DELAYPERPROCMS;
FMinInitDelayMs := CEFSENTINEL_DEFAULT_MININITDELAYMS;
FFinalDelayMs := CEFSENTINEL_DEFAULT_FINALDELAYMS;
@@ -151,22 +155,13 @@ begin
end;
procedure TCEFSentinel.AfterConstruction;
{$IFDEF FPC}
var
TempWndMethod : TWndMethod;
{$ENDIF}
begin
inherited AfterConstruction;
if not(csDesigning in ComponentState) then
begin
{$IFDEF FPC}
{$IFDEF MSWINDOWS}
TempWndMethod := @WndProc;
FCompHandle := AllocateHWnd(TempWndMethod);
{$ENDIF}
{$ELSE}
FCompHandle := AllocateHWnd(WndProc);
FCompHandle := AllocateHWnd({$IFDEF FPC}@{$ENDIF}WndProc);
{$ENDIF}
FStatusCS := TCriticalSection.Create;
@@ -218,12 +213,12 @@ procedure TCEFSentinel.doCloseMsg(var aMessage : TMessage);
begin
if assigned(FOnClose) then FOnClose(self);
end;
{$ENDIF}
function TCEFSentinel.SendCompMessage(aMsg : cardinal) : boolean;
begin
Result := (FCompHandle <> 0) and PostMessage(FCompHandle, aMsg, 0, 0);
end;
{$ENDIF}
procedure TCEFSentinel.Start;
begin
@@ -233,7 +228,9 @@ begin
if (FStatus = ssIdle) then
begin
FStatus := ssInitialDelay;
{$IFDEF MSWINDOWS}
SendCompMessage(CEF_SENTINEL_START);
{$ENDIF}
end;
finally
if (FStatusCS <> nil) then FStatusCS.Release;
@@ -280,7 +277,9 @@ begin
if CanClose then
begin
FStatus := ssClosing;
{$IFDEF MSWINDOWS}
SendCompMessage(CEF_SENTINEL_DOCLOSE);
{$ENDIF}
end
else
begin
@@ -294,7 +293,9 @@ begin
if CanClose then
begin
FStatus := ssClosing;
{$IFDEF MSWINDOWS}
SendCompMessage(CEF_SENTINEL_DOCLOSE);
{$ENDIF}
end
else
begin

8
source/uCEFWinControl.pas
View File

@@ -133,19 +133,21 @@ begin
end;
function TCEFWinControl.TakeSnapshot(var aBitmap : TBitmap) : boolean;
{$IFDEF MSWINDOWS}
var
TempHWND : HWND;
TempDC : HDC;
TempRect : TRect;
TempWidth : Integer;
TempHeight : Integer;
{$ENDIF}
begin
Result := False;
{$IFDEF MSWINDOWS}
if (aBitmap = nil) then exit;
TempHWND := ChildWindowHandle;
if (TempHWND = 0) then exit;
{$IFDEF MSWINDOWS}
{$IFDEF DELPHI16_UP}Winapi.{$ENDIF}Windows.GetClientRect(TempHWND, TempRect);
TempDC := GetDC(TempHWND);
TempWidth := TempRect.Right - TempRect.Left;
@@ -163,12 +165,16 @@ begin
end;
function TCEFWinControl.DestroyChildWindow : boolean;
{$IFDEF MSWINDOWS}
var
TempHWND : HWND;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
TempHWND := ChildWindowHandle;
Result := (TempHWND <> 0) and DestroyWindow(TempHWND);
{$ELSE}
Result := False;
{$ENDIF}
end;

15
source/uCEFWorkScheduler.pas
View File

@@ -166,10 +166,6 @@ begin
end;
procedure TCEFWorkScheduler.AfterConstruction;
{$IFDEF FPC}
var
TempWndMethod : TWndMethod;
{$ENDIF}
begin
inherited AfterConstruction;
@@ -179,12 +175,7 @@ begin
if (GlobalCEFApp <> nil) and
((GlobalCEFApp.ProcessType = ptBrowser) or GlobalCEFApp.SingleProcess) then
begin
{$IFDEF FPC}
TempWndMethod := @WndProc;
FCompHandle := AllocateHWnd(TempWndMethod);
{$ELSE}
FCompHandle := AllocateHWnd(WndProc);
{$ENDIF}
FCompHandle := AllocateHWnd({$IFDEF FPC}@{$ENDIF}WndProc);
end;
{$ENDIF}
@@ -203,7 +194,11 @@ begin
{$IFDEF DELPHI14_UP}
FThread.Start;
{$ELSE}
{$IFNDEF FPC}
FThread.Resume;
{$ELSE}
FThread.Start;
{$ENDIF}
{$ENDIF}
end;

37
source/uCEFWriteHandler.pas
View File

@@ -238,14 +238,7 @@ begin
{$IFDEF MSWINDOWS}
DeleteCriticalSection(FCriticalSection);
FCriticalSection.DebugInfo := nil;
FCriticalSection.LockCount := 0;
FCriticalSection.RecursionCount := 0;
FCriticalSection.OwningThread := 0;
FCriticalSection.LockSemaphore := 0;
{$IFNDEF FPC}
FCriticalSection.Reserved := 0;
{$ENDIF}
FillChar(FCriticalSection, SizeOf(FCriticalSection), 0);
{$ELSE}
DoneCriticalSection(FCriticalSection);
{$ENDIF}
@@ -259,22 +252,24 @@ var
TempSize : int64;
begin
EnterCriticalSection(FCriticalSection);
try
TempSize := size * n;
TempSize := size * n;
if ((FOffset + TempSize) >= FBufferSize) and (Grow(TempSize) = 0) then
Result := 0
else
begin
TempPointer := Pointer(cardinal(FBuffer) + FOffset);
if ((FOffset + TempSize) >= FBufferSize) and (Grow(TempSize) = 0) then
Result := 0
else
begin
TempPointer := Pointer(cardinal(FBuffer) + FOffset);
Move(ptr^, TempPointer^, TempSize);
Move(ptr^, TempPointer^, TempSize);
FOffset := FOffset + TempSize;
Result := n;
end;
FOffset := FOffset + TempSize;
Result := n;
end;
LeaveCriticalSection(FCriticalSection);
finally
LeaveCriticalSection(FCriticalSection);
end;
end;
function TCefBytesWriteHandler.Seek(offset: Int64; whence: Integer): Integer;
@@ -352,8 +347,8 @@ function TCefBytesWriteHandler.Grow(size : NativeUInt) : NativeUInt;
var
TempTotal : int64;
begin
EnterCriticalSection(FCriticalSection);
try
EnterCriticalSection(FCriticalSection);
if (size < FGrow) then
TempTotal := FGrow

2
source/uCEFV8Exception.pas → source/uCEFv8Exception.pas
View File

@@ -35,7 +35,7 @@
*
*)
unit uCEFV8Exception;
unit uCEFv8Exception;
{$IFDEF FPC}
{$MODE OBJFPC}{$H+}

2
source/uCEFv8Value.pas
View File

@@ -133,7 +133,7 @@ implementation
uses
uCEFMiscFunctions, uCEFLibFunctions, uCEFv8Accessor, uCEFv8Handler, uCEFv8Exception,
uCEFv8Interceptor, uCEFStringList, uCefv8ArrayBufferReleaseCallback;
uCEFv8Interceptor, uCEFStringList, uCEFv8ArrayBufferReleaseCallback;
function TCefv8ValueRef.AdjustExternallyAllocatedMemory(changeInBytes: Integer): Integer;
begin

2
update_CEF4Delphi.json
View File

@@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 61,
"InternalVersion" : 62,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "78.3.1.0"
}