CEF4Delphi/demos/Delphi_FMX_Windows/FMXTabbedBrowser/uMainForm.pas

unit uMainForm;

{$I ..\..\..\source\cef.inc}

interface

uses
  {$IFDEF MSWINDOWS}
  Winapi.Messages, Winapi.Windows,
  {$ENDIF}
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.TabControl,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, System.Actions,
  FMX.ActnList, System.Math;


const
  CEF_INITIALIZED      = WM_APP + $100;
  CEF_DESTROYTAB       = WM_APP + $101;
  CEF_SHOWBROWSER      = WM_APP + $102;
  CEF_DESTROYWINPARENT = WM_APP + $103;

  HOMEPAGE_URL        = 'https://www.google.com';
  DEFAULT_TAB_CAPTION = 'New tab';

type
  TMainForm = class(TForm)
    ButtonLay: TLayout;
    AddTabBtn: TSpeedButton;
    RemoveTabBtn: TSpeedButton;
    BrowserTabCtrl: TTabControl;
    ActionList1: TActionList;
    AddTabAction: TAction;
    RemoveTabAction: TAction;
    PrevTabBtn: TSpeedButton;
    PrevTabAction: TAction;
    NextTabAction: TAction;
    NextTabBtn: TSpeedButton;
    ShowTabsBtn: TSpeedButton;
    ShowTabsAction: TAction;
    IndependetChk: TCheckBox;

    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

    procedure BrowserTabCtrlChange(Sender: TObject);

    procedure AddTabActionExecute(Sender: TObject);
    procedure RemoveTabActionExecute(Sender: TObject);
    procedure PrevTabActionExecute(Sender: TObject);
    procedure NextTabActionExecute(Sender: TObject);
    procedure ShowTabsActionExecute(Sender: TObject);

  protected
    // Variables to control when can we destroy the form safely
    FCanClose   : boolean;
    FClosing    : boolean;

    FLastTabID  : cardinal; // Used by NextTabID to generate unique tab IDs

    {$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}
    function  GetNextTabID : cardinal;
    procedure EnableButtonLay;
    procedure ShowSelectedBrowser;
    procedure DestroyWindowParent(aTabID : cardinal);
    procedure DestroyTab(aTabID : cardinal);
    function  CloseAllTabs : boolean;
    procedure CloseSelectedTab;
    procedure ResizeAllBrowsers;

    property  NextTabID : cardinal   read GetNextTabID;

  public
    function  PostCustomMessage(aMsg : cardinal; aWParam : WPARAM = 0; aLParam : LPARAM = 0) : boolean;
    procedure NotifyMoveOrResizeStarted;
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
  end;

var
  MainForm: TMainForm;

procedure CreateGlobalCEFApp;

implementation

{$R *.fmx}

uses
  FMX.Platform, FMX.Platform.Win,
  uCEFMiscFunctions, uCEFApplication, uCEFConstants, uBrowserTab;

// This demo shows how to use a TTabControl with TFrames that include
// CEF4Delphi browsers.

// Instead of a regular TTabItem we use a custom TBrowserTab class that
// inherits from TTabItem and instead of a regular TFrame we use a custom
// TBrowserFrame class that inherits from TFrame.

// To create a new tab you need to call TBrowserTab.CreateBrowser in the last
// step to create all the browser components and initialize the browser.

// To close a tab you have to call TBrowserTab.CloseBrowser and wait for a
// CEF_DESTROYTAB message that includes TBrowserTab.TabID in TMessage.wParam.
// Then you find the tab with that unique TabID and you free it.

// TBrowserFrame has all the usual code to close CEF4Delphi browsers following
// a similar destruction sequence than the SimpleFMXBrowser demo :
//
// 1. TBrowserTab.CloseBrowser calls TChromium.CloseBrowser which triggers the
//    TChromium.OnClose event.
// 2. TChromium.OnClose sends a CEF_DESTROYWINPARENT message to destroy
//    CEFWindowParent1 in the main thread, which triggers the
//    TChromium.OnBeforeClose event.
// 3. TChromium.OnBeforeClose executes the TBrowserFrame.OnBrowserDestroyed
//    event which will be used in TBrowserTab to send a CEF_DESTROYTAB message
//    to the main form to free the tab.

// To close safely this demo you must close all the browser tabs first following
// this steps :
//
// 1. FormCloseQuery sets CanClose to FALSE and calls CloseAllTabs and FClosing
//    is set to TRUE.
// 2. Each tab will send a CEF_DESTROYTAB message to free that tab.
// 3. When TTabControl has no tabs then we can set FCanClose to TRUE and close
//    the main form.

procedure GlobalCEFApp_OnContextInitialized;
begin
  if (MainForm <> nil) then MainForm.PostCustomMessage(CEF_INITIALIZED);
end;

procedure CreateGlobalCEFApp;
begin
  GlobalCEFApp                      := TCefApplication.Create;
  GlobalCEFApp.RootCache            := ExtractFileDir(ParamStr(0));
  GlobalCEFApp.cache                := GlobalCEFApp.RootCache + '\cache';
  GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized;
end;

procedure TMainForm.NextTabActionExecute(Sender: TObject);
begin
  if (BrowserTabCtrl.TabIndex < pred(BrowserTabCtrl.TabCount)) then
    BrowserTabCtrl.TabIndex := BrowserTabCtrl.TabIndex + 1;
end;

procedure TMainForm.PrevTabActionExecute(Sender: TObject);
begin
  if (BrowserTabCtrl.TabIndex > 0) then
    BrowserTabCtrl.TabIndex := BrowserTabCtrl.TabIndex - 1;
end;

procedure TMainForm.NotifyMoveOrResizeStarted;
var
  i : integer;
begin
  if (BrowserTabCtrl = nil) then exit;

  i := pred(BrowserTabCtrl.TabCount);

  while (i >= 0) do
    begin
      TBrowserTab(BrowserTabCtrl.Tabs[i]).NotifyMoveOrResizeStarted;
      dec(i);
    end;
end;

procedure TMainForm.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  PositionChanged: Boolean;
begin
  PositionChanged := (ALeft <> Left) or (ATop <> Top);

  inherited SetBounds(ALeft, ATop, AWidth, AHeight);

  if PositionChanged then
    NotifyMoveOrResizeStarted;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := FCanClose;

  if not(FClosing) then
    begin
      FClosing          := True;
      ButtonLay.Enabled := False;

      if not(CloseAllTabs) then CanClose := True;
    end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FCanClose   := False;
  FClosing    := False;
  FLastTabID  := 0;
end;

procedure TMainForm.FormResize(Sender: TObject);
begin
  ResizeAllBrowsers;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  if (GlobalCEFApp <> nil) and GlobalCEFApp.GlobalContextInitialized then
    EnableButtonLay;
end;

procedure TMainForm.ResizeAllBrowsers;
var
  i : integer;
begin
  i := pred(BrowserTabCtrl.TabCount);

  while (i >= 0) do
    begin
      TBrowserTab(BrowserTabCtrl.Tabs[i]).ResizeBrowser;
      dec(i);
    end;
end;

procedure TMainForm.EnableButtonLay;
begin
  if not(ButtonLay.Enabled) then
    begin
      ButtonLay.Enabled := True;
      Caption           := 'FMX Tabbed Browser';
      cursor            := crDefault;
      if (BrowserTabCtrl.TabCount <= 0) then AddTabAction.Execute;
    end;
end;

function TMainForm.GetNextTabID : cardinal;
begin
  inc(FLastTabID);
  Result := FLastTabID;
end;

procedure TMainForm.ShowSelectedBrowser;
begin
  if (BrowserTabCtrl.ActiveTab <> nil) then
    TBrowserTab(BrowserTabCtrl.ActiveTab).ShowBrowser;
end;

procedure TMainForm.ShowTabsActionExecute(Sender: TObject);
begin
  if (BrowserTabCtrl.TabPosition = TTabPosition.PlatformDefault) then
    BrowserTabCtrl.TabPosition := TTabPosition.None
   else
    BrowserTabCtrl.TabPosition := TTabPosition.PlatformDefault;

  ResizeAllBrowsers;
end;

procedure TMainForm.AddTabActionExecute(Sender: TObject);
var
  TempNewTab : TBrowserTab;
begin
  TempNewTab        := TBrowserTab.Create(BrowserTabCtrl, NextTabID, DEFAULT_TAB_CAPTION);
  TempNewTab.Parent := BrowserTabCtrl;

  BrowserTabCtrl.TabIndex := pred(BrowserTabCtrl.TabCount);

  TempNewTab.CreateBrowser(HOMEPAGE_URL, IndependetChk.IsChecked);
end;

procedure TMainForm.RemoveTabActionExecute(Sender: TObject);
begin
  CloseSelectedTab;
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_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) <> 0) then
            UpdateCustomWindowState;
        end;

      WM_SHOWWINDOW :
        if (aMessage.wParam <> 0) and (aMessage.lParam = SW_PARENTOPENING) then
          PostCustomMessage(CEF_SHOWBROWSER);

      CEF_INITIALIZED       : EnableButtonLay;
      CEF_DESTROYWINPARENT  : DestroyWindowParent(aMessage.wParam);
      CEF_DESTROYTAB        : DestroyTab(aMessage.wParam);
      CEF_SHOWBROWSER       : ShowSelectedBrowser;
    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
  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 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;

  if IsIconic(TempHWND) then Result := TWindowState.wsMinimized;
end;
{$ENDIF}

procedure TMainForm.DestroyWindowParent(aTabID : cardinal);
var
  i : integer;
  TempTab : TBrowserTab;
begin
  i := pred(BrowserTabCtrl.TabCount);

  while (i >= 0) do
    begin
      TempTab := TBrowserTab(BrowserTabCtrl.Tabs[i]);

      if (TempTab.TabID = aTabID) then
        begin
          TempTab.DestroyWindowParent;
          break;
        end
       else
        dec(i);
    end;
end;

procedure TMainForm.DestroyTab(aTabID : cardinal);
var
  i : integer;
  TempTab : TBrowserTab;
  TempText : string;
begin
  i := pred(BrowserTabCtrl.TabCount);

  while (i >= 0) do
    begin
      TempTab := TBrowserTab(BrowserTabCtrl.Tabs[i]);

      if (TempTab.TabID = aTabID) then
        begin
          BrowserTabCtrl.Delete(i);
          break;
        end
       else
        dec(i);
    end;

  if FClosing then
    begin
      if (BrowserTabCtrl.TabCount <= 0) then
        begin
          FCanClose := True;
          Close;
        end;
    end
   else
    begin
      ShowSelectedBrowser;

      // Sometimes TTabControl doesn't draw the new selected tab correctly.
      // Changing TTabItem.Text forces the component to redraw all the tabs.
      // A nicer solution would be to use a custom ttabcontrol that publishes
      // the TTabControl.RealignTabs procedure.
      if (BrowserTabCtrl.ActiveTab <> nil) then
        begin
          TempText := BrowserTabCtrl.ActiveTab.Text;
          BrowserTabCtrl.ActiveTab.Text := TempText + '-';
          BrowserTabCtrl.ActiveTab.Text := TempText;
        end;
    end;
end;

function TMainForm.PostCustomMessage(aMsg : cardinal; aWParam : WPARAM; aLParam : LPARAM) : boolean;
{$IFDEF MSWINDOWS}
var
  TempHWND : HWND;
{$ENDIF}
begin
  {$IFDEF MSWINDOWS}
  TempHWND := FmxHandleToHWND(Handle);
  Result   := (TempHWND <> 0) and WinApi.Windows.PostMessage(TempHWND, aMsg, aWParam, aLParam);
  {$ELSE}
  Result   := False;
  {$ENDIF}
end;

procedure TMainForm.BrowserTabCtrlChange(Sender: TObject);
var
  i : integer;
begin
  i := pred(BrowserTabCtrl.TabCount);

  while (i >= 0) do
    begin
      if (BrowserTabCtrl.TabIndex = i) then
        TBrowserTab(BrowserTabCtrl.Tabs[i]).ShowBrowser
       else
        TBrowserTab(BrowserTabCtrl.Tabs[i]).HideBrowser;

      dec(i);
    end;
end;

function TMainForm.CloseAllTabs : boolean;
var
  i : integer;
begin
  Result := False;
  i      := pred(BrowserTabCtrl.TabCount);

  while (i >= 0) do
    begin
      TBrowserTab(BrowserTabCtrl.Tabs[i]).CloseBrowser;
      Result := True;
      dec(i);
    end;
end;

procedure TMainForm.CloseSelectedTab;
begin
  if (BrowserTabCtrl.ActiveTab <> nil) then
    TBrowserTab(BrowserTabCtrl.ActiveTab).CloseBrowser;
end;

end.