You've already forked CEF4Delphi
mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2025-06-22 22:17:48 +02:00
New TLazarusBrowserWindow. Handles all required events.
This commit is contained in:
martin
@ -1,6 +1,6 @@
|
|||||||
<?xml version="1.0" encoding="UTF-8"?>
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
<CONFIG>
|
<CONFIG>
|
||||||
<Package Version="4">
|
<Package Version="5">
|
||||||
<PathDelim Value="\"/>
|
<PathDelim Value="\"/>
|
||||||
<Name Value="CEF4Delphi_Lazarus"/>
|
<Name Value="CEF4Delphi_Lazarus"/>
|
||||||
<Type Value="RunAndDesignTime"/>
|
<Type Value="RunAndDesignTime"/>
|
||||||
@ -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."/>
|
<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"/>
|
<License Value="MPL 1.1"/>
|
||||||
<Version Major="88" Minor="2" Release="9"/>
|
<Version Major="88" Minor="2" Release="9"/>
|
||||||
<Files Count="199">
|
<Files Count="200">
|
||||||
<Item1>
|
<Item1>
|
||||||
<Filename Value="..\source\uCEFAccessibilityHandler.pas"/>
|
<Filename Value="..\source\uCEFAccessibilityHandler.pas"/>
|
||||||
<UnitName Value="uCEFAccessibilityHandler"/>
|
<UnitName Value="uCEFAccessibilityHandler"/>
|
||||||
@ -835,7 +835,13 @@
|
|||||||
<Filename Value="..\source\uceflazaruscocoa.pas"/>
|
<Filename Value="..\source\uceflazaruscocoa.pas"/>
|
||||||
<UnitName Value="uceflazaruscocoa"/>
|
<UnitName Value="uceflazaruscocoa"/>
|
||||||
</Item199>
|
</Item199>
|
||||||
|
<Item200>
|
||||||
|
<Filename Value="..\source\uceflazarusbrowserwindow.pas"/>
|
||||||
|
<HasRegisterProc Value="True"/>
|
||||||
|
<UnitName Value="uceflazarusbrowserwindow"/>
|
||||||
|
</Item200>
|
||||||
</Files>
|
</Files>
|
||||||
|
<CompatibilityMode Value="True"/>
|
||||||
<RequiredPkgs Count="4">
|
<RequiredPkgs Count="4">
|
||||||
<Item1>
|
<Item1>
|
||||||
<PackageName Value="dcpcrypt"/>
|
<PackageName Value="dcpcrypt"/>
|
||||||
|
|||||||
@ -66,7 +66,7 @@ uses
|
|||||||
uCEFPrintDialogCallback, uCEFPrintHandler, uCEFPrintJobCallback,
|
uCEFPrintDialogCallback, uCEFPrintHandler, uCEFPrintJobCallback,
|
||||||
uCEFLinuxFunctions, uCEFLinuxTypes, uCEFLinuxConstants,
|
uCEFLinuxFunctions, uCEFLinuxTypes, uCEFLinuxConstants,
|
||||||
uCEFWorkSchedulerQueueThread, uCEFLinkedWinControlBase, uCEFLazarusCocoa,
|
uCEFWorkSchedulerQueueThread, uCEFLinkedWinControlBase, uCEFLazarusCocoa,
|
||||||
LazarusPackageIntf;
|
uCEFLazarusBrowserWindow, LazarusPackageIntf;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
@ -89,6 +89,7 @@ begin
|
|||||||
RegisterUnit('uCEFPanelComponent', @uCEFPanelComponent.Register);
|
RegisterUnit('uCEFPanelComponent', @uCEFPanelComponent.Register);
|
||||||
RegisterUnit('uCEFScrollViewComponent', @uCEFScrollViewComponent.Register);
|
RegisterUnit('uCEFScrollViewComponent', @uCEFScrollViewComponent.Register);
|
||||||
RegisterUnit('uCEFTextfieldComponent', @uCEFTextfieldComponent.Register);
|
RegisterUnit('uCEFTextfieldComponent', @uCEFTextfieldComponent.Register);
|
||||||
|
RegisterUnit('uCEFLazarusBrowserWindow', @uCEFLazarusBrowserWindow.Register);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
|
|||||||
38
source/res/tlazarusbrowserwindow.lrs
Normal file
38
source/res/tlazarusbrowserwindow.lrs
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
LazarusResources.Add('tlazarusbrowserwindow','PNG',[
|
||||||
|
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#2#0#0#0'o'#21#170#175
|
||||||
|
+#0#0#0#9'pHYs'#0#0#13#215#0#0#13#215#1'B('#155'x'#0#0#0#7'tIME'#7#226#5#11#10
|
||||||
|
+#31#18#187#205#226'X'#0#0#3#10'IDAT8'#203#173#149'Ml'#27'U'#16#199'g'#158'7'
|
||||||
|
+#222#197'Qk'#183'IIBl#'#156'JM'#12'V'#137#168#16'E *8Qn'#17' '#142#168#226
|
||||||
|
+#200#181#189'p'#228#128#212'['#213#3'\'#171#194#165'= TQ'#129'P'#131#26#138
|
||||||
|
+'d'#167#20'PE'#212'H'#9'_'#18'i'#226#218#241'G'#214'~'#187#222'}3'#195'a#w'
|
||||||
|
+#243'Q)'#144#206'i5o'#222'_3'#191#153'y'#139'"'#2#143#195','#215'u'#23#23#23
|
||||||
|
+#247#169'R,'#22#161'\.'#19#145#236#195#136#168'\.+"RJ'#237''''#29#165#20#17
|
||||||
|
+#237'I'#162'g'#246#192#232'Q'#7'k.\-'#223#191#241#253'M'#1#4#128#4#192#169
|
||||||
|
+#215'_}'#231#197#241#177#131#143#22'b'#230'm'#222'Oo5'#191#190'v'#205'NZ'#153
|
||||||
|
+'L'#26#5#1#128#133'ggg'#175'_'#15#222#255#224#204#187#147#187'4Z'#1#128#136
|
||||||
|
+'p'#204'.'#220'l^'#186#252#133#149't'#208'Jv'#180#239'j'#175#165#187#237#142
|
||||||
|
+'6'#146#224'D'#242#147#243#23#206']Y'#142#199'G'#3#180#153'Q'#127#154'j'#30
|
||||||
|
+#206#207#223'N$'#157#182#246#200#176#31#154#227#133#209#3#169#228'j'#203#183
|
||||||
|
+#5#6#149#12#165#7#239#222#254'a'#253#244'3'#135#156#205'+'#136#184')'#20'e'
|
||||||
|
+#20'y'#231#254#30'('#30'+'#212'j'#235'n'#167'{4w'#248#243#143#222'^m'#19#139
|
||||||
|
+'d3'#214#221#127#186':'#228#148'm'#245#180'k'#148'b'#14#251']'#3#0'+R!'#162
|
||||||
|
+#200'['#249'y!?>'#246#236'sS_~'#245#237#220#197'3'#31'_Y'#178#7#20'"z~xvfb'
|
||||||
|
+#249#129#7#28#218#142#179#244#231#253'L'#225'p'#31#144#136#168#168#180'X'#193
|
||||||
|
+'@l'#242#217#209#247'N'#191#242#203#239#27#141#166#214':'#208#186#215'r{'#183
|
||||||
|
+'~'#171#167#146#9'f'#16#129'-P'#153'w)'#141'X'#136#152#133#166'&'''#218#186
|
||||||
|
+'Wk{'#134#24#17'Z:'#232#6#6#128#1#0#1#12#131'!V'#24'+'#173#159'Q$'#20#132#20
|
||||||
|
+#24#177'mY'#217#8'_'#155#28'Zu'#189#7']'#31#1#12'K'#169#144#209#1'#'#2#3#244
|
||||||
|
+#136'@'#152#5#250#211'cE*}F'''#166#167#23#238'-'#140#28'9d)u'#227#158#251#217
|
||||||
|
+#135'/|sgMD'#222'x~'#196'0'#136#0' 4'#154#237'\6K'#180#209#135#205#204#219#25
|
||||||
|
+#189'<'#214#233't}'#207'7'#134#184#222#9#175#222'i'#13#13#165#237#212#224#210
|
||||||
|
+#154'oH'#16' 4'#208#236#132#25#232'lc'#180'} '#135#147#193'K'''#166'W'#170'u'
|
||||||
|
+#207#15'{'#129#17#162#229#170'n'#235#224#216'S'#131'!'#177#14#229#143#149'Zv'
|
||||||
|
+'|'#212#134'`'#247#129#140'o'#201'['#185#134#147'(}'#247#227#175#169''''#236
|
||||||
|
+'t'#250'`h'#248#228#241#225#182'G'#213'zk'#221#13#158#206#231'rV3'#190'T'#15
|
||||||
|
+#187#22'g'#20#217#169#145'F'#241#205#137#185'j'#166'2'#255#211#147#233#129
|
||||||
|
+#191'V'#209#13'h'#234'h'#225#228#145#214#1#171#190'5v'#171#208#206#189#29#182
|
||||||
|
+'{3'#249#234'L>'#23#243'U'#1'`G <d'#244'x'#222#236' '#8#148'R'#142#227#252'o'
|
||||||
|
+#9'D'#212'Zc'#163#209#168'T*'#158#231#25'c'#254#235#31#5#17#17#209'q'#156'R'
|
||||||
|
+#169#132#241#203';I'#237#229#193#142'>'#254#5'Ixq'#26'FW'#221'b'#0#0#0#0'IEN'
|
||||||
|
+'D'#174'B`'#130
|
||||||
|
]);
|
||||||
487
source/uceflazarusbrowserwindow.pas
Normal file
487
source/uceflazarusbrowserwindow.pas
Normal file
@ -0,0 +1,487 @@
|
|||||||
|
// ************************************************************************
|
||||||
|
// ***************************** 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 © 2021 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 uCEFLazarusBrowserWindow;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
{$i cef.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF FPC}
|
||||||
|
LResources,
|
||||||
|
{$ENDIF}
|
||||||
|
uCEFApplication, uCEFChromiumWindow, uCEFTypes, uCEFInterfaces, uCEFChromium,
|
||||||
|
uCEFLinkedWinControlBase, Forms, ExtCtrls, Classes, sysutils;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
(* On cocoa closing a browser does not work, while the application is in any other event.
|
||||||
|
I.e. if the App is in a button-press event, then the browser will
|
||||||
|
only close once that event was finished.
|
||||||
|
*)
|
||||||
|
|
||||||
|
TLazarusBrowserWindow = class;
|
||||||
|
|
||||||
|
{ TChromiumWrapper }
|
||||||
|
|
||||||
|
TChromiumWrapper = class
|
||||||
|
protected type
|
||||||
|
TWrapperChromiumState = (csNoBrowser, csCreatingBrowser, csHasBrowser, csClosingBrowser, csCloseAfterCreate);
|
||||||
|
TWrapperState = (wsNone, wsWaitingForClose, wsSentCloseEventAfterWait, wsDestroyAfterWait);
|
||||||
|
protected
|
||||||
|
FChromium : TChromium;
|
||||||
|
FChromiumState : TWrapperChromiumState;
|
||||||
|
FWrapperState : TWrapperState;
|
||||||
|
|
||||||
|
FBrowserWindow : TLazarusBrowserWindow;
|
||||||
|
FLoadUrl : ustring;
|
||||||
|
|
||||||
|
procedure WebBrowser_OnAfterCreated(Sender: TObject; const browser: ICefBrowser);
|
||||||
|
procedure WebBrowser_OnClose(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction); reintroduce;
|
||||||
|
procedure WebBrowser_OnBeforeClose(Sender: TObject; const browser: ICefBrowser); reintroduce;
|
||||||
|
{$IFDEF FPC}
|
||||||
|
procedure WebBrowser_OnGotFocus(Sender: TObject; const browser: ICefBrowser);
|
||||||
|
{$ENDIF}
|
||||||
|
procedure DoCreated(Data: PtrInt);
|
||||||
|
|
||||||
|
procedure MaybeDestroy;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TLazarusBrowserWindow); reintroduce;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
function CreateBrowser: boolean;
|
||||||
|
procedure LoadURL(aURL: ustring);
|
||||||
|
procedure CloseBrowser(aForceClose: boolean);
|
||||||
|
function IsClosed: boolean;
|
||||||
|
(* WaitForBrowserClosed calls ProcessMessages.
|
||||||
|
It therefore is possible that the TLazarusBrowserWindow will be destroyed
|
||||||
|
when this method returns.
|
||||||
|
It is the callers responsibility to take any necessary precaution.
|
||||||
|
*)
|
||||||
|
procedure WaitForBrowserClosed;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TLazarusBrowserWindow }
|
||||||
|
|
||||||
|
(* On MacOs TLazarusBrowserWindow must wait for OnBrowserClosed before it can
|
||||||
|
be destroyed or before its handle can be closed
|
||||||
|
*)
|
||||||
|
|
||||||
|
TLazarusBrowserWindow = class(TCEFLinkedWinControlBase)
|
||||||
|
private
|
||||||
|
FChromiumWrapper : TChromiumWrapper;
|
||||||
|
|
||||||
|
FOnBrowserClosed : TNotifyEvent;
|
||||||
|
FOnBrowserCreated : TNotifyEvent;
|
||||||
|
FTimer : TTimer;
|
||||||
|
|
||||||
|
procedure DoCreateBrowser(Sender: TObject);
|
||||||
|
protected
|
||||||
|
function GetChromium: TChromium; override;
|
||||||
|
procedure DestroyHandle; override;
|
||||||
|
procedure RealizeBounds; override;
|
||||||
|
|
||||||
|
procedure DoEnter; override;
|
||||||
|
procedure DoExit; override;
|
||||||
|
procedure DoOnCreated;
|
||||||
|
procedure DoOnClosed(Data: PtrInt);
|
||||||
|
procedure DoOnFocus(Data: PtrInt);
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure CreateHandle; override;
|
||||||
|
|
||||||
|
procedure CloseBrowser(aForceClose: boolean);
|
||||||
|
procedure WaitForBrowserClosed;
|
||||||
|
function IsClosed: boolean;
|
||||||
|
procedure LoadURL(aURL: ustring);
|
||||||
|
|
||||||
|
published
|
||||||
|
property Chromium; // : TChromium read GetChromium;
|
||||||
|
|
||||||
|
property OnBrowserCreated : TNotifyEvent read FOnBrowserCreated write FOnBrowserCreated;
|
||||||
|
(* OnBrowserClosed will not be called, if the TLazarusBrowserWindow is
|
||||||
|
destroyed/destroying before the browser is closed.
|
||||||
|
*)
|
||||||
|
property OnBrowserClosed : TNotifyEvent read FOnBrowserClosed write FOnBrowserClosed;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
procedure Register;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TChromiumWrapper }
|
||||||
|
|
||||||
|
procedure TChromiumWrapper.WebBrowser_OnAfterCreated(Sender: TObject;
|
||||||
|
const browser: ICefBrowser);
|
||||||
|
begin
|
||||||
|
(* We may still be in Chromium.CreateBrowserSync
|
||||||
|
In that case initialization will happen after this event,
|
||||||
|
but before the call to CreateBrowser returns
|
||||||
|
*)
|
||||||
|
Application.QueueAsyncCall(@DoCreated, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChromiumWrapper.WebBrowser_OnClose(Sender: TObject;
|
||||||
|
const browser: ICefBrowser; var aAction: TCefCloseBrowserAction);
|
||||||
|
begin
|
||||||
|
(* FBrowserWindow should always be <> nil
|
||||||
|
If FBrowserWindow is nil (MacOS) then the FBrowserWindow.Handle is destroyed too,
|
||||||
|
and CEF should call BeforeClose, without calling DoClose
|
||||||
|
*)
|
||||||
|
if (FBrowserWindow <> nil) and FBrowserWindow.DestroyChildWindow then
|
||||||
|
aAction := cbaDelay
|
||||||
|
else
|
||||||
|
aAction := cbaClose;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChromiumWrapper.WebBrowser_OnBeforeClose(Sender: TObject;
|
||||||
|
const browser: ICefBrowser);
|
||||||
|
begin
|
||||||
|
FChromiumState := csNoBrowser;
|
||||||
|
|
||||||
|
if (FBrowserWindow <> nil) then begin
|
||||||
|
if FWrapperState = wsWaitingForClose then
|
||||||
|
FWrapperState := wsSentCloseEventAfterWait
|
||||||
|
else
|
||||||
|
Application.QueueAsyncCall(@FBrowserWindow.DoOnClosed, 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChromiumWrapper.WebBrowser_OnGotFocus(Sender: TObject;
|
||||||
|
const browser: ICefBrowser);
|
||||||
|
begin
|
||||||
|
if (FBrowserWindow <> nil) then
|
||||||
|
Application.QueueAsyncCall(@FBrowserWindow.DoOnFocus, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChromiumWrapper.DoCreated(Data: PtrInt);
|
||||||
|
begin
|
||||||
|
|
||||||
|
// Any other state, means this is a late async call
|
||||||
|
case FChromiumState of
|
||||||
|
csCreatingBrowser: begin
|
||||||
|
FChromiumState := csHasBrowser;
|
||||||
|
if FLoadUrl <> '' then
|
||||||
|
LoadURL(FLoadUrl);
|
||||||
|
|
||||||
|
if (FBrowserWindow <> nil) then
|
||||||
|
FBrowserWindow.DoOnCreated;
|
||||||
|
end;
|
||||||
|
csCloseAfterCreate: begin
|
||||||
|
FChromiumState := csHasBrowser;
|
||||||
|
CloseBrowser(True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChromiumWrapper.MaybeDestroy;
|
||||||
|
begin
|
||||||
|
CloseBrowser(True);
|
||||||
|
FBrowserWindow := nil;
|
||||||
|
|
||||||
|
if FWrapperState in [wsWaitingForClose, wsSentCloseEventAfterWait] then
|
||||||
|
FWrapperState := wsDestroyAfterWait;
|
||||||
|
|
||||||
|
if FChromiumState = csNoBrowser then
|
||||||
|
Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TChromiumWrapper.Create(AOwner: TLazarusBrowserWindow);
|
||||||
|
begin
|
||||||
|
FBrowserWindow := AOwner;
|
||||||
|
FChromiumState := csNoBrowser;
|
||||||
|
FWrapperState := wsNone;
|
||||||
|
|
||||||
|
if not(csDesigning in AOwner.ComponentState) then
|
||||||
|
begin
|
||||||
|
FChromium := TChromium.Create(nil);
|
||||||
|
FChromium.OnClose := {$IFDEF FPC}@{$ENDIF}WebBrowser_OnClose;
|
||||||
|
FChromium.OnBeforeClose := {$IFDEF FPC}@{$ENDIF}WebBrowser_OnBeforeClose;
|
||||||
|
FChromium.OnAfterCreated := {$IFDEF FPC}@{$ENDIF}WebBrowser_OnAfterCreated;
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
// This is a workaround for the CEF issue #2026. Read below for more info.
|
||||||
|
FChromium.OnGotFocus := {$IFDEF FPC}@{$ENDIF}WebBrowser_OnGotFocus;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
inherited Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TChromiumWrapper.Destroy;
|
||||||
|
begin
|
||||||
|
|
||||||
|
if FChromiumState <> csNoBrowser then
|
||||||
|
WaitForBrowserClosed;
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
FChromium.Destroy;
|
||||||
|
Application.RemoveAsyncCalls(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TChromiumWrapper.CreateBrowser: boolean;
|
||||||
|
begin
|
||||||
|
if FChromiumState <> csNoBrowser then
|
||||||
|
exit(False);
|
||||||
|
|
||||||
|
FChromiumState := csCreatingBrowser;
|
||||||
|
Result := FChromium.CreateBrowser(FBrowserWindow, '');
|
||||||
|
if Result then begin
|
||||||
|
if FChromium.Initialized then
|
||||||
|
DoCreated(0);
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
FChromiumState := csNoBrowser;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChromiumWrapper.LoadURL(aURL: ustring);
|
||||||
|
begin
|
||||||
|
FLoadUrl := '';
|
||||||
|
if FChromiumState = csHasBrowser then
|
||||||
|
FChromium.LoadURL(aURL)
|
||||||
|
else
|
||||||
|
FLoadUrl := aURL;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChromiumWrapper.CloseBrowser(aForceClose: boolean);
|
||||||
|
begin
|
||||||
|
if FChromiumState = csCreatingBrowser then begin
|
||||||
|
FChromiumState := csCloseAfterCreate;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if FChromiumState in [csHasBrowser] then
|
||||||
|
begin
|
||||||
|
FChromiumState := csClosingBrowser;
|
||||||
|
FChromium.CloseBrowser(aForceClose);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TChromiumWrapper.IsClosed: boolean;
|
||||||
|
begin
|
||||||
|
Result := FChromiumState = csNoBrowser;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChromiumWrapper.WaitForBrowserClosed;
|
||||||
|
begin
|
||||||
|
if FChromiumState = csNoBrowser then
|
||||||
|
exit;
|
||||||
|
if FChromiumState <> csClosingBrowser then
|
||||||
|
CloseBrowser(True);
|
||||||
|
|
||||||
|
FWrapperState := wsWaitingForClose;
|
||||||
|
while FChromiumState <> csNoBrowser do begin
|
||||||
|
Application.ProcessMessages;
|
||||||
|
if GlobalCEFApp.ExternalMessagePump then
|
||||||
|
GlobalCEFApp.DoMessageLoopWork;
|
||||||
|
sleep(5);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (FBrowserWindow <> nil) and
|
||||||
|
(FWrapperState = wsSentCloseEventAfterWait)
|
||||||
|
then
|
||||||
|
Application.QueueAsyncCall(@FBrowserWindow.DoOnClosed, 0);
|
||||||
|
|
||||||
|
if FWrapperState = wsDestroyAfterWait then
|
||||||
|
Destroy
|
||||||
|
else
|
||||||
|
FWrapperState := wsNone;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TLazarusBrowserWindow }
|
||||||
|
|
||||||
|
procedure TLazarusBrowserWindow.DoCreateBrowser(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FTimer.Enabled := False;
|
||||||
|
|
||||||
|
case FChromiumWrapper.FChromiumState of
|
||||||
|
csCreatingBrowser, csHasBrowser: begin
|
||||||
|
FreeAndNil(FTimer);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
csClosingBrowser, csCloseAfterCreate: begin
|
||||||
|
// need new wrapper // This could prevent an OnBrowserClosed event
|
||||||
|
FChromiumWrapper.MaybeDestroy;
|
||||||
|
FChromiumWrapper := TChromiumWrapper.Create(Self);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FChromiumWrapper.CreateBrowser then begin
|
||||||
|
FreeAndNil(FTimer);
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
if GlobalCEFApp.ExternalMessagePump then
|
||||||
|
GlobalCEFApp.DoMessageLoopWork;
|
||||||
|
|
||||||
|
FTimer.Interval := 100;
|
||||||
|
FTimer.Enabled := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TLazarusBrowserWindow.GetChromium: TChromium;
|
||||||
|
begin
|
||||||
|
Result := FChromiumWrapper.FChromium;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TLazarusBrowserWindow.CreateHandle;
|
||||||
|
begin
|
||||||
|
inherited CreateHandle;
|
||||||
|
if not (csDesigning in ComponentState) then begin
|
||||||
|
(* On Windows we can create the browser immediately.
|
||||||
|
But at least on Linux, we need to wait
|
||||||
|
*)
|
||||||
|
FTimer := TTimer.Create(Self);
|
||||||
|
FTimer.Interval := 20;
|
||||||
|
FTimer.OnTimer := @DoCreateBrowser;
|
||||||
|
FTimer.Enabled := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TLazarusBrowserWindow.DestroyHandle;
|
||||||
|
begin
|
||||||
|
if FTimer <> nil then
|
||||||
|
FreeAndNil(FTimer);
|
||||||
|
|
||||||
|
if (GlobalCEFApp = nil) or
|
||||||
|
(FChromiumWrapper.FChromiumState = csNoBrowser) or
|
||||||
|
(csDesigning in ComponentState)
|
||||||
|
then begin
|
||||||
|
inherited DestroyHandle;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFDEF MACOSX}
|
||||||
|
inherited DestroyHandle;
|
||||||
|
FChromiumWrapper.CloseBrowser(True);
|
||||||
|
{$ELSE}
|
||||||
|
FChromiumWrapper.WaitForBrowserClosed;
|
||||||
|
inherited DestroyHandle;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TLazarusBrowserWindow.RealizeBounds;
|
||||||
|
begin
|
||||||
|
inherited RealizeBounds;
|
||||||
|
|
||||||
|
if not (csDesigning in ComponentState) and HandleAllocated then
|
||||||
|
Chromium.NotifyMoveOrResizeStarted;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TLazarusBrowserWindow.DoEnter;
|
||||||
|
begin
|
||||||
|
inherited DoEnter;
|
||||||
|
If not(csDesigning in ComponentState) then Chromium.SetFocus(True);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TLazarusBrowserWindow.DoExit;
|
||||||
|
begin
|
||||||
|
inherited DoExit;
|
||||||
|
if not(csDesigning in ComponentState) then
|
||||||
|
Chromium.SendCaptureLostEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TLazarusBrowserWindow.DoOnCreated;
|
||||||
|
begin
|
||||||
|
{$IFDEF FPC}{$IFDEF LINUX}
|
||||||
|
Chromium.UpdateXWindowVisibility(Visible);
|
||||||
|
Chromium.UpdateBrowserSize(Left, Top, Width, Height);
|
||||||
|
{$ENDIF}{$ENDIF}
|
||||||
|
if Assigned(FOnBrowserCreated) then
|
||||||
|
FOnBrowserCreated(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TLazarusBrowserWindow.DoOnClosed(Data: PtrInt);
|
||||||
|
begin
|
||||||
|
if (not(csDestroying in ComponentState)) and
|
||||||
|
Assigned(FOnBrowserClosed)
|
||||||
|
then
|
||||||
|
FOnBrowserClosed(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TLazarusBrowserWindow.DoOnFocus(Data: PtrInt);
|
||||||
|
begin
|
||||||
|
SetFocus;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TLazarusBrowserWindow.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
FChromiumWrapper := TChromiumWrapper.Create(Self);
|
||||||
|
inherited Create(AOwner);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TLazarusBrowserWindow.Destroy;
|
||||||
|
begin
|
||||||
|
inherited Destroy;
|
||||||
|
FChromiumWrapper.MaybeDestroy;
|
||||||
|
Application.RemoveAsyncCalls(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TLazarusBrowserWindow.CloseBrowser(aForceClose: boolean);
|
||||||
|
begin
|
||||||
|
FChromiumWrapper.CloseBrowser(aForceClose);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TLazarusBrowserWindow.WaitForBrowserClosed;
|
||||||
|
begin
|
||||||
|
FChromiumWrapper.WaitForBrowserClosed;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TLazarusBrowserWindow.IsClosed: boolean;
|
||||||
|
begin
|
||||||
|
Result := FChromiumWrapper.IsClosed;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TLazarusBrowserWindow.LoadURL(aURL: ustring);
|
||||||
|
begin
|
||||||
|
FChromiumWrapper.LoadURL(aURL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
{$I res/tlazarusbrowserwindow.lrs}
|
||||||
|
RegisterComponents('Chromium', [TLazarusBrowserWindow]);
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
Reference in New Issue
Block a user