pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-08-14 21:42:50 +02:00
Code Issues Actions 1 Releases Activity

Update to CEF 79.1.27

Browse Source 
- Fixed issue #253 when the FMX demos in normal mode are minimized and restored by clicking directly in the task bar icon.
This commit is contained in:
Salvador Díaz Fau
2020-01-15 18:11:12 +01:00
parent e93fd29623
commit 91a845e42f
15 changed files with 419 additions and 521 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
README.md
View File

@@ -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.

1
demos/Delphi_FMX/FMXToolBoxBrowser/FMXToolBoxBrowser.dpr
View File

@@ -44,7 +44,6 @@ uses
WinApi.Windows,
{$ENDIF }
uCEFApplication,
uFMXApplicationService in 'uFMXApplicationService.pas',
uMainForm in 'uMainForm.pas' {MainForm},
uChildForm in 'uChildForm.pas' {ChildForm};

3
demos/Delphi_FMX/FMXToolBoxBrowser/FMXToolBoxBrowser.dproj
View File

@@ -135,7 +135,6 @@
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="uFMXApplicationService.pas"/>
<DCCReference Include="uMainForm.pas">
<Form>MainForm</Form>
<FormType>fmx</FormType>
@@ -192,7 +191,7 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\Debug\FMXToolBoxBrowser.exe" Configuration="Debug" Class="ProjectOutput">
<DeployFile LocalName="..\..\..\bin\FMXToolBoxBrowser.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>FMXToolBoxBrowser.exe</RemoteName>
<Overwrite>true</Overwrite>

2
demos/Delphi_FMX/FMXToolBoxBrowser/uChildForm.fmx
View File

@@ -1,8 +1,6 @@
object ChildForm: TChildForm
Left = 0
Top = 0
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = Single
Caption = 'Form1'
ClientHeight = 600
ClientWidth = 800

163
demos/Delphi_FMX/FMXToolBoxBrowser/uChildForm.pas
View File

@@ -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.

206
demos/Delphi_FMX/FMXToolBoxBrowser/uFMXApplicationService.pas
View File

@@ -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 <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 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.

131
demos/Delphi_FMX/FMXToolBoxBrowser/uMainForm.pas
View File

@@ -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);

3
demos/Delphi_FMX/SimpleFMXBrowser/SimpleFMXBrowser.dpr
View File

@@ -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}

3
demos/Delphi_FMX/SimpleFMXBrowser/SimpleFMXBrowser.dproj
View File

@@ -139,7 +139,6 @@
<Form>SimpleFMXBrowserFrm</Form>
<FormType>fmx</FormType>
</DCCReference>
<DCCReference Include="uFMXApplicationService.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
@@ -173,7 +172,7 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\Debug\SimpleFMXBrowser.exe" Configuration="Debug" Class="ProjectOutput">
<DeployFile LocalName="..\..\..\bin\SimpleFMXBrowser.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>SimpleFMXBrowser.exe</RemoteName>
<Overwrite>true</Overwrite>

188
demos/Delphi_FMX/SimpleFMXBrowser/uFMXApplicationService.pas
View File

@@ -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 <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 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.

6
demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.fmx
View File

@@ -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

220
demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.pas
View File

@@ -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);

2
packages/cef4delphi_lazarus.lpk
View File

@@ -21,7 +21,7 @@
</CompilerOptions>
<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="79" Minor="1" Release="10"/>
<Version Major="79" Minor="1" Release="27"/>
<Files Count="147">
<Item1>
<Filename Value="..\source\uCEFAccessibilityHandler.pas"/>

2
source/uCEFApplicationCore.pas
View File

@@ -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;

4
update_CEF4Delphi.json
View File

@@ -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" : {