diff --git a/README.md b/README.md index 1887cc85..a2be4415 100644 --- a/README.md +++ b/README.md @@ -3,10 +3,10 @@ CEF4Delphi is an open source project created by Salvador D CEF4Delphi is based on DCEF3, made by Henri Gourvest. The original license of DCEF3 still applies to CEF4Delphi. Read the license terms in the first lines of any *.pas file. -CEF4Delphi uses CEF 79.1.10 which includes Chromium 79.0.3945.117. +CEF4Delphi uses CEF 79.1.27 which includes Chromium 79.0.3945.117. The CEF binaries used by CEF4Delphi are available for download at spotify : -* [32 bits](http://opensource.spotify.com/cefbuilds/cef_binary_79.1.10%2Bg7ec49fa%2Bchromium-79.0.3945.117_windows32.tar.bz2) -* [64 bits](http://opensource.spotify.com/cefbuilds/cef_binary_79.1.10%2Bg7ec49fa%2Bchromium-79.0.3945.117_windows64.tar.bz2) +* [32 bits](http://opensource.spotify.com/cefbuilds/cef_binary_79.1.27%2Bgd2449e5%2Bchromium-79.0.3945.117_windows32.tar.bz2) +* [64 bits](http://opensource.spotify.com/cefbuilds/cef_binary_79.1.27%2Bgd2449e5%2Bchromium-79.0.3945.117_windows64.tar.bz2) CEF4Delphi was developed and tested on Delphi 10.3 Rio and it has been tested in Delphi 7, Delphi XE, Delphi 10, Delphi 10.2 and Lazarus 2.0.6/FPC 3.0.4. CEF4Delphi includes VCL, FireMonkey (FMX) and Lazarus components. diff --git a/demos/Delphi_FMX/FMXToolBoxBrowser/FMXToolBoxBrowser.dpr b/demos/Delphi_FMX/FMXToolBoxBrowser/FMXToolBoxBrowser.dpr index bfbab5fd..5f05daf4 100644 --- a/demos/Delphi_FMX/FMXToolBoxBrowser/FMXToolBoxBrowser.dpr +++ b/demos/Delphi_FMX/FMXToolBoxBrowser/FMXToolBoxBrowser.dpr @@ -44,7 +44,6 @@ uses WinApi.Windows, {$ENDIF } uCEFApplication, - uFMXApplicationService in 'uFMXApplicationService.pas', uMainForm in 'uMainForm.pas' {MainForm}, uChildForm in 'uChildForm.pas' {ChildForm}; diff --git a/demos/Delphi_FMX/FMXToolBoxBrowser/FMXToolBoxBrowser.dproj b/demos/Delphi_FMX/FMXToolBoxBrowser/FMXToolBoxBrowser.dproj index ed0420f9..8d7863f8 100644 --- a/demos/Delphi_FMX/FMXToolBoxBrowser/FMXToolBoxBrowser.dproj +++ b/demos/Delphi_FMX/FMXToolBoxBrowser/FMXToolBoxBrowser.dproj @@ -135,7 +135,6 @@ MainSource -
MainForm
fmx @@ -192,7 +191,7 @@ true - + FMXToolBoxBrowser.exe true diff --git a/demos/Delphi_FMX/FMXToolBoxBrowser/uChildForm.fmx b/demos/Delphi_FMX/FMXToolBoxBrowser/uChildForm.fmx index f9e070fa..fb699acf 100644 --- a/demos/Delphi_FMX/FMXToolBoxBrowser/uChildForm.fmx +++ b/demos/Delphi_FMX/FMXToolBoxBrowser/uChildForm.fmx @@ -1,8 +1,6 @@ object ChildForm: TChildForm Left = 0 Top = 0 - BorderIcons = [biSystemMenu, biMinimize] - BorderStyle = Single Caption = 'Form1' ClientHeight = 600 ClientWidth = 800 diff --git a/demos/Delphi_FMX/FMXToolBoxBrowser/uChildForm.pas b/demos/Delphi_FMX/FMXToolBoxBrowser/uChildForm.pas index b6733db0..26c6d5c8 100644 --- a/demos/Delphi_FMX/FMXToolBoxBrowser/uChildForm.pas +++ b/demos/Delphi_FMX/FMXToolBoxBrowser/uChildForm.pas @@ -45,7 +45,11 @@ uses {$ENDIF} System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, - uCEFFMXChromium, uCEFFMXWindowParent, uCEFInterfaces, uCEFConstants, uCEFTypes; + uCEFFMXChromium, uCEFFMXWindowParent, uCEFInterfaces, uCEFConstants, uCEFTypes, + uCEFChromiumCore; + +const + CEF_SHOWBROWSER = WM_APP + $101; type TChildForm = class(TForm) @@ -69,16 +73,33 @@ type FMXWindowParent : TFMXWindowParent; FHomepage : string; + {$IFDEF MSWINDOWS} + // This is a workaround for the issue #253 + // https://github.com/salvadordf/CEF4Delphi/issues/253 + FCustomWindowState : TWindowState; + FOldWndPrc : TFNWndProc; + FFormStub : Pointer; + {$ENDIF} + function GetBrowserID : integer; procedure ResizeChild; procedure CreateFMXWindowParent; + function GetFMXWindowParentRect : System.Types.TRect; function PostCustomMessage(aMessage : cardinal; wParam : cardinal = 0; lParam : integer = 0) : boolean; + procedure NotifyMoveOrResizeStarted; + + {$IFDEF MSWINDOWS} + function GetCurrentWindowState : TWindowState; + procedure UpdateCustomWindowState; + procedure CreateHandle; override; + procedure DestroyHandle; override; + procedure CustomWndProc(var aMessage: TMessage); + {$ENDIF} public - procedure NotifyMoveOrResizeStarted; - procedure DoDestroyParent; procedure SendCloseMsg; + procedure SendShowBrowserMsg; procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override; property Closing : boolean read FClosing; @@ -92,7 +113,7 @@ implementation uses FMX.Platform, FMX.Platform.Win, - uCEFMiscFunctions, uCEFApplication, uFMXApplicationService, uMainForm; + uCEFMiscFunctions, uCEFApplication, uMainForm; // Child destruction steps // ======================= @@ -118,6 +139,113 @@ begin {$ENDIF} end; +{$IFDEF MSWINDOWS} +procedure TChildForm.CreateHandle; +begin + inherited CreateHandle; + + FFormStub := MakeObjectInstance(CustomWndProc); + FOldWndPrc := TFNWndProc(SetWindowLongPtr(FmxHandleToHWND(Handle), GWLP_WNDPROC, NativeInt(FFormStub))); +end; + +procedure TChildForm.DestroyHandle; +begin + SetWindowLongPtr(FmxHandleToHWND(Handle), GWLP_WNDPROC, NativeInt(FOldWndPrc)); + FreeObjectInstance(FFormStub); + + inherited DestroyHandle; +end; + +procedure TChildForm.CustomWndProc(var aMessage: TMessage); +const + SWP_STATECHANGED = $8000; // Undocumented +var + TempWindowPos : PWindowPos; +begin + try + case aMessage.Msg of + WM_ENTERMENULOOP : + if (aMessage.wParam = 0) and + (GlobalCEFApp <> nil) then + GlobalCEFApp.OsmodalLoop := True; + + WM_EXITMENULOOP : + if (aMessage.wParam = 0) and + (GlobalCEFApp <> nil) then + GlobalCEFApp.OsmodalLoop := False; + + WM_MOVE, + WM_MOVING : NotifyMoveOrResizeStarted; + + WM_SIZE : + if (aMessage.wParam = SIZE_RESTORED) then + UpdateCustomWindowState; + + WM_WINDOWPOSCHANGING : + begin + TempWindowPos := TWMWindowPosChanging(aMessage).WindowPos; + if ((TempWindowPos.Flags and SWP_STATECHANGED) = SWP_STATECHANGED) then + UpdateCustomWindowState; + end; + + CEF_DESTROY : + if (FMXWindowParent <> nil) then + FreeAndNil(FMXWindowParent); + + CEF_SHOWBROWSER : + begin + FMXWindowParent.WindowState := TWindowState.wsNormal; + FMXWindowParent.Show; + FMXWindowParent.SetBounds(GetFMXWindowParentRect); + end; + end; + + aMessage.Result := CallWindowProc(FOldWndPrc, FmxHandleToHWND(Handle), aMessage.Msg, aMessage.wParam, aMessage.lParam); + except + on e : exception do + if CustomExceptionHandler('TChildForm.CustomWndProc', e) then raise; + end; +end; + +procedure TChildForm.UpdateCustomWindowState; +var + TempNewState : TWindowState; +begin + TempNewState := GetCurrentWindowState; + + if (FCustomWindowState <> TempNewState) then + begin + // This is a workaround for the issue #253 + // https://github.com/salvadordf/CEF4Delphi/issues/253 + if (FCustomWindowState = TWindowState.wsMinimized) then + SendShowBrowserMsg; + + FCustomWindowState := TempNewState; + end; +end; + +function TChildForm.GetCurrentWindowState : TWindowState; +var + TempPlacement : TWindowPlacement; + TempHWND : HWND; +begin + // TForm.WindowState is not updated correctly in FMX forms. + // We have to call the GetWindowPlacement function in order to read the window state correctly. + + Result := TWindowState.wsNormal; + TempHWND := FmxHandleToHWND(Handle); + + ZeroMemory(@TempPlacement, SizeOf(TWindowPlacement)); + TempPlacement.Length := SizeOf(TWindowPlacement); + + if GetWindowPlacement(TempHWND, @TempPlacement) then + case TempPlacement.showCmd of + SW_SHOWMAXIMIZED : Result := TWindowState.wsMaximized; + SW_SHOWMINIMIZED : Result := TWindowState.wsMinimized; + end; +end; +{$ENDIF} + function TChildForm.GetBrowserID : integer; begin Result := FMXChromium1.BrowserID; @@ -134,16 +262,24 @@ begin end; end; +function TChildForm.GetFMXWindowParentRect : System.Types.TRect; +begin + Result.Left := 0; + Result.Top := 0; + Result.Right := ClientWidth - 1; + Result.Bottom := ClientHeight - 1; +end; + procedure TChildForm.ResizeChild; begin if (FMXWindowParent <> nil) then - FMXWindowParent.SetBounds(0, 0, ClientWidth - 1, ClientHeight - 1); + FMXWindowParent.SetBounds(GetFMXWindowParentRect); end; procedure TChildForm.FMXChromium1BeforeClose(Sender: TObject; const browser: ICefBrowser); begin FCanClose := True; - PostCustomMessage(WM_CLOSE); + SendCloseMsg; end; procedure TChildForm.FMXChromium1BeforePopup(Sender: TObject; @@ -186,6 +322,10 @@ begin FClosing := False; FMXWindowParent := nil; FHomepage := ''; + + {$IFDEF MSWINDOWS} + FCustomWindowState := WindowState; + {$ENDIF} end; procedure TChildForm.FormDestroy(Sender: TObject); @@ -244,15 +384,14 @@ begin if (FMXChromium1 <> nil) then FMXChromium1.NotifyMoveOrResizeStarted; end; -procedure TChildForm.DoDestroyParent; -begin - // We destroy FMXWindowParent safely in the main thread and this will trigger the TFMXChromium.OnBeforeClose event. - if (FMXWindowParent <> nil) then FreeAndNil(FMXWindowParent); -end; - procedure TChildForm.SendCloseMsg; begin PostCustomMessage(WM_CLOSE); end; +procedure TChildForm.SendShowBrowserMsg; +begin + PostCustomMessage(CEF_SHOWBROWSER); +end; + end. diff --git a/demos/Delphi_FMX/FMXToolBoxBrowser/uFMXApplicationService.pas b/demos/Delphi_FMX/FMXToolBoxBrowser/uFMXApplicationService.pas deleted file mode 100644 index 987e6239..00000000 --- a/demos/Delphi_FMX/FMXToolBoxBrowser/uFMXApplicationService.pas +++ /dev/null @@ -1,206 +0,0 @@ -// ************************************************************************ -// ***************************** 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 © 2020 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 uFMXApplicationService; - -{$I cef.inc} - -// This unit is based in the TFMXApplicationService class created by Takashi Yamamoto -// https://www.gesource.jp/weblog/?p=7367 - -interface - -uses - FMX.Platform; - -type - TFMXApplicationService = class(TInterfacedObject, IFMXApplicationService) - protected - class var OldFMXApplicationService: IFMXApplicationService; - class var NewFMXApplicationService: IFMXApplicationService; - - public - procedure Run; - function HandleMessage: Boolean; - procedure WaitMessage; - function GetDefaultTitle: string; - function GetTitle: string; - procedure SetTitle(const Value: string); - function GetVersionString: string; - procedure Terminate; - function Terminating: Boolean; - function Running: Boolean; - - class procedure AddPlatformService; - - property DefaultTitle : string read GetDefaultTitle; - property Title : string read GetTitle write SetTitle; - property AppVersion : string read GetVersionString; - end; - -implementation - -uses - FMX.Forms, - uMainForm, - uChildForm, - uCEFApplication, - {$IFDEF MSWINDOWS} - Winapi.Messages, Winapi.Windows, - {$ENDIF} - uCEFConstants; - -class procedure TFMXApplicationService.AddPlatformService; -begin - if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationService, IInterface(OldFMXApplicationService)) then - begin - TPlatformServices.Current.RemovePlatformService(IFMXApplicationService); - - NewFMXApplicationService := TFMXApplicationService.Create; - TPlatformServices.Current.AddPlatformService(IFMXApplicationService, NewFMXApplicationService); - end; -end; - -function TFMXApplicationService.GetDefaultTitle: string; -begin - Result := OldFMXApplicationService.GetDefaultTitle; -end; - -function TFMXApplicationService.GetTitle: string; -begin - Result := OldFMXApplicationService.GetTitle; -end; - -function TFMXApplicationService.GetVersionString: string; -begin - {$IFDEF DELPHI22_UP} - Result := OldFMXApplicationService.GetVersionString; - {$ELSE DELPHI22_UP} - Result := 'unsupported yet'; - {$ENDIF DELPHI22_UP} -end; - -procedure TFMXApplicationService.Run; -begin - OldFMXApplicationService.Run; -end; - -procedure TFMXApplicationService.SetTitle(const Value: string); -begin - OldFMXApplicationService.SetTitle(Value); -end; - -procedure TFMXApplicationService.Terminate; -begin - OldFMXApplicationService.Terminate; -end; - -function TFMXApplicationService.Terminating: Boolean; -begin - Result := OldFMXApplicationService.Terminating; -end; - -procedure TFMXApplicationService.WaitMessage; -begin - OldFMXApplicationService.WaitMessage; -end; - -function TFMXApplicationService.Running: Boolean; -begin - {$IFDEF DELPHI24_UP} - Result := OldFMXApplicationService.Running; - {$ELSE} - Result := True; - {$ENDIF} -end; - -function TFMXApplicationService.HandleMessage: Boolean; -{$IFDEF MSWINDOWS} -var - i : integer; - TempMsg : TMsg; -{$ENDIF} -begin - {$IFDEF MSWINDOWS} - if PeekMessage(TempMsg, 0, 0, 0, PM_NOREMOVE) then - case TempMsg.Message of - WM_ENTERMENULOOP : - if not(Application.Terminated) and - (TempMsg.wParam = 0) and - (GlobalCEFApp <> nil) then - GlobalCEFApp.OsmodalLoop := True; - - WM_EXITMENULOOP : - if not(Application.Terminated) and - (TempMsg.wParam = 0) and - (GlobalCEFApp <> nil) then - GlobalCEFApp.OsmodalLoop := False; - - CEF_INITIALIZED : - if not(Application.Terminated) and - (Application.MainForm <> nil) and - (Application.MainForm is TMainForm) then - TMainForm(Application.MainForm).DoCEFInitialized; - - CEF_CHILDDESTROYED : - if not(Application.Terminated) and - (Application.MainForm <> nil) and - (Application.MainForm is TMainForm) then - TMainForm(Application.MainForm).DoChildDestroyed; - - CEF_DESTROY : - if not(Application.Terminated) then - begin - i := 0; - - while (i < screen.FormCount) do - if (screen.Forms[i] is TChildForm) and - (TChildForm(screen.Forms[i]).BrowserID = TempMsg.lParam) then - begin - TChildForm(screen.Forms[i]).DoDestroyParent; - i := screen.FormCount; - end - else - inc(i); - end; - end; - {$ENDIF} - - Result := OldFMXApplicationService.HandleMessage; -end; - -end. diff --git a/demos/Delphi_FMX/FMXToolBoxBrowser/uMainForm.pas b/demos/Delphi_FMX/FMXToolBoxBrowser/uMainForm.pas index 492727a7..242b92ce 100644 --- a/demos/Delphi_FMX/FMXToolBoxBrowser/uMainForm.pas +++ b/demos/Delphi_FMX/FMXToolBoxBrowser/uMainForm.pas @@ -76,6 +76,19 @@ type function PostCustomMessage(aMessage : cardinal; wParam : cardinal = 0; lParam : integer = 0) : boolean; protected + {$IFDEF MSWINDOWS} + // This is a workaround for the issue #253 + // https://github.com/salvadordf/CEF4Delphi/issues/253 + FCustomWindowState : TWindowState; + FOldWndPrc : TFNWndProc; + FFormStub : Pointer; + + function GetCurrentWindowState : TWindowState; + procedure UpdateCustomWindowState; + procedure CreateHandle; override; + procedure DestroyHandle; override; + procedure CustomWndProc(var aMessage: TMessage); + {$ENDIF} public procedure DoCEFInitialized; @@ -97,7 +110,7 @@ implementation uses FMX.Platform, FMX.Platform.Win, - uCEFMiscFunctions, uFMXApplicationService, uChildForm, uCEFApplication; + uCEFMiscFunctions, uChildForm, uCEFApplication; // This Firemonkey demo shows how to create child windows with browsers using CEF4Delphi. // It uses a custom IFMXApplicationService to handle Windows messages. @@ -152,6 +165,113 @@ begin {$ENDIF} end; +{$IFDEF MSWINDOWS} +procedure TMainForm.CreateHandle; +begin + inherited CreateHandle; + + FFormStub := MakeObjectInstance(CustomWndProc); + FOldWndPrc := TFNWndProc(SetWindowLongPtr(FmxHandleToHWND(Handle), GWLP_WNDPROC, NativeInt(FFormStub))); +end; + +procedure TMainForm.DestroyHandle; +begin + SetWindowLongPtr(FmxHandleToHWND(Handle), GWLP_WNDPROC, NativeInt(FOldWndPrc)); + FreeObjectInstance(FFormStub); + + inherited DestroyHandle; +end; + +procedure TMainForm.CustomWndProc(var aMessage: TMessage); +const + SWP_STATECHANGED = $8000; // Undocumented +var + TempWindowPos : PWindowPos; +begin + try + case aMessage.Msg of + WM_ENTERMENULOOP : + if (aMessage.wParam = 0) and + (GlobalCEFApp <> nil) then + GlobalCEFApp.OsmodalLoop := True; + + WM_EXITMENULOOP : + if (aMessage.wParam = 0) and + (GlobalCEFApp <> nil) then + GlobalCEFApp.OsmodalLoop := False; + + WM_SIZE : + if (aMessage.wParam = SIZE_RESTORED) then + UpdateCustomWindowState; + + WM_WINDOWPOSCHANGING : + begin + TempWindowPos := TWMWindowPosChanging(aMessage).WindowPos; + if ((TempWindowPos.Flags and SWP_STATECHANGED) = SWP_STATECHANGED) then + UpdateCustomWindowState; + end; + + CEF_INITIALIZED : DoCEFInitialized; + CEF_CHILDDESTROYED : DoChildDestroyed; + end; + + aMessage.Result := CallWindowProc(FOldWndPrc, FmxHandleToHWND(Handle), aMessage.Msg, aMessage.wParam, aMessage.lParam); + except + on e : exception do + if CustomExceptionHandler('TMainForm.CustomWndProc', e) then raise; + end; +end; + +procedure TMainForm.UpdateCustomWindowState; +var + i : integer; + TempNewState : TWindowState; +begin + TempNewState := GetCurrentWindowState; + + if (FCustomWindowState <> TempNewState) then + begin + // This is a workaround for the issue #253 + // https://github.com/salvadordf/CEF4Delphi/issues/253 + if (FCustomWindowState = TWindowState.wsMinimized) then + begin + i := 0; + + while (i < screen.FormCount) do + begin + if (screen.Forms[i] is TChildForm) then + TChildForm(screen.Forms[i]).SendShowBrowserMsg; + + inc(i); + end; + end; + + FCustomWindowState := TempNewState; + end; +end; + +function TMainForm.GetCurrentWindowState : TWindowState; +var + TempPlacement : TWindowPlacement; + TempHWND : HWND; +begin + // TForm.WindowState is not updated correctly in FMX forms. + // We have to call the GetWindowPlacement function in order to read the window state correctly. + + Result := TWindowState.wsNormal; + TempHWND := FmxHandleToHWND(Handle); + + ZeroMemory(@TempPlacement, SizeOf(TWindowPlacement)); + TempPlacement.Length := SizeOf(TWindowPlacement); + + if GetWindowPlacement(TempHWND, @TempPlacement) then + case TempPlacement.showCmd of + SW_SHOWMAXIMIZED : Result := TWindowState.wsMaximized; + SW_SHOWMINIMIZED : Result := TWindowState.wsMinimized; + end; +end; +{$ENDIF} + procedure TMainForm.CreateToolboxChild(const ChildCaption, URL: string); var TempChild : TChildForm; @@ -261,11 +381,12 @@ end; procedure TMainForm.FormCreate(Sender: TObject); begin - // TFMXApplicationService is used to handle custom Windows messages - TFMXApplicationService.AddPlatformService; + FCanClose := False; + FClosing := False; - FCanClose := False; - FClosing := False; + {$IFDEF MSWINDOWS} + FCustomWindowState := WindowState; + {$ENDIF} end; procedure TMainForm.FormShow(Sender: TObject); diff --git a/demos/Delphi_FMX/SimpleFMXBrowser/SimpleFMXBrowser.dpr b/demos/Delphi_FMX/SimpleFMXBrowser/SimpleFMXBrowser.dpr index 76bc1d4d..0fb1c743 100644 --- a/demos/Delphi_FMX/SimpleFMXBrowser/SimpleFMXBrowser.dpr +++ b/demos/Delphi_FMX/SimpleFMXBrowser/SimpleFMXBrowser.dpr @@ -7,8 +7,7 @@ uses WinApi.Windows, {$ENDIF } uCEFApplication, - uSimpleFMXBrowser in 'uSimpleFMXBrowser.pas' {SimpleFMXBrowserFrm}, - uFMXApplicationService in 'uFMXApplicationService.pas'; + uSimpleFMXBrowser in 'uSimpleFMXBrowser.pas' {SimpleFMXBrowserFrm}; {$R *.res} diff --git a/demos/Delphi_FMX/SimpleFMXBrowser/SimpleFMXBrowser.dproj b/demos/Delphi_FMX/SimpleFMXBrowser/SimpleFMXBrowser.dproj index 5c54b112..a8a7918e 100644 --- a/demos/Delphi_FMX/SimpleFMXBrowser/SimpleFMXBrowser.dproj +++ b/demos/Delphi_FMX/SimpleFMXBrowser/SimpleFMXBrowser.dproj @@ -139,7 +139,6 @@
SimpleFMXBrowserFrm
fmx
- Cfg_2 Base @@ -173,7 +172,7 @@ true - + SimpleFMXBrowser.exe true diff --git a/demos/Delphi_FMX/SimpleFMXBrowser/uFMXApplicationService.pas b/demos/Delphi_FMX/SimpleFMXBrowser/uFMXApplicationService.pas deleted file mode 100644 index f8c3423a..00000000 --- a/demos/Delphi_FMX/SimpleFMXBrowser/uFMXApplicationService.pas +++ /dev/null @@ -1,188 +0,0 @@ -// ************************************************************************ -// ***************************** 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 © 2020 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 uFMXApplicationService; - -{$I cef.inc} - -// This unit is based in the TFMXApplicationService class created by Takashi Yamamoto -// https://www.gesource.jp/weblog/?p=7367 - -interface - -uses - FMX.Platform; - -type - TFMXApplicationService = class(TInterfacedObject, IFMXApplicationService) - protected - class var OldFMXApplicationService: IFMXApplicationService; - class var NewFMXApplicationService: IFMXApplicationService; - - public - procedure Run; - function HandleMessage: Boolean; - procedure WaitMessage; - function GetDefaultTitle: string; - function GetTitle: string; - procedure SetTitle(const Value: string); - function GetVersionString: string; - procedure Terminate; - function Terminating: Boolean; - function Running: Boolean; - - class procedure AddPlatformService; - - property DefaultTitle : string read GetDefaultTitle; - property Title : string read GetTitle write SetTitle; - property AppVersion : string read GetVersionString; - end; - -implementation - -uses - FMX.Forms, - uSimpleFMXBrowser, - uCEFApplication, - {$IFDEF MSWINDOWS} - Winapi.Messages, Winapi.Windows, - {$ENDIF} - uCEFConstants; - -class procedure TFMXApplicationService.AddPlatformService; -begin - if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationService, IInterface(OldFMXApplicationService)) then - begin - TPlatformServices.Current.RemovePlatformService(IFMXApplicationService); - - NewFMXApplicationService := TFMXApplicationService.Create; - TPlatformServices.Current.AddPlatformService(IFMXApplicationService, NewFMXApplicationService); - end; -end; - -function TFMXApplicationService.GetDefaultTitle: string; -begin - Result := OldFMXApplicationService.GetDefaultTitle; -end; - -function TFMXApplicationService.GetTitle: string; -begin - Result := OldFMXApplicationService.GetTitle; -end; - -function TFMXApplicationService.GetVersionString: string; -begin - {$IFDEF DELPHI22_UP} - Result := OldFMXApplicationService.GetVersionString; - {$ELSE DELPHI22_UP} - Result := 'unsupported yet'; - {$ENDIF DELPHI22_UP} -end; - -procedure TFMXApplicationService.Run; -begin - OldFMXApplicationService.Run; -end; - -procedure TFMXApplicationService.SetTitle(const Value: string); -begin - OldFMXApplicationService.SetTitle(Value); -end; - -procedure TFMXApplicationService.Terminate; -begin - OldFMXApplicationService.Terminate; -end; - -function TFMXApplicationService.Terminating: Boolean; -begin - Result := OldFMXApplicationService.Terminating; -end; - -procedure TFMXApplicationService.WaitMessage; -begin - OldFMXApplicationService.WaitMessage; -end; - -function TFMXApplicationService.Running: Boolean; -begin - {$IFDEF DELPHI24_UP} - Result := OldFMXApplicationService.Running; - {$ELSE} - Result := True; - {$ENDIF} -end; - -function TFMXApplicationService.HandleMessage: Boolean; -{$IFDEF MSWINDOWS} -var - TempMsg : TMsg; -{$ENDIF} -begin - {$IFDEF MSWINDOWS} - if PeekMessage(TempMsg, 0, 0, 0, PM_NOREMOVE) then - case TempMsg.Message of - WM_ENTERMENULOOP : - if not(Application.Terminated) and - (TempMsg.wParam = 0) and - (GlobalCEFApp <> nil) then - GlobalCEFApp.OsmodalLoop := True; - - WM_EXITMENULOOP : - if not(Application.Terminated) and - (TempMsg.wParam = 0) and - (GlobalCEFApp <> nil) then - GlobalCEFApp.OsmodalLoop := False; - - CEF_AFTERCREATED : - if not(Application.Terminated) and - (Application.MainForm <> nil) and - (Application.MainForm is TSimpleFMXBrowserFrm) then - TSimpleFMXBrowserFrm(Application.MainForm).DoBrowserCreated; - - CEF_DESTROY : - if not(Application.Terminated) and - (Application.MainForm <> nil) and - (Application.MainForm is TSimpleFMXBrowserFrm) then - TSimpleFMXBrowserFrm(Application.MainForm).DoDestroyParent; - end; - {$ENDIF} - - Result := OldFMXApplicationService.HandleMessage; -end; - -end. diff --git a/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.fmx b/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.fmx index 76cee7d3..6c328e72 100644 --- a/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.fmx +++ b/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.fmx @@ -8,10 +8,8 @@ object SimpleFMXBrowserFrm: TSimpleFMXBrowserFrm FormFactor.Width = 320 FormFactor.Height = 480 FormFactor.Devices = [Desktop] - OnActivate = FormActivate OnCreate = FormCreate OnCloseQuery = FormCloseQuery - OnDeactivate = FormDeactivate OnResize = FormResize OnShow = FormShow DesignerMasterStyle = 0 @@ -54,7 +52,7 @@ object SimpleFMXBrowserFrm: TSimpleFMXBrowserFrm Text = 'Go' OnClick = GoBtnClick end - object Button1: TButton + object SnapShotBtn: TButton Align = Right StyledSettings = [Style, FontColor] Position.X = 46.000000000000000000 @@ -65,7 +63,7 @@ object SimpleFMXBrowserFrm: TSimpleFMXBrowserFrm Text = #181 TextSettings.Font.Family = 'Webdings' TextSettings.Font.Size = 24.000000000000000000 - OnClick = Button1Click + OnClick = SnapShotBtnClick end end end diff --git a/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.pas b/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.pas index e13f6973..845ae88e 100644 --- a/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.pas +++ b/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.pas @@ -53,6 +53,8 @@ uses const MINIBROWSER_CONTEXTMENU_SHOWDEVTOOLS = MENU_ID_USER_FIRST + 1; + CEF_SHOWBROWSER = WM_APP + $101; + type TSimpleFMXBrowserFrm = class(TForm) AddressPnl: TPanel; @@ -61,65 +63,55 @@ type Timer1: TTimer; Panel1: TPanel; GoBtn: TButton; - Button1: TButton; + SnapShotBtn: TButton; SaveDialog1: TSaveDialog; + procedure GoBtnClick(Sender: TObject); + procedure Timer1Timer(Sender: TObject); + procedure SnapShotBtnClick(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormCreate(Sender: TObject); - procedure Timer1Timer(Sender: TObject); procedure FormShow(Sender: TObject); - procedure FMXChromium1Close(Sender: TObject; - const browser: ICefBrowser; var aAction : TCefCloseBrowserAction); - procedure FMXChromium1BeforeClose(Sender: TObject; - const browser: ICefBrowser); - procedure FMXChromium1BeforePopup(Sender: TObject; - const browser: ICefBrowser; const frame: ICefFrame; const targetUrl, - targetFrameName: ustring; - targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; - const popupFeatures: TCefPopupFeatures; - var windowInfo: TCefWindowInfo; var client: ICefClient; - var settings: TCefBrowserSettings; - var extra_info: ICefDictionaryValue; - var noJavascriptAccess, Result: Boolean); procedure FormResize(Sender: TObject); - procedure FMXChromium1AfterCreated(Sender: TObject; - const browser: ICefBrowser); - procedure FMXChromium1BeforeContextMenu(Sender: TObject; - const browser: ICefBrowser; const frame: ICefFrame; - const params: ICefContextMenuParams; const model: ICefMenuModel); - procedure FMXChromium1ContextMenuCommand(Sender: TObject; - const browser: ICefBrowser; const frame: ICefFrame; - const params: ICefContextMenuParams; commandId: Integer; - eventFlags: Cardinal; out Result: Boolean); - procedure Button1Click(Sender: TObject); - procedure FormActivate(Sender: TObject); - procedure FormDeactivate(Sender: TObject); + + procedure FMXChromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction); + procedure FMXChromium1BeforeClose(Sender: TObject; const browser: ICefBrowser); + procedure FMXChromium1BeforePopup(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl, targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; const popupFeatures: TCefPopupFeatures; var windowInfo: TCefWindowInfo; var client: ICefClient; var settings: TCefBrowserSettings; var extra_info: ICefDictionaryValue; var noJavascriptAccess, Result: Boolean); + procedure FMXChromium1AfterCreated(Sender: TObject; const browser: ICefBrowser); + procedure FMXChromium1BeforeContextMenu(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel); + procedure FMXChromium1ContextMenuCommand(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; commandId: Integer; eventFlags: Cardinal; out Result: Boolean); protected // Variables to control when can we destroy the form safely FCanClose : boolean; // Set to True in TFMXChromium.OnBeforeClose FClosing : boolean; // Set to True in the CloseQuery event. + FMXWindowParent : TFMXWindowParent; + + {$IFDEF MSWINDOWS} // This is a workaround for the issue #253 // https://github.com/salvadordf/CEF4Delphi/issues/253 - FOldWindowState : TWindowState; - - FMXWindowParent : TFMXWindowParent; - - function GetCurrentWindowState : TWindowState; + FCustomWindowState : TWindowState; + FOldWndPrc : TFNWndProc; + FFormStub : Pointer; + {$ENDIF} procedure LoadURL; procedure ResizeChild; procedure CreateFMXWindowParent; - procedure ShowFMXWindowParent; function GetFMXWindowParentRect : System.Types.TRect; function PostCustomMessage(aMessage : cardinal; wParam : cardinal = 0; lParam : integer = 0) : boolean; - property CurrentWindowState : TWindowState read GetCurrentWindowState; + {$IFDEF MSWINDOWS} + function GetCurrentWindowState : TWindowState; + procedure UpdateCustomWindowState; + procedure CreateHandle; override; + procedure DestroyHandle; override; + procedure CustomWndProc(var aMessage: TMessage); + {$ENDIF} public - procedure DoBrowserCreated; - procedure DoDestroyParent; procedure NotifyMoveOrResizeStarted; procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override; end; @@ -161,7 +153,7 @@ implementation uses FMX.Platform, FMX.Platform.Win, - uCEFMiscFunctions, uCEFApplication, uFMXApplicationService; + uCEFMiscFunctions, uCEFApplication; procedure CreateGlobalCEFApp; begin @@ -256,14 +248,104 @@ begin {$ENDIF} end; +{$IFDEF MSWINDOWS} +procedure TSimpleFMXBrowserFrm.CreateHandle; +begin + inherited CreateHandle; + + FFormStub := MakeObjectInstance(CustomWndProc); + FOldWndPrc := TFNWndProc(SetWindowLongPtr(FmxHandleToHWND(Handle), GWLP_WNDPROC, NativeInt(FFormStub))); +end; + +procedure TSimpleFMXBrowserFrm.DestroyHandle; +begin + SetWindowLongPtr(FmxHandleToHWND(Handle), GWLP_WNDPROC, NativeInt(FOldWndPrc)); + FreeObjectInstance(FFormStub); + + inherited DestroyHandle; +end; + +procedure TSimpleFMXBrowserFrm.CustomWndProc(var aMessage: TMessage); +const + SWP_STATECHANGED = $8000; // Undocumented +var + TempWindowPos : PWindowPos; +begin + try + case aMessage.Msg of + WM_ENTERMENULOOP : + if (aMessage.wParam = 0) and + (GlobalCEFApp <> nil) then + GlobalCEFApp.OsmodalLoop := True; + + WM_EXITMENULOOP : + if (aMessage.wParam = 0) and + (GlobalCEFApp <> nil) then + GlobalCEFApp.OsmodalLoop := False; + + WM_MOVE, + WM_MOVING : NotifyMoveOrResizeStarted; + + WM_SIZE : + if (aMessage.wParam = SIZE_RESTORED) then + UpdateCustomWindowState; + + WM_WINDOWPOSCHANGING : + begin + TempWindowPos := TWMWindowPosChanging(aMessage).WindowPos; + if ((TempWindowPos.Flags and SWP_STATECHANGED) = SWP_STATECHANGED) then + UpdateCustomWindowState; + end; + + CEF_AFTERCREATED : + begin + Caption := 'Simple FMX Browser'; + AddressPnl.Enabled := True; + end; + + CEF_DESTROY : + if (FMXWindowParent <> nil) then + FreeAndNil(FMXWindowParent); + + CEF_SHOWBROWSER : + begin + FMXWindowParent.WindowState := TWindowState.wsNormal; + FMXWindowParent.Show; + FMXWindowParent.SetBounds(GetFMXWindowParentRect); + end; + end; + + aMessage.Result := CallWindowProc(FOldWndPrc, FmxHandleToHWND(Handle), aMessage.Msg, aMessage.wParam, aMessage.lParam); + except + on e : exception do + if CustomExceptionHandler('TSimpleFMXBrowserFrm.CustomWndProc', e) then raise; + end; +end; + +procedure TSimpleFMXBrowserFrm.UpdateCustomWindowState; +var + TempNewState : TWindowState; +begin + TempNewState := GetCurrentWindowState; + + if (FCustomWindowState <> TempNewState) then + begin + // This is a workaround for the issue #253 + // https://github.com/salvadordf/CEF4Delphi/issues/253 + if (FCustomWindowState = TWindowState.wsMinimized) then + PostCustomMessage(CEF_SHOWBROWSER); + + FCustomWindowState := TempNewState; + end; +end; + function TSimpleFMXBrowserFrm.GetCurrentWindowState : TWindowState; var TempPlacement : TWindowPlacement; TempHWND : HWND; begin - // TForm.WindowState is not updated correctly in FMX forms and - // it's not possible to receive WM_SIZE with SIZE_RESTORED so have to - // call the GetWindowPlacement function and handle the form state changes manually. + // TForm.WindowState is not updated correctly in FMX forms. + // We have to call the GetWindowPlacement function in order to read the window state correctly. Result := TWindowState.wsNormal; TempHWND := FmxHandleToHWND(Handle); @@ -277,30 +359,7 @@ begin SW_SHOWMINIMIZED : Result := TWindowState.wsMinimized; end; end; - -procedure TSimpleFMXBrowserFrm.FormActivate(Sender: TObject); -var - TempState : TWindowState; -begin - // This is a workaround for the issue #253 - // https://github.com/salvadordf/CEF4Delphi/issues/253 - TempState := CurrentWindowState; - - if (FOldWindowState <> TempState) then - begin - if (FOldWindowState = TWindowState.wsMinimized) then - ShowFMXWindowParent; - - FOldWindowState := TempState; - end; -end; - -procedure TSimpleFMXBrowserFrm.FormDeactivate(Sender: TObject); -begin - // This is a workaround for the issue #253 - // https://github.com/salvadordf/CEF4Delphi/issues/253 - FOldWindowState := CurrentWindowState; -end; +{$ENDIF} procedure TSimpleFMXBrowserFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin @@ -316,13 +375,13 @@ end; procedure TSimpleFMXBrowserFrm.FormCreate(Sender: TObject); begin - // TFMXApplicationService is used to handle custom Windows messages - TFMXApplicationService.AddPlatformService; + FCanClose := False; + FClosing := False; + FMXWindowParent := nil; - FCanClose := False; - FClosing := False; - FMXWindowParent := nil; - FOldWindowState := TWindowState.wsNormal; + {$IFDEF MSWINDOWS} + FCustomWindowState := WindowState; + {$ENDIF} end; procedure TSimpleFMXBrowserFrm.FormResize(Sender: TObject); @@ -345,7 +404,7 @@ begin FMXWindowParent.SetBounds(GetFMXWindowParentRect); end; -procedure TSimpleFMXBrowserFrm.Button1Click(Sender: TObject); +procedure TSimpleFMXBrowserFrm.SnapShotBtnClick(Sender: TObject); var TempBitmap : TBitmap; begin @@ -445,25 +504,6 @@ begin Timer1.Enabled := True; end; -procedure TSimpleFMXBrowserFrm.DoBrowserCreated; -begin - // Now the browser is fully initialized - Caption := 'Simple FMX Browser'; - AddressPnl.Enabled := True; -end; - -procedure TSimpleFMXBrowserFrm.DoDestroyParent; -begin - if (FMXWindowParent <> nil) then FreeAndNil(FMXWindowParent); -end; - -procedure TSimpleFMXBrowserFrm.ShowFMXWindowParent; -begin - // This is a workaround for the issue #253 - // https://github.com/salvadordf/CEF4Delphi/issues/253 - if (FMXWindowParent <> nil) then FMXWindowParent.Show; -end; - procedure TSimpleFMXBrowserFrm.LoadURL; begin FMXChromium1.LoadURL(AddressEdt.Text); diff --git a/packages/cef4delphi_lazarus.lpk b/packages/cef4delphi_lazarus.lpk index 74de05a0..99c2ea6f 100644 --- a/packages/cef4delphi_lazarus.lpk +++ b/packages/cef4delphi_lazarus.lpk @@ -21,7 +21,7 @@ - + diff --git a/source/uCEFApplicationCore.pas b/source/uCEFApplicationCore.pas index e1ca77ad..f3218847 100644 --- a/source/uCEFApplicationCore.pas +++ b/source/uCEFApplicationCore.pas @@ -62,7 +62,7 @@ uses const CEF_SUPPORTED_VERSION_MAJOR = 79; CEF_SUPPORTED_VERSION_MINOR = 1; - CEF_SUPPORTED_VERSION_RELEASE = 10; + CEF_SUPPORTED_VERSION_RELEASE = 27; CEF_SUPPORTED_VERSION_BUILD = 0; CEF_CHROMEELF_VERSION_MAJOR = 79; diff --git a/update_CEF4Delphi.json b/update_CEF4Delphi.json index 2eee6c63..998cf7ef 100644 --- a/update_CEF4Delphi.json +++ b/update_CEF4Delphi.json @@ -2,9 +2,9 @@ "UpdateLazPackages" : [ { "ForceNotify" : true, - "InternalVersion" : 81, + "InternalVersion" : 82, "Name" : "cef4delphi_lazarus.lpk", - "Version" : "79.1.10.0" + "Version" : "79.1.27.0" } ], "UpdatePackageData" : {