diff --git a/packages/cef4delphi_lazarus.lpk b/packages/cef4delphi_lazarus.lpk index b0be2c1b..a41483ad 100644 --- a/packages/cef4delphi_lazarus.lpk +++ b/packages/cef4delphi_lazarus.lpk @@ -1,6 +1,6 @@ - + @@ -22,7 +22,7 @@ - + @@ -835,7 +835,13 @@ + + + + + + diff --git a/packages/cef4delphi_lazarus.pas b/packages/cef4delphi_lazarus.pas index e3ac23de..5ddb7c66 100644 --- a/packages/cef4delphi_lazarus.pas +++ b/packages/cef4delphi_lazarus.pas @@ -66,7 +66,7 @@ uses uCEFPrintDialogCallback, uCEFPrintHandler, uCEFPrintJobCallback, uCEFLinuxFunctions, uCEFLinuxTypes, uCEFLinuxConstants, uCEFWorkSchedulerQueueThread, uCEFLinkedWinControlBase, uCEFLazarusCocoa, - LazarusPackageIntf; + uCEFLazarusBrowserWindow, LazarusPackageIntf; implementation @@ -89,6 +89,7 @@ begin RegisterUnit('uCEFPanelComponent', @uCEFPanelComponent.Register); RegisterUnit('uCEFScrollViewComponent', @uCEFScrollViewComponent.Register); RegisterUnit('uCEFTextfieldComponent', @uCEFTextfieldComponent.Register); + RegisterUnit('uCEFLazarusBrowserWindow', @uCEFLazarusBrowserWindow.Register); end; initialization diff --git a/source/res/tlazarusbrowserwindow.lrs b/source/res/tlazarusbrowserwindow.lrs new file mode 100644 index 00000000..9cb2f93d --- /dev/null +++ b/source/res/tlazarusbrowserwindow.lrs @@ -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 '#254#5'Ixq'#26'FW'#221'b'#0#0#0#0'IEN' + +'D'#174'B`'#130 +]); diff --git a/source/uceflazarusbrowserwindow.pas b/source/uceflazarusbrowserwindow.pas new file mode 100644 index 00000000..aa1b4c66 --- /dev/null +++ b/source/uceflazarusbrowserwindow.pas @@ -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 + * 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. +