CEF4Delphi/demos/Lazarus_Linux_GTK2/TabbedBrowser2/uBrowserTab.pas
salvadordf 7f3e3415ef Added partial GTK3 support
Converted the OSRExternalPumpBrowser demo to GTK3
Converted the TinyBrowser demo to GTK3
Converted the TinyBrowser2 demo to GTK3
Moved all Lazarus demos for Linux to the Lazarus_Linux_GTK2 directory
Fixed the Copy.CEF.DLLs tool thanks to fraurino
2022-06-25 16:41:34 +02:00

150 lines
4.5 KiB
ObjectPascal

// ************************************************************************
// ***************************** 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 © 2022 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 uBrowserTab;
{$mode objfpc}{$H+}
{$I cef.inc}
interface
uses
LCLIntf, LCLType, LMessages, Classes, Messages, ComCtrls, Controls,
Forms,
uBrowserFrame;
type
TBrowserTab = class(TTabSheet)
protected
FBrowserFrame : TBrowserFrame;
FTabID : cardinal;
function GetParentForm : TCustomForm;
procedure SendFormMessage(aMsg : cardinal; aData : PtrInt = 0);
procedure BrowserFrame_OnBrowserDestroyed(Sender: TObject);
procedure BrowserFrame_OnBrowserTitleChange(Sender: TObject; const aTitle : string);
property ParentForm : TCustomForm read GetParentForm;
public
constructor Create(AOwner: TComponent; aTabID : cardinal; const aCaption : string); reintroduce;
procedure NotifyMoveOrResizeStarted;
procedure CreateBrowser(const aHomepage : string);
procedure CloseBrowser;
property TabID : cardinal read FTabID;
end;
implementation
uses
uMainForm;
constructor TBrowserTab.Create(AOwner: TComponent; aTabID : cardinal; const aCaption : string);
begin
inherited Create(AOwner);
FTabID := aTabID;
Caption := aCaption;
FBrowserFrame := nil;
end;
function TBrowserTab.GetParentForm : TCustomForm;
var
TempParent : TWinControl;
begin
TempParent := Parent;
while (TempParent <> nil) and not(TempParent is TCustomForm) do
TempParent := TempParent.Parent;
if (TempParent <> nil) and (TempParent is TCustomForm) then
Result := TCustomForm(TempParent)
else
Result := nil;
end;
procedure TBrowserTab.SendFormMessage(aMsg : cardinal; aData : PtrInt);
var
TempForm : TCustomForm;
begin
TempForm := ParentForm;
if (TempForm <> nil) and (TempForm is TMainForm) then
TMainForm(TempForm).SendCompMessage(aMsg, aData);
end;
procedure TBrowserTab.NotifyMoveOrResizeStarted;
begin
FBrowserFrame.NotifyMoveOrResizeStarted;
end;
procedure TBrowserTab.CreateBrowser(const aHomepage : string);
begin
FBrowserFrame := TBrowserFrame.Create(self);
FBrowserFrame.Parent := self;
FBrowserFrame.Align := alClient;
FBrowserFrame.Visible := True;
FBrowserFrame.Homepage := aHomepage;
FBrowserFrame.OnBrowserDestroyed := @BrowserFrame_OnBrowserDestroyed;
FBrowserFrame.OnBrowserTitleChange := @BrowserFrame_OnBrowserTitleChange;
FBrowserFrame.CreateBrowser;
end;
procedure TBrowserTab.CloseBrowser;
begin
if (FBrowserFrame <> nil) then FBrowserFrame.CloseBrowser;
end;
procedure TBrowserTab.BrowserFrame_OnBrowserDestroyed(Sender: TObject);
begin
// This event is executed in a CEF thread so we have to use
// Application.QueueAsyncCall to destroy the tab in the main application
// thread.
SendFormMessage(CEF_DESTROYTAB, PtrInt(TabID));
end;
procedure TBrowserTab.BrowserFrame_OnBrowserTitleChange(Sender: TObject; const aTitle : string);
begin
Caption := aTitle;
end;
end.