1
0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2024-12-04 09:26:52 +02:00
CEF4Delphi/source/uCEFChromiumWindow.pas

356 lines
11 KiB
ObjectPascal
Raw Normal View History

2017-01-27 18:29:37 +02:00
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
2017-01-27 18:29:37 +02:00
// 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
//
2021-01-01 12:11:30 +02:00
// Copyright � 2021 Salvador Diaz Fau. All rights reserved.
2017-01-27 18:29:37 +02:00
//
// ************************************************************************
// ************ 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 uCEFChromiumWindow;
{$IFDEF FPC}
{$MODE OBJFPC}{$H+}
{$ENDIF}
{$IFNDEF CPUX64}{$ALIGN ON}{$ENDIF}
{$MINENUMSIZE 4}
2017-01-27 18:29:37 +02:00
2017-02-05 21:56:46 +02:00
{$I cef.inc}
2017-01-27 18:29:37 +02:00
interface
uses
2017-02-05 21:56:46 +02:00
{$IFDEF DELPHI16_UP}
{$IFDEF MSWINDOWS}WinApi.Windows, WinApi.Messages,{$ENDIF} System.Classes, Vcl.Controls,
2017-02-05 21:56:46 +02:00
{$ELSE}
{$IFDEF MSWINDOWS}Windows,{$ENDIF} Classes, Forms, Controls, Graphics,
{$IFDEF FPC}
LCLProc, LCLType, LCLIntf, LResources, LMessages, InterfaceBase,
{$ELSE}
Messages,
{$ENDIF}
2017-02-05 21:56:46 +02:00
{$ENDIF}
uCEFWindowParent, uCEFChromium, uCEFInterfaces, uCEFConstants, uCEFTypes, uCEFWinControl;
2017-01-27 18:29:37 +02:00
type
{$IFNDEF FPC}{$IFDEF DELPHI16_UP}[ComponentPlatformsAttribute(pidWin32 or pidWin64)]{$ENDIF}{$ENDIF}
TChromiumWindow = class(TCEFWinControl)
2017-01-27 18:29:37 +02:00
protected
FChromium : TChromium;
FOnClose : TNotifyEvent;
2017-12-07 11:49:51 +02:00
FOnBeforeClose : TNotifyEvent;
FOnAfterCreated : TNotifyEvent;
FUseSetFocus : boolean;
2017-01-27 18:29:37 +02:00
{$IFDEF FPC}
procedure SetVisible(Value: Boolean); override;
{$ENDIF}
function GetBrowserInitialized : boolean;
{$IFDEF MSWINDOWS}
function GetChildWindowHandle : THandle; override;
procedure WndProc(var aMessage: TMessage); override;
2017-01-27 18:29:37 +02:00
procedure OnCloseMsg(var aMessage : TMessage); message CEF_DOONCLOSE;
procedure OnAfterCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED;
{$ENDIF}
procedure WebBrowser_OnClose(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
2017-12-07 11:49:51 +02:00
procedure WebBrowser_OnBeforeClose(Sender: TObject; const browser: ICefBrowser);
procedure WebBrowser_OnAfterCreated(Sender: TObject; const browser: ICefBrowser);
2017-01-27 18:29:37 +02:00
{$IFDEF FPC}
procedure BrowserAfterCreated(Data: PtrInt);
procedure BrowserOnCLose(Data: PtrInt);
{$ENDIF}
2017-01-27 18:29:37 +02:00
public
constructor Create(AOwner: TComponent); override;
procedure AfterConstruction; override;
function CreateBrowser : boolean;
2017-01-27 18:29:37 +02:00
procedure CloseBrowser(aForceClose : boolean);
procedure LoadURL(const aURL : ustring);
2017-12-07 11:49:51 +02:00
procedure NotifyMoveOrResizeStarted;
procedure UpdateSize; override;
2017-01-27 18:29:37 +02:00
property ChromiumBrowser : TChromium read FChromium;
property Initialized : boolean read GetBrowserInitialized;
2017-01-27 18:29:37 +02:00
published
property UseSetFocus : boolean read FUseSetFocus write FUseSetFocus default True;
property OnClose : TNotifyEvent read FOnClose write FOnClose;
2017-12-07 11:49:51 +02:00
property OnBeforeClose : TNotifyEvent read FOnBeforeClose write FOnBeforeClose;
property OnAfterCreated : TNotifyEvent read FOnAfterCreated write FOnAfterCreated;
2017-01-27 18:29:37 +02:00
end;
{$IFDEF FPC}
procedure Register;
{$ENDIF}
// *********************************************************
// ********************** ATTENTION ! **********************
// *********************************************************
// ** **
// ** MANY OF THE EVENTS IN CEF4DELPHI COMPONENTS LIKE **
// ** TCHROMIUM, TFMXCHROMIUM OR TCEFAPPLICATION ARE **
// ** EXECUTED IN A CEF THREAD BY DEFAULT. **
// ** **
// ** WINDOWS CONTROLS MUST BE CREATED AND DESTROYED IN **
// ** THE SAME THREAD TO AVOID ERRORS. **
// ** SOME OF THEM RECREATE THE HANDLERS IF THEY ARE **
// ** MODIFIED AND CAN CAUSE THE SAME ERRORS. **
// ** **
// ** DON'T CREATE, MODIFY OR DESTROY WINDOWS CONTROLS **
// ** INSIDE THE CEF4DELPHI EVENTS AND USE **
// ** SYNCHRONIZATION OBJECTS TO PROTECT VARIABLES AND **
// ** FIELDS IF THEY ARE ALSO USED IN THE MAIN THREAD. **
// ** **
// ** READ THIS FOR MORE INFORMATION : **
// ** https://www.briskbard.com/index.php?pageid=cef **
// ** **
// ** USE OUR FORUMS FOR MORE QUESTIONS : **
// ** https://www.briskbard.com/forum/ **
// ** **
// *********************************************************
// *********************************************************
// This component should *ONLY* be used in emtremely simple applications with simple browsers.
// In other cases it's recomended using a TChromium with a TCEFWindowParent as shown in the
// SimpleBrowser2 demo.
2017-01-27 18:29:37 +02:00
implementation
uses
2017-02-05 21:56:46 +02:00
{$IFDEF DELPHI16_UP}
2017-01-27 18:29:37 +02:00
System.SysUtils;
2017-02-05 21:56:46 +02:00
{$ELSE}
SysUtils;
{$ENDIF}
2017-01-27 18:29:37 +02:00
constructor TChromiumWindow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FChromium := nil;
FOnClose := nil;
2017-12-07 11:49:51 +02:00
FOnBeforeClose := nil;
FOnAfterCreated := nil;
FUseSetFocus := True;
2017-01-27 18:29:37 +02:00
end;
procedure TChromiumWindow.AfterConstruction;
begin
inherited AfterConstruction;
if not(csDesigning in ComponentState) then
begin
FChromium := TChromium.Create(self);
FChromium.OnClose := {$IFDEF FPC}@{$ENDIF}WebBrowser_OnClose;
FChromium.OnBeforeClose := {$IFDEF FPC}@{$ENDIF}WebBrowser_OnBeforeClose;
FChromium.OnAfterCreated := {$IFDEF FPC}@{$ENDIF}WebBrowser_OnAfterCreated;
2017-01-27 18:29:37 +02:00
end;
end;
{$IFDEF MSWINDOWS}
2017-01-27 18:29:37 +02:00
function TChromiumWindow.GetChildWindowHandle : THandle;
begin
Result := 0;
if (FChromium <> nil) then Result := FChromium.WindowHandle;
if (Result = 0) then Result := inherited GetChildWindowHandle;
2017-01-27 18:29:37 +02:00
end;
procedure TChromiumWindow.WndProc(var aMessage: TMessage);
var
TempHandle : THandle;
begin
case aMessage.Msg of
WM_SETFOCUS:
begin
if FUseSetFocus and (FChromium <> nil) then
FChromium.SetFocus(True)
else
begin
TempHandle := ChildWindowHandle;
if (TempHandle <> 0) then PostMessage(TempHandle, WM_SETFOCUS, aMessage.WParam, 0);
end;
inherited WndProc(aMessage);
end;
WM_ERASEBKGND:
if (ChildWindowHandle = 0) then inherited WndProc(aMessage);
CM_WANTSPECIALKEY:
if not(TWMKey(aMessage).CharCode in [VK_LEFT .. VK_DOWN, VK_RETURN, VK_ESCAPE]) then
aMessage.Result := 1
else
inherited WndProc(aMessage);
WM_GETDLGCODE : aMessage.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
else inherited WndProc(aMessage);
end;
end;
{$ENDIF}
function TChromiumWindow.GetBrowserInitialized : boolean;
begin
Result := (FChromium <> nil) and FChromium.Initialized;
end;
procedure TChromiumWindow.WebBrowser_OnClose(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
2017-01-27 18:29:37 +02:00
begin
aAction := cbaClose;
if assigned(FOnClose) then
begin
{$IFDEF MSWINDOWS}
PostMessage(Handle, CEF_DOONCLOSE, 0, 0);
aAction := cbaDelay;
{$ELSE}
{$IFDEF FPC}
Application.QueueAsyncCall(@BrowserOnClose, 0);
{$ENDIF}
{$ENDIF}
end;
2017-01-27 18:29:37 +02:00
end;
2017-12-07 11:49:51 +02:00
procedure TChromiumWindow.WebBrowser_OnBeforeClose(Sender: TObject; const browser: ICefBrowser);
begin
if assigned(FOnBeforeClose) then FOnBeforeClose(self);
2017-12-07 11:49:51 +02:00
end;
procedure TChromiumWindow.WebBrowser_OnAfterCreated(Sender: TObject; const browser: ICefBrowser);
begin
{$IFDEF MSWINDOWS}
PostMessage(Handle, CEF_AFTERCREATED, 0, 0);
{$ELSE}
{$IFDEF FPC}
Application.QueueAsyncCall(@BrowserAfterCreated, 0);
{$ENDIF}
{$ENDIF}
end;
{$IFDEF MSWINDOWS}
2017-01-27 18:29:37 +02:00
procedure TChromiumWindow.OnCloseMsg(var aMessage : TMessage);
begin
if assigned(FOnClose) then FOnClose(self);
end;
procedure TChromiumWindow.OnAfterCreatedMsg(var aMessage : TMessage);
begin
UpdateSize;
if assigned(FOnAfterCreated) then FOnAfterCreated(self);
end;
{$ENDIF}
{$IFDEF FPC}
procedure TChromiumWindow.BrowserAfterCreated(Data: PtrInt);
begin
UpdateSize;
if assigned(FOnAfterCreated) then FOnAfterCreated(self);
end;
procedure TChromiumWindow.BrowserOnCLose(Data: PtrInt);
begin
if assigned(FOnClose) then FOnClose(self);
end;
{$ENDIF}
function TChromiumWindow.CreateBrowser : boolean;
2017-01-27 18:29:37 +02:00
begin
Result := not(csDesigning in ComponentState) and
(FChromium <> nil) and
FChromium.CreateBrowser(self, '');
2017-01-27 18:29:37 +02:00
end;
procedure TChromiumWindow.CloseBrowser(aForceClose : boolean);
begin
if (FChromium <> nil) then FChromium.CloseBrowser(aForceClose);
end;
procedure TChromiumWindow.LoadURL(const aURL : ustring);
2017-01-27 18:29:37 +02:00
begin
if not(csDesigning in ComponentState) and (FChromium <> nil) then
FChromium.LoadURL(aURL);
end;
2017-12-07 11:49:51 +02:00
procedure TChromiumWindow.NotifyMoveOrResizeStarted;
begin
if (FChromium <> nil) then FChromium.NotifyMoveOrResizeStarted;
end;
{$IFDEF FPC}
procedure TChromiumWindow.SetVisible(Value: Boolean);
{$IFDEF LINUX}
var
TempChanged : boolean;
{$ENDIF}
begin
{$IFDEF LINUX}
TempChanged := (Visible <> Value);
{$ENDIF}
inherited SetVisible(Value);
{$IFDEF LINUX}
if not(csDesigning in ComponentState) and
TempChanged and
(FChromium <> nil) and
FChromium.Initialized then
FChromium.UpdateXWindowVisibility(Visible);
{$ENDIF}
end;
{$ENDIF}
procedure TChromiumWindow.UpdateSize;
begin
{$IFDEF LINUX}
if not(csDesigning in ComponentState) and
(FChromium <> nil) and
FChromium.Initialized then
FChromium.UpdateBrowserSize(Left, Top, Width, Height);
{$ELSE}
inherited UpdateSize;
{$ENDIF}
end;
{$IFDEF FPC}
procedure Register;
begin
{$I res/tchromiumwindow.lrs}
RegisterComponents('Chromium', [TChromiumWindow]);
end;
{$ENDIF}
2017-01-27 18:29:37 +02:00
end.