unit TDIClass ;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, ComCtrls, ExtCtrls, Menus,
  ExtendedNotebook, Buttons, Graphics ;

type

  ETDIError = class( Exception ) ;

  TTDICloseTabButtom = (tbNone, tbMenu, tbButtom ) ;
  TTDIBackgroundCorner = (coTopLeft, coTopRight, coBottomLeft, coBottomRight);

  { TTDIAction }

  TTDIAction = class( TPersistent )
  private
    FCaption : String ;
    FImageIndex : Integer ;
  public
    Constructor Create ;
  published
    property Caption    : String  read FCaption    write FCaption ;
    property ImageIndex : Integer read FImageIndex write FImageIndex ;
  end ;

  { TTDIActions }

  TTDIActions = Class( TPersistent )
  private
    FCloseAllTabs : TTDIAction ;
    FCloseTab : TTDIAction ;
    FTabsMenu : TTDIAction ;
  public
    Constructor Create ;
    Destructor Destroy ; override;
  published
    property TabsMenu     : TTDIAction read FTabsMenu     write FTabsMenu ;
    property CloseTab     : TTDIAction read FCloseTab     write FCloseTab ;
    property CloseAllTabs : TTDIAction read FCloseAllTabs write FCloseAllTabs ;
  end ;

  { TTDIPage }

  TTDIPage = class(TTabSheet)
  private
    fsFormInPage : TForm ;
    fsFormOldParent: TWinControl;
    fsFormOldCloseEvent : TCloseEvent;
    fsFormOldAlign : TAlign;
    fsFormOldClientRect : TRect;
    fsFormOldBorderStyle : TFormBorderStyle;
    fsLastActiveControl: TWinControl;

    procedure OnResizeTDIPage(Sender : TObject) ;
    procedure OnFormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure SaveFormProperties ;
    procedure RestoreFormProperties ;

    procedure SetFormInPage(AValue : TForm) ;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure CheckFormAlign ;

  public
    constructor Create(TheOwner: TComponent );  override;

    procedure RestoreLastFocusedControl ;

    property FormInPage : TForm read fsFormInPage write SetFormInPage ;
    property LastActiveControl : TWinControl read fsLastActiveControl write fsLastActiveControl ;
  end ;

  { TTDINoteBook }

  TTDINoteBook = class(TExtendedNotebook)
  private
    FBackgroundImage : TImage ;
    FCloseTabButtom : TTDICloseTabButtom ;
    FFixedPages : Integer ;
    FMainMenu : TMainMenu ;
    FBackgroundCorner : TTDIBackgroundCorner ;
    FTDIActions : TTDIActions ;
    FClosePageShortCut: TShortCut;
    FClosePageMouseMiddleButtom: Boolean;

    procedure SetBackgroundImage(AValue : TImage) ;
    procedure SetBackgroundCorner(AValue : TTDIBackgroundCorner) ;
    procedure SetCloseTabButtom(AValue : TTDICloseTabButtom) ;
    procedure SetMainMenu(AValue : TMainMenu) ;
    procedure SetFixedPages(AValue : Integer) ;
  private
    FCloseBitBtn : TBitBtn ;
    FCloseMenuItem : TMenuItem ;
    FCloseMenuItem2 : TMenuItem ;
    FCloseAllTabsMenuItem : TMenuItem ;
    FRestoreActiveControl : Boolean ;
    FTabsMenuItem : TMenuItem ;
    FTimerRestoreLastControl : TTimer;
    FVerifyIfCanChangePage : Boolean ;
    FIsRemovingAPage : Boolean;

    procedure CreateCloseBitBtn ;
    procedure CreateCloseMenuItem ;
    procedure CreateTabsMenuItem ;

    procedure ShowCloseButtom ;
    procedure HideCloseButtom ;
    procedure DrawBackgroundImage ;

    procedure CloseTabClicked( Sender: TObject );
    procedure CloseAllTabsClicked( Sender: TObject );
    procedure SelectTabByMenu( Sender: TObject );
    procedure DropDownTabsMenu( Sender: TObject );

    procedure TimerRestoreLastFocus( Sender: TObject );

    procedure RemoveInvalidPages ;
  protected
    function CanChange: Boolean; override;
    procedure DoChange; override;
    procedure Loaded; override;
    procedure RemovePage(Index: Integer); override;

    procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;

    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  public
    constructor Create(TheOwner: TComponent);  override;
    destructor Destroy ; override;
    procedure DoCloseTabClicked(APage: TCustomPage); override;

    procedure CreateFormInNewPage( AFormClass: TFormClass; ImageIndex : Integer = -1 ) ;
    procedure ShowForInNewPage( AForm: TForm; ImageIndex : Integer = -1 );
    Function FindFormInPages( AForm: TForm): Integer ;

    Function CanCloseAllPages: Boolean ;
    Function CanCloseAPage( APageIndex: Integer): Boolean;
    procedure CheckInterface;

  published
    property BackgroundImage : TImage read FBackgroundImage
      write SetBackgroundImage  ;
    property BackgroundCorner : TTDIBackgroundCorner read FBackgroundCorner
        write SetBackgroundCorner default coBottomRight ;
    property MainMenu : TMainMenu read FMainMenu write SetMainMenu ;
    property CloseTabButtom : TTDICloseTabButtom read FCloseTabButtom
      write SetCloseTabButtom default tbMenu ;

    property TDIActions : TTDIActions read FTDIActions write FTDIActions ;

    property ClosePageMouseMiddleButtom : Boolean read FClosePageMouseMiddleButtom
      write FClosePageMouseMiddleButtom default True;
    property ClosePageShortCut: TShortCut read FClosePageShortCut
      write FClosePageShortCut default 0;

    property RestoreActiveControl : Boolean read FRestoreActiveControl
      write FRestoreActiveControl default True;
    property VerifyIfCanChangePage : Boolean read FVerifyIfCanChangePage
      write FVerifyIfCanChangePage default True;
    property FixedPages : Integer read FFixedPages write SetFixedPages default 0;
  end ;


implementation

Uses TDIConst ;

{ TTDIAction }

constructor TTDIAction.Create ;
begin
  FCaption    := '';
  FImageIndex := -1;
end ;

{ TTDIActions }

constructor TTDIActions.Create ;
begin
  FCloseAllTabs := TTDIAction.Create;
  FCloseAllTabs.Caption := sActionCloseAllTabs;

  FCloseTab := TTDIAction.Create;
  FCloseTab.Caption := sActionCloseTab;

  FTabsMenu := TTDIAction.Create;
  FTabsMenu.Caption := sActionTabsMenu;
end ;

destructor TTDIActions.Destroy ;
begin
  FCloseAllTabs.Free;
  FCloseTab.Free;
  FTabsMenu.Free;

  inherited Destroy;
end ;

{ TTDIPage }

constructor TTDIPage.Create(TheOwner : TComponent) ;
begin
  inherited Create(TheOwner) ;

  Self.Parent   := TWinControl( TheOwner ) ;
  Self.OnResize := @OnResizeTDIPage ;

  fsLastActiveControl := nil ;
end ;

procedure TTDIPage.RestoreLastFocusedControl ;
begin
  if Assigned( fsLastActiveControl ) then
  begin
    if fsLastActiveControl <> Screen.ActiveControl then
    begin
      if fsLastActiveControl.Visible and fsLastActiveControl.Enabled then
      begin
        try
           fsLastActiveControl.SetFocus ;
           //FormInPage.ActiveControl := fsLastActiveControl;
        except
        end ;
      end ;
    end
  end
  else
  begin
    { No LastActiveControle ? Ok, if current Screen control isn't in TabSheet,
      go to first Control on TabSheet... }
    if not Self.ContainsControl( Screen.ActiveControl ) then
      Self.SelectNext( Self, True, True);
  end
end ;

procedure TTDIPage.SetFormInPage(AValue : TForm) ;
begin
  fsFormInPage := AValue ;

  // Saving Form Properties //
  SaveFormProperties ;

  // Adjusting Page Caption and Color as the Form //
  Caption := fsFormInPage.Caption;
  //Color := fsFormInPage.Color;

  // HiJacking the Form.OnClose Event, to detect Form Closed from Inside //
  fsFormInPage.OnClose := @OnFormClose;

  // Adjusting AForm Border Style and Align //
  fsFormInPage.BorderStyle := bsNone ;
  fsFormInPage.Align       := alClient ; 

  // Change Form Parent to the Page //
  fsFormInPage.Parent := Self;
  //fsFormInPage.FreeNotification(Self);  // This cause a SIGSEGV, when Form is Closed from inside

  // Show the Form //
  fsFormInPage.Visible := True ;

  // Saving the current ActiveControl in the Form //
  fsLastActiveControl := fsFormInPage.ActiveControl;
end ;

procedure TTDIPage.Notification(AComponent : TComponent ; Operation : TOperation
  ) ;
begin
  inherited Notification(AComponent, Operation) ;

  if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;

  if (Operation = opRemove) and (AComponent = fsFormInPage) then
  begin
    RestoreFormProperties;

    fsFormInPage := nil;
  end ;
end ;

procedure TTDIPage.CheckFormAlign ;
begin
  if not Assigned(fsFormInPage) then exit ;

  { If Form has MaxConstrains and doesn't fill all the Screen, Centralize on
    TabSheet }
  if (fsFormInPage.Width < Width) or (fsFormInPage.Height < Height) then
  begin
    fsFormInPage.Align := alNone;

    if (fsFormInPage.Width < Width) then
      fsFormInPage.Left := Trunc( (Width - fsFormInPage.Width) / 2 )
    else
      fsFormInPage.Left := 0 ;

    if (fsFormInPage.Height < Height) then
      fsFormInPage.Top := Trunc( (Height - fsFormInPage.Height) / 2 )
    else
      fsFormInPage.Top := 0 ;
  end
  else
    fsFormInPage.Align := alClient;
end ;

procedure TTDIPage.OnResizeTDIPage(Sender : TObject) ;
begin
  CheckFormAlign;
end ;

procedure TTDIPage.OnFormClose(Sender : TObject ; var CloseAction : TCloseAction
  ) ;
begin
  if Assigned( fsFormOldCloseEvent ) then
     fsFormOldCloseEvent( Sender, CloseAction );

  // This will force this page be killed by TTDINoteBook.Notification();
  if Assigned( fsFormInPage ) then
  begin
    RestoreFormProperties;

    fsFormInPage := nil;

    if Assigned( Parent ) then
      Parent.RemoveComponent( Self );
  end ;
end ;

procedure TTDIPage.SaveFormProperties ;
begin
  if not Assigned( fsFormInPage ) then exit ;

  fsFormOldParent            := fsFormInPage.Parent;
  fsFormOldCloseEvent        := fsFormInPage.OnClose;
  fsFormOldAlign             := fsFormInPage.Align;
  fsFormOldBorderStyle       := fsFormInPage.BorderStyle;
  fsFormOldClientRect.Top    := fsFormInPage.Top;
  fsFormOldClientRect.Left   := fsFormInPage.Left;
  fsFormOldClientRect.Right  := fsFormInPage.Width;
  fsFormOldClientRect.Bottom := fsFormInPage.Height;
end ;

procedure TTDIPage.RestoreFormProperties ;
begin
  if not Assigned( fsFormInPage ) then exit ;

  if ([csDesigning, csDestroying] * fsFormInPage.ComponentState <> []) then exit ;

  fsFormInPage.Parent      := fsFormOldParent;
  fsFormInPage.Visible     := False;
  fsFormInPage.Align       := fsFormOldAlign;
  fsFormInPage.BorderStyle := fsFormOldBorderStyle;
  fsFormInPage.Top         := fsFormOldClientRect.Top;
  fsFormInPage.Left        := fsFormOldClientRect.Left;
  fsFormInPage.Width       := fsFormOldClientRect.Right;
  fsFormInPage.Height      := fsFormOldClientRect.Bottom;
  fsFormInPage.OnClose     := fsFormOldCloseEvent;
end ;

{ TTDINoteBook }

constructor TTDINoteBook.Create(TheOwner : TComponent) ;
begin
  inherited Create(TheOwner) ;

  FCloseTabButtom            := tbMenu;
  FBackgroundCorner          := coBottomRight;
  FFixedPages                := 0;
  FRestoreActiveControl      := True;
  FVerifyIfCanChangePage     := True;
  FIsRemovingAPage           := False;
  FClosePageMouseMiddleButtom:= True;
  FClosePageShortCut         := 0;
  FBackgroundImage           := nil;
  FCloseBitBtn               := nil;
  FCloseMenuItem             := nil;
  FCloseMenuItem2            := nil;
  FCloseAllTabsMenuItem      := nil;
  FTabsMenuItem              := nil;
  FTDIActions                := TTDIActions.Create;

  { This is ugly, I know... but I didn't found a best solution to restore Last
    Focused Control of TDIPage }
  FTimerRestoreLastControl := TTimer.Create(Self);
  FTimerRestoreLastControl.Enabled  := False;
  FTimerRestoreLastControl.Interval := 10;
  FTimerRestoreLastControl.OnTimer  := @TimerRestoreLastFocus;
end ;

destructor TTDINoteBook.Destroy ;
begin
  if Assigned( FCloseBitBtn )  then
    FCloseBitBtn.Free ;

  { // Don't Destroy Menu Items... They will be destroyed by MainMenu //

  if Assigned( FCloseMenuItem )  then
    FCloseMenuItem.Free ;

  if Assigned( FTabsMenuItem )  then
  begin
    FTabsMenuItem.Free ;
    FCloseMenuItem2.Free;
    FCloseAllTabsMenuItem.Free;
  end ;
  }

  FTDIActions.Free;

  FTimerRestoreLastControl.Free;

  inherited Destroy;
end ;

procedure TTDINoteBook.DoCloseTabClicked(APage: TCustomPage);
var
  LastPageCount: Integer;
begin
  LastPageCount := PageCount;

  inherited DoCloseTabClicked(APage);

  if Assigned( APage ) and (LastPageCount = PageCount) then  // If Page was not closed...
  begin
    PageIndex := APage.PageIndex;

    if PageIndex >= FixedPages then
      RemovePage( APage.PageIndex );
  end;
end;

procedure TTDINoteBook.CreateCloseBitBtn ;
begin
  if FCloseBitBtn <> nil then exit;

  FCloseBitBtn := TBitBtn.Create( Self ) ;
  with FCloseBitBtn do
  begin
    Name     := 'CloseBitBtn';
    Caption  := 'X';
    Visible  := False ;
    Parent   := Nil;
    Height   := 22;
    Width    := 22;
    Layout   := blGlyphTop;
    OnClick  := @CloseTabClicked;
    TabStop  := False;
    AnchorSideTop.Control   := Self;
    AnchorSideRight.Control := Self;
    AnchorSideRight.Side    := asrBottom;
    Anchors                 := [akTop, akRight]
  end ;

  if Self.Owner is TWinControl then
    FCloseBitBtn.Parent := TWinControl(Self.Owner) ;

  // Setting Image to FCloseBitBtn //;
  if Assigned( Images ) and (FTDIActions.CloseTab.ImageIndex > -1) then
  begin
     Images.GetBitmap( FTDIActions.CloseTab.ImageIndex, FCloseBitBtn.Glyph );
     FCloseBitBtn.Caption := '';
  end ;
end ;

procedure TTDINoteBook.CreateCloseMenuItem ;
begin
  if FCloseMenuItem <> nil then exit;

  if not Assigned( FMainMenu ) then
     raise ETDIError.Create( sMainMenuNotAssigned );

  FCloseMenuItem := TMenuItem.Create( FMainMenu );
  with FCloseMenuItem do
  begin
    Name := 'miTDICloseButtom';
    if (TDIActions.CloseTab.ImageIndex < 0) or
       (not Assigned( FMainMenu.Images )) or
       (TDIActions.CloseTab.ImageIndex >= Images.Count)  then
      Caption := 'X'
    else
    begin
      Caption := '' ;
      ImageIndex := TDIActions.CloseTab.ImageIndex;
    end ;

    RightJustify := True ;
    OnClick      := @CloseTabClicked;
  end ;

  FMainMenu.Items.Add( FCloseMenuItem );
end ;

procedure TTDINoteBook.CreateTabsMenuItem ;
Var
  NewMenuItem : TMenuItem;
begin
  if FTabsMenuItem <> nil then exit;

  if not Assigned( FMainMenu ) then
     raise ETDIError.Create( sMainMenuNotAssigned );

  // Creating entry on MainMenu //
  FTabsMenuItem := TMenuItem.Create( FMainMenu );
  with FTabsMenuItem do
  begin
    Name         := 'miTDITabsMenuItem';
    Caption      := TDIActions.TabsMenu.Caption;
    ImageIndex   := TDIActions.TabsMenu.ImageIndex;
    RightJustify := True ;
    OnClick      := @DropDownTabsMenu;

  end ;
  FMainMenu.Items.Add( FTabsMenuItem );

  // Creating Sub-Menu options //

  // Creating a Separator //
  NewMenuItem := TMenuItem.Create( FTabsMenuItem );
  with NewMenuItem do
  begin
    Name    := 'miTDISeparator';
    Caption := '-';
  end ;
  FTabsMenuItem.Add(NewMenuItem);

  // Creating Close Tab MenuItem //
  FCloseMenuItem2 := TMenuItem.Create( FTabsMenuItem );
  with FCloseMenuItem2 do
  begin
    Name       := 'miTDICloseTab';
    Caption    := TDIActions.CloseTab.Caption;
    ImageIndex := TDIActions.CloseTab.ImageIndex;
    OnClick    := @CloseTabClicked;
  end ;
  FTabsMenuItem.Add(FCloseMenuItem2);

  // Creating Close All Tabs MenuItem //
  FCloseAllTabsMenuItem := TMenuItem.Create( FTabsMenuItem );
  with FCloseAllTabsMenuItem do
  begin
    Name       := 'miTDICloseAllTabs';
    Caption    := TDIActions.CloseAllTabs.Caption;
    ImageIndex := TDIActions.CloseAllTabs.ImageIndex;
    OnClick    := @CloseAllTabsClicked;
  end ;
  FTabsMenuItem.Add(FCloseAllTabsMenuItem);
end ;

procedure TTDINoteBook.SetFixedPages(AValue : Integer) ;
begin
  if FFixedPages = AValue then Exit ;
  FFixedPages := AValue ;

  CheckInterface;
end ;

procedure TTDINoteBook.SetBackgroundImage(AValue : TImage) ;
begin
  if FBackgroundImage = AValue then Exit ;
  FBackgroundImage := AValue ;

  if Visible then
    DrawBackgroundImage;
end ;

procedure TTDINoteBook.SetBackgroundCorner(AValue : TTDIBackgroundCorner) ;
begin
  if FBackgroundCorner = AValue then Exit ;
  FBackgroundCorner := AValue ;

  if Visible then
    DrawBackgroundImage;
end ;

procedure TTDINoteBook.SetCloseTabButtom(AValue : TTDICloseTabButtom) ;
begin
  if FCloseTabButtom = AValue then Exit ;

  if (AValue = tbButtom) and  (not (Owner is TWinControl)) then
    raise ETDIError.Create( sOwnerIsNotWinControl ) ;

  FCloseTabButtom := AValue ;
end ;

procedure TTDINoteBook.SetMainMenu(AValue : TMainMenu) ;
begin
  if FMainMenu = AValue then Exit ;
  FMainMenu := AValue ;
end ;

procedure TTDINoteBook.CreateFormInNewPage(AFormClass : TFormClass ;
  ImageIndex : Integer) ;
Var
  NewForm : TForm ;
begin
  NewForm := AFormClass.Create(nil);

  ShowForInNewPage( NewForm, ImageIndex );
end ;

procedure TTDINoteBook.ShowForInNewPage(AForm : TForm ; ImageIndex : Integer) ;
Var
  NewPage : TTDIPage ;
  AlreadyExistingPage : Integer ;
begin
  // Looking for a Page with same AForm Object //
  AlreadyExistingPage := FindFormInPages( AForm );
  if AlreadyExistingPage >= 0 then
  begin
    PageIndex := AlreadyExistingPage;
    exit ;
  end ;

  // Create a new Page
  NewPage := TTDIPage.Create(Self);
  NewPage.ImageIndex := ImageIndex;

  Visible := True;

  // This will call TTDIPage.SetFormInPage, who does the magic //
  NewPage.FormInPage := AForm;

  // Activate the new Page
  ActivePage := NewPage;

  // First Page always need a little help for align form inside //
  if PageCount = 1 then
  begin
    NewPage.CheckFormAlign ;
    CheckInterface;
  end ;
end ;

function TTDINoteBook.FindFormInPages(AForm : TForm) : Integer ;
var
  I : Integer ;
begin
  Result := -1;

  I := 0;
  while (Result < 0) and (I < PageCount) do
  begin
     if Pages[I] is TTDIPage then
       with TTDIPage( Pages[I] ) do
       begin
         if AForm = FormInPage then
           Result := I;
       end ;

     Inc( I ) ;
  end ;
end ;

procedure TTDINoteBook.CheckInterface ;
begin
  if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;

  Visible := (PageCount > 0);

  // Checking for Close Button visibility //
  if (FCloseTabButtom <> tbNone) then
  begin
    if Visible then
      ShowCloseButtom
    else
      HideCloseButtom;
  end ;

  // Checking for Tabs Menu visibility //
  if FTabsMenuItem <> nil then
     FTabsMenuItem.Visible := Visible ;

  // Drawing Background Image //
  if Visible then
    DrawBackgroundImage;
end ;

procedure TTDINoteBook.ShowCloseButtom ;
begin
  case FCloseTabButtom of
    tbButtom :
      begin
        if FCloseBitBtn = nil then
          CreateCloseBitBtn;

        if not FCloseBitBtn.Visible then
        begin
          FCloseBitBtn.Visible := True ;
          FCloseBitBtn.BringToFront;
        end ;
        FCloseBitBtn.Enabled := ( ActivePageIndex >= FFixedPages );
      end ;

    tbMenu :
      begin
        if FCloseMenuItem = nil then
          CreateCloseMenuItem;

        FCloseMenuItem.Visible := True ;
        FCloseMenuItem.Enabled   := ( ActivePageIndex >= FFixedPages );
      end ;
  end ;

end ;

procedure TTDINoteBook.HideCloseButtom ;
begin
  if FCloseBitBtn <> nil then
    FCloseBitBtn.Visible := False;
  if FCloseMenuItem <> nil then
    FCloseMenuItem.Visible := False;
end ;

procedure TTDINoteBook.CloseTabClicked(Sender : TObject) ;
begin
  RemovePage( ActivePageIndex );
end ;

procedure TTDINoteBook.CloseAllTabsClicked(Sender : TObject) ;
Var
  LastPageCount : Integer ;
begin
   if PageCount < 1 then exit ;

   LastPageCount := -1 ;
   PageIndex     := PageCount-1;  // Go to Last page
   // Close while have pages, and Pages still being closed //
   while (PageCount > FFixedPages) and (LastPageCount <> PageCount) do
   begin
     LastPageCount := PageCount ;
     RemovePage( ActivePageIndex );
     Application.ProcessMessages;
   end;
end ;

function TTDINoteBook.CanCloseAllPages : Boolean ;
Var
  I : Integer ;
begin
  Result := True;
  if PageCount < 1 then exit ;

  I := 0;
  while Result and ( I < PageCount ) do
  begin
    Result := CanCloseAPage( I );
    Inc(I)
  end ;
end ;

function TTDINoteBook.CanCloseAPage(APageIndex : Integer) : Boolean ;
begin
  Result := True;

  if Pages[APageIndex] is TTDIPage then
    with TTDIPage(Pages[APageIndex]) do
    begin
      if Assigned( FormInPage ) then
        Result := FormInPage.CloseQuery;
    end ;
end ;


procedure TTDINoteBook.SelectTabByMenu(Sender : TObject) ;
begin
  if Sender is TMenuItem then
    ActivePageIndex := TMenuItem(Sender).Tag;
end ;

procedure TTDINoteBook.DropDownTabsMenu(Sender : TObject) ;
Var
  I : Integer ;
  NewMenuItem : TMenuItem ;
begin
  // Removing Menu Items until find Separator '-' //
  NewMenuItem := FTabsMenuItem.Items[0] ;
  while (NewMenuItem.Caption <> '-') do
  begin
     FTabsMenuItem.Remove(NewMenuItem);
     NewMenuItem.Free ;
     NewMenuItem := FTabsMenuItem.Items[0] ;
  end ;

  // Inserting on Menu Items for existing Tabs //
  for I := PageCount-1 downto 0 do
  begin
     NewMenuItem := TMenuItem.Create(FTabsMenuItem);
     NewMenuItem.Caption    := Page[I].Caption ;
     NewMenuItem.ImageIndex := Page[I].ImageIndex ;
     NewMenuItem.OnClick    := @SelectTabByMenu ;
     NewMenuItem.Tag        := I ;
     NewMenuItem.Checked    := (I = PageIndex ) ;

     FTabsMenuItem.Insert(0,NewMenuItem);
  end ;

  FCloseMenuItem2.Enabled       := (PageCount > 0) and
                                   (ActivePageIndex >= FFixedPages);
  FCloseAllTabsMenuItem.Enabled := (PageCount > 0);
end ;

procedure TTDINoteBook.TimerRestoreLastFocus(Sender : TObject) ;
begin
  FTimerRestoreLastControl.Enabled := False;

  if Assigned( ActivePage ) then
    if ActivePage is TTDIPage then
      TTDIPage( ActivePage ).RestoreLastFocusedControl;
end ;

function TTDINoteBook.CanChange : Boolean ;
Var
  AWinControl : TWinControl ;
begin
  Result := True;

  if ([csDesigning, csDestroying] * ComponentState = []) then
  begin
    if Assigned( ActivePage ) then
    begin
      // Saving Last Active Control in Page //
      AWinControl := Screen.ActiveControl;

      if ActivePage is TTDIPage then
      begin
        if ActivePage.ContainsControl( AWinControl ) then
        begin
          TTDIPage( ActivePage ).LastActiveControl := AWinControl;

          if FVerifyIfCanChangePage then
          begin
            { Try to detect if occurs some exception when leaving current
              control focus. This may occurs in TWinControl.OnExit Validation }
            Self.SetFocus;

            { If still on same ActiveControl, maybe Focus Control was trapped on
              some OnExit Validation }
            Result := ( AWinControl <> Screen.ActiveControl );
          end ;
        end ;
      end ;
    end ;
  end ;

  Result := Result and (inherited CanChange) ;
end ;

procedure TTDINoteBook.DoChange ;
begin
  inherited DoChange;

  if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;

  CheckInterface;

  {
  // This doesn't work on Win32, Focus always go to first control on Page //
  if FRestoreActiveControl then
    if (ActivePage is TTDIPage) then
      TTDIPage( ActivePage ).RestoreLastFocusedControl;
  }

  // This is a ugly workaround.. but it works :) //
  FTimerRestoreLastControl.Enabled := True;
end ;

procedure TTDINoteBook.Loaded ;
begin
  inherited Loaded ;

  if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;

  if Assigned( FMainMenu ) then
     CreateTabsMenuItem;

  CheckInterface;
end ;

procedure TTDINoteBook.RemovePage(Index : Integer) ;
Var
  CanRemovePage : Boolean ;
  LastPageCount : Integer ;
begin
  CanRemovePage := True;
  FIsRemovingAPage := True;

  try
    if ([csDesigning, csDestroying] * ComponentState = []) then
      if Pages[Index] is TTDIPage then
        with TTDIPage(Pages[Index]) do
        begin
          if Assigned( FormInPage ) then
          begin
            { // This code is ok, but calls CloseQuery twice //
             CanRemovePage := FormInPage.CloseQuery ;
             if CanRemovePage then
               FormInPage.Close ;
            }
            LastPageCount := PageCount;
            FormInPage.Close ;
            CanRemovePage := (LastPageCount = PageCount ) and  // Page wasn't removed by Notification ?
                             ( (not Assigned(FormInPage)) or   // Form Isn't valid ?
                               ( not FormInPage.Showing )      // Form is not showing ?
                             );
          end ;
        end ;

    if CanRemovePage then
    begin
      inherited RemovePage(Index) ;

      if PageCount < 1 then  // On this case, DoChange is not fired //
        CheckInterface;
    end ;
  finally
    FIsRemovingAPage := False;
  end ;
end ;

procedure TTDINoteBook.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  APageIndex : Integer ;
begin
  if FClosePageMouseMiddleButtom and (Button = mbMiddle) then
  begin
     APageIndex := TabIndexAtClientPos( Point(X,Y) );
     if (APageIndex >= 0) and (APageIndex >= FixedPages) then
     begin
       RemovePage( APageIndex );
       exit;
     end;
  end;

  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TTDINoteBook.KeyDown(var Key: Word; Shift: TShiftState);
begin
  // TODO: HiJack TDIPage.Form.OnKeyDown to detect ShortCut inside the Form //

  if ShortCut(Key, Shift) = FClosePageShortCut then
    if PageIndex >= FFixedPages then
    begin
      RemovePage( PageIndex );
      exit;
    end;

  inherited KeyDown(Key, Shift);
end;

procedure TTDINoteBook.Notification(AComponent : TComponent ;
  Operation : TOperation) ;
begin
  inherited Notification(AComponent, Operation) ;

  if (Operation = opRemove) then
  begin
     if (AComponent = FBackgroundImage) then
       FBackgroundImage := nil

     else if (AComponent = FMainMenu) then
       FMainMenu := nil

     else if ([csDesigning, csDestroying] * ComponentState <> []) then

     else if (AComponent is TForm) then
       RemoveInvalidPages

     else if (AComponent is TTDIPage) and (not FIsRemovingAPage) then
        RemovePage( TTDIPage( AComponent ).PageIndex ) ;
  end ;
end ;

procedure TTDINoteBook.DrawBackgroundImage ;
begin
  if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;

  if not Assigned( FBackgroundImage ) then exit ;

  if not Assigned( ActivePage ) then exit ;

  FBackgroundImage.Parent  := ActivePage;
  FBackgroundImage.Anchors := [];
  FBackgroundImage.AnchorSideBottom.Control := nil;
  FBackgroundImage.AnchorSideTop.Control    := nil;
  FBackgroundImage.AnchorSideRight.Control  := nil;
  FBackgroundImage.AnchorSideLeft.Control   := nil;

  if FBackgroundCorner in [coBottomRight, coBottomLeft] then
  begin
     FBackgroundImage.AnchorSideBottom.Control := ActivePage;
     FBackgroundImage.AnchorSideBottom.Side    := asrBottom;
     FBackgroundImage.Anchors := FBackgroundImage.Anchors + [akBottom];
  end
  else
  begin
     FBackgroundImage.AnchorSideTop.Control := ActivePage;
     FBackgroundImage.AnchorSideTop.Side    := asrTop;
     FBackgroundImage.Anchors := FBackgroundImage.Anchors + [akTop];
  end ;

  if FBackgroundCorner in [coBottomRight, coTopRight] then
  begin
     FBackgroundImage.AnchorSideRight.Control := ActivePage;
     FBackgroundImage.AnchorSideRight.Side    := asrBottom;
     FBackgroundImage.Anchors := FBackgroundImage.Anchors + [akRight];
  end
  else
  begin
     FBackgroundImage.AnchorSideLeft.Control := ActivePage;
     FBackgroundImage.AnchorSideLeft.Side    := asrTop;
     FBackgroundImage.Anchors := FBackgroundImage.Anchors + [akLeft];
  end ;

  FBackgroundImage.Visible := True ;
end ;

procedure TTDINoteBook.RemoveInvalidPages ;
var
  I : Integer ;
begin
  // Remove all TTDIPage with FormInPage not assigned //;
  I := 0 ;
  while I < PageCount do
  begin
    if Page[I] is TTDIPage then
    begin
      with TTDIPage( Page[I] ) do
      begin
        if FormInPage = nil then
        begin
          RemovePage( I );
          Dec( I ) ;
        end ;
      end ;
    end ;

    Inc( I ) ;
  end ;
end ;

end.