lazarus/lcl/include/notebook.inc

{%MainUnit ../extctrls.pp}
{******************************************************************************
                               TNotebook
 ******************************************************************************

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}

{******************************************************************************
                                   TUNBPages
 ******************************************************************************}

{------------------------------------------------------------------------------
  TUNBPages Constructor
 ------------------------------------------------------------------------------}
constructor TUNBPages.Create(thePageList: TListWithEvent;
  theNotebook: TNotebook);
begin
  inherited Create;
  fPageList := thePageList;
  fPageList.OnChange:=@PageListChange;
  fNotebook := theNotebook;
end;

{------------------------------------------------------------------------------
  procedure TUNBPages.PageListChange(Ptr: Pointer; AnAction: TListNotification);
 ------------------------------------------------------------------------------}
procedure TUNBPages.PageListChange(Ptr: Pointer; AnAction: TListNotification);
{var
  APage: TUNBPage;}
begin
{  if (AnAction=lnAdded) then
  begin
    APage:=TObject(Ptr) as TUNBPage;
    if not (pfInserting in APage.FFlags) then
      APage.Parent:=fNotebook;
  end;}
end;

{------------------------------------------------------------------------------
  TUNBPages Get
 ------------------------------------------------------------------------------}
function TUNBPages.Get(Index: Integer): string;
begin
  if (Index<0) or (Index>=fPageList.Count) then
    RaiseGDBException('TUNBPages.Get Index out of bounds');
  Result := TPage(fPageList[Index]).Caption;
end;

{------------------------------------------------------------------------------
  TUNBPages GetCount
 ------------------------------------------------------------------------------}
function TUNBPages.GetCount: Integer;
begin
  Result := fPageList.Count;
end;

{------------------------------------------------------------------------------
  TUNBPages GetObject
 ------------------------------------------------------------------------------}
function TUNBPages.GetObject(Index: Integer): TObject;
begin
  if (Index<0) or (Index>=fPageList.Count) then
    RaiseGDBException('TUNBPages.GetObject Index out of bounds');
  Result := TPage(fPageList[Index]);
end;

{------------------------------------------------------------------------------
  TUNBPages Put
 ------------------------------------------------------------------------------}
procedure TUNBPages.Put(Index: Integer; const S: String);
begin
  if (Index<0) or (Index>=fPageList.Count) then
    RaiseGDBException('TUNBPages.Put Index out of bounds');
  //debugln(['TUNBPages.Put ',DbgSName(FNotebook),' ',Index,' S="',S,'"']);
  TPage(fPageList[Index]).Caption := S;
end;

{------------------------------------------------------------------------------
  TUNBPages Clear
 ------------------------------------------------------------------------------}
procedure TUNBPages.Clear;
begin
  while fPageList.Count>0 do
    Delete(fPageList.Count-1);
end;

{------------------------------------------------------------------------------
  TUNBPages Delete
 ------------------------------------------------------------------------------}
procedure TUNBPages.Delete(Index: Integer);
var
  APage: TPage;
begin
  // Make sure Index is in the range of valid pages to delete
  if (Index < 0) or (Index >= fPageList.Count) then Exit;

  APage := TPage(fPageList[Index]);
  //Update fPageList
  fPageList.Delete(Index);
  // delete handle
  APage.Parent := nil;
  // free the page
  Application.ReleaseComponent(APage);
end;

{------------------------------------------------------------------------------
  TUNBPages Insert
 ------------------------------------------------------------------------------}
procedure TUNBPages.Insert(Index: Integer; const S: String);
var
  NewPage: TPage;
  NewOwner: TComponent;
begin
  NewOwner := FNotebook.Owner;
  if NewOwner = nil then
    NewOwner := FNotebook;
  NewPage := TPage.Create(NewOwner);
  NewPage.Caption := S;

  FNoteBook.InsertPage(NewPage,Index);
end;

{******************************************************************************
                               TNotebook
 ******************************************************************************}
function TNotebook.GetActivePage: String;
begin
  Result := Page[GetPageIndex].Caption;
end;

function TNotebook.GetActivePageComponent: TPage;
begin
  Result := Page[GetPageIndex];
end;

function TNotebook.GetPage(AIndex: Integer): TPage;
begin
  if (AIndex < 0) or (AIndex >= FPageList.Count) then
    RaiseGDBException(Format('TNotebook.GetCustomPage Index out of bounds. AIndex=%d', [AIndex]));
  Result := TPage(FPageList.Items[AIndex]);
end;

function TNotebook.GetPageCount: Integer;
begin
  Result := FPages.Count;
end;

function TNotebook.GetPageIndex: Integer;
begin
  Result := FPageIndex;
end;

procedure TNotebook.InsertPage(APage: TPage; Index: Integer);
begin
  if FPageList.IndexOf(APage) >= 0 then Exit;

  FPageList.Insert(Index, APage);

  APage.Parent := Self;
  APage.Align := alClient;
  APage.Visible := False;
  APage.ControlStyle := APage.ControlStyle + [csNoDesignVisible];

  if PageIndex = -1 then SetPageIndex(Index);
end;

procedure TNotebook.SetPageIndex(AValue: Integer);
var
  pg: TPage;
begin
  if (AValue < -1) or (AValue >= Pages.Count) then Exit;
  if FPageIndex = AValue then exit;

  // Hide the previously shown page
  if (FPageIndex >= 0) and (FPageIndex < Pages.Count) then
  begin
    pg := Page[FPageIndex];
    pg.ControlStyle := pg.ControlStyle + [csNoDesignVisible];
    pg.Visible := False;
  end;

  // Update the property
  FPageIndex := AValue;
  if (FPageIndex = -1) then
    exit;

  // And show the new one
  pg := Page[FPageIndex];
  if Assigned(pg.FOnBeforeShow) then
    pg.FOnBeforeShow(Self, pg, FPageIndex); // OnBeforeShow event
  pg.Visible := True;
  pg.ControlStyle := pg.ControlStyle - [csNoDesignVisible];
  pg.Align := alClient;
end;

{------------------------------------------------------------------------------
  TNotebook Constructor
 ------------------------------------------------------------------------------}
constructor TNotebook.Create(TheOwner: TComponent);
var
  lSize: TSize;
begin
  inherited Create(TheOwner);

  FPageList := TListWithEvent.Create;
  FPageIndex := -1;
  FPages := TUNBPages.Create(FPageList, Self);

  ControlStyle := []; // do not add csAcceptsControls

  // Initial size
  lSize := GetControlClassDefaultSize();
  SetInitialBounds(0, 0, lSize.CX, lSize.CY);
end;

destructor TNotebook.Destroy;
begin
  FreeAndNil(FPageList);
  FreeAndNil(FPages);

  inherited Destroy;
end;

procedure TNotebook.ShowControl(AControl: TControl);
var
  i: Integer;
begin
  if AControl = ActivePageComponent then exit;
  i := FPageList.IndexOf(Pointer(aControl));
  if i >= 0 then
    PageIndex := i;
  inherited ShowControl(AControl);
end;