lazarus/lcl/tests/test4_2pagecontrol.lpr

{
 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.LCL, included in this distribution,                 *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************

  LCL Test 4_2

  Test for TPageControl.
}
program test4_2pagecontrol;

{$mode objfpc}{$H+}

uses
  Interfaces, FPCAdds, LCLProc, LCLType, Classes, Controls, Forms, TypInfo,
  LMessages, Buttons, ExtCtrls, ComCtrls, Graphics, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    PageControl1: TPageControl;
    PagesListBox: TListBox;
    ButtonsGroupBox: TGroupBox;
    InsertPageLeftButton: TButton;
    InsertPageRightButton: TButton;
    DeletePageButton: TButton;
    MovePageLeftButton: TButton;
    MovePageRightButton: TButton;
    PageVisibleCheckBox: TCheckBox;
    procedure DeletePageButtonClick(Sender: TObject);
    procedure Form1Create(Sender: TObject);
    procedure InsertPageLeftButtonClick(Sender: TObject);
    procedure InsertPageRightButtonClick(Sender: TObject);
    procedure MovePageLeftButtonClick(Sender: TObject);
    procedure MovePageRightButtonClick(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure PageVisibleCheckBoxClick(Sender: TObject);
    procedure PagesListBoxClick(Sender: TObject);
  public
    constructor Create(TheOwner: TComponent); override;
    procedure AddNewPage(Index: integer);
    procedure FillPagesListBox;
  end;

{ TForm1 }

procedure TForm1.Form1Create(Sender: TObject);
var
  i: Integer;
begin
  debugln('TForm1.Form1Create ',DbgSName(Sender));
  SetBounds(50,50,500,400);

  PageControl1:=TPageControl.Create(Self);
  with PageControl1 do begin
    Name:='PageControl1';
    Align:=alTop;
    Height:=200;
    Parent:=Self;
    OnChange:=@PageControl1Change;
  end;

  PagesListBox:=TListBox.Create(Self);
  with PagesListBox do begin
    Name:='PagesListBox';
    Align:=alLeft;
    Parent:=Self;
    OnClick:=@PagesListBoxClick;
  end;

  ButtonsGroupBox:=TGroupBox.Create(Self);
  with ButtonsGroupBox do begin
    Name:='ButtonsGroupBox';
    Align:=alClient;
    Parent:=Self;
  end;
  
  InsertPageLeftButton:=TButton.Create(Self);
  with InsertPageLeftButton do begin
    Name:='InsertPageLeftButton';
    Caption:='Insert page left';
    AutoSize:=true;
    Parent:=ButtonsGroupBox;
    OnClick:=@InsertPageLeftButtonClick;
  end;
  
  InsertPageRightButton:=TButton.Create(Self);
  with InsertPageRightButton do begin
    Name:='InsertPageRightButton';
    Caption:='Insert page right';
    AutoSize:=true;
    Parent:=ButtonsGroupBox;
    OnClick:=@InsertPageRightButtonClick;
  end;

  MovePageLeftButton:=TButton.Create(Self);
  with MovePageLeftButton do begin
    Name:='MovePageLeftButton';
    Caption:='move page left';
    AutoSize:=true;
    Parent:=ButtonsGroupBox;
    OnClick:=@MovePageLeftButtonClick;
  end;

  MovePageRightButton:=TButton.Create(Self);
  with MovePageRightButton do begin
    Name:='MovePageRightButton';
    Caption:='move page right';
    AutoSize:=true;
    Parent:=ButtonsGroupBox;
    OnClick:=@MovePageRightButtonClick;
  end;

  DeletePageButton:=TButton.Create(Self);
  with DeletePageButton do begin
    Name:='DeletePageButton';
    Caption:='Delete page';
    AutoSize:=true;
    Parent:=ButtonsGroupBox;
    OnClick:=@DeletePageButtonClick;
  end;

  PageVisibleCheckBox:=TCheckBox.Create(Self);
  with PageVisibleCheckBox do begin
    Name:='PageVisibleCheckBox';
    Caption:='Visible';
    AutoSize:=true;
    Parent:=ButtonsGroupBox;
    OnClick:=@PageVisibleCheckBoxClick;
  end;
  
  ButtonsGroupBox.ChildSizing.ControlsPerLine:=2;
  ButtonsGroupBox.ChildSizing.Layout:=cclLeftToRightThenTopToBottom;

  for i:=0 to 2 do AddNewPage(i);
  FillPagesListBox;

end;

procedure TForm1.DeletePageButtonClick(Sender: TObject);
var
  i: LongInt;
begin
  i:=PagesListBox.ItemIndex;
  if (i<0) or (i>=PageControl1.PageCount) then exit;
  PageControl1.Pages[i].Free;
  FillPagesListBox;
end;

procedure TForm1.InsertPageLeftButtonClick(Sender: TObject);
var
  i: LongInt;
begin
  i:=PagesListBox.ItemIndex;
  if (i<0) or (i>=PageControl1.PageCount) then i:=PageControl1.PageIndex;
  AddNewPage(i);
end;

procedure TForm1.InsertPageRightButtonClick(Sender: TObject);
var
  i: LongInt;
begin
  if PageControl1.PageCount=0 then
    AddNewPage(0)
  else begin
    i:=PagesListBox.ItemIndex;
    if (i<0) or (i>=PageControl1.PageCount) then i:=PageControl1.PageIndex;
    AddNewPage(i+1);
  end;
end;

procedure TForm1.MovePageLeftButtonClick(Sender: TObject);
var
  i: LongInt;
begin
  i:=PagesListBox.ItemIndex;
  if (i<0) or (i>=PageControl1.PageCount) then i:=PageControl1.PageIndex;
  if i<=0 then exit;
  PageControl1.Pages[i].PageIndex:=PageControl1.Pages[i].PageIndex-1;
  FillPagesListBox;
  PagesListBox.ItemIndex:=PageControl1.PageIndex;
end;

procedure TForm1.MovePageRightButtonClick(Sender: TObject);
var
  i: LongInt;
begin
  i:=PagesListBox.ItemIndex;
  if (i<0) or (i>=PageControl1.PageCount) then i:=PageControl1.PageIndex;
  if i>=PageControl1.PageCount-1 then exit;
  PageControl1.Pages[i].PageIndex:=PageControl1.Pages[i].PageIndex+1;
  FillPagesListBox;
  PagesListBox.ItemIndex:=PageControl1.PageIndex;
end;

procedure TForm1.PageControl1Change(Sender: TObject);
begin
  FillPagesListBox;
  PagesListBox.ItemIndex:=PageControl1.PageIndex;
  DebugLn(['TForm1.PageControl1Change PagesListBox.ItemIndex=',PagesListBox.ItemIndex,' PageControl1.PageIndex=',PageControl1.PageIndex]);
end;

procedure TForm1.PageVisibleCheckBoxClick(Sender: TObject);
var
  i: LongInt;
begin
  i:=PagesListBox.ItemIndex;
  if i<0 then exit;
  PageControl1.Pages[i].TabVisible:=PageVisibleCheckBox.Checked;
end;

procedure TForm1.PagesListBoxClick(Sender: TObject);
var
  i: LongInt;
begin
  i:=PagesListBox.ItemIndex;
  if i<0 then exit;
  PageControl1.PageIndex:=i;
  PageVisibleCheckBox.Checked:=PageControl1.Pages[i].TabVisible;
end;

constructor TForm1.Create(TheOwner: TComponent);
begin
  OnCreate:=@Form1Create;
  inherited Create(TheOwner);
  // start with 3 pages
end;

procedure TForm1.AddNewPage(Index: integer);
var
  NewPage: TTabSheet;
  NewName: String;
begin
  NewPage:=TTabSheet.Create(Self);
  NewName:='Page1';
  while FindComponent(NewName)<>nil do NewName:=CreateNextIdentifier(NewName);
  NewPage.Name:=NewName;
  NewPage.Caption:=NewName;
  NewPage.PageControl := PageControl1;
  NewPage.PageIndex := Index;
  PageControl1.PageIndex:=Index;
  FillPagesListBox;
  PagesListBox.ItemIndex:=PageControl1.PageIndex;
end;

procedure TForm1.FillPagesListBox;
var
  i: Integer;
  OldItemIndex: LongInt;
begin
  PagesListBox.Items.BeginUpdate;
  OldItemIndex:=PagesListBox.ItemIndex;
  for i:=0 to PageControl1.PageCount-1 do begin
    if PagesListBox.Items.Count>i then begin
      PagesListBox.Items[i]:=PageControl1.Pages[i].Name;
    end else begin
      PagesListBox.Items.Add(PageControl1.Pages[i].Name);
    end;
  end;
  while (PagesListBox.Items.Count>PageControl1.PageCount) do
    PagesListBox.Items.Delete(PagesListBox.Items.Count-1);
  PagesListBox.ItemIndex:=OldItemIndex;
  PagesListBox.Items.EndUpdate;
  if PagesListBox.ItemIndex>=0 then
    PageVisibleCheckBox.Checked:=
      PageControl1.Pages[PagesListBox.ItemIndex].TabVisible;
end;

var
  Form1: TForm1 = nil;
begin
  Application.Title:='test4_1synedit';
  Application.Initialize;
  Application.CreateForm(TForm1,Form1);
  Application.Run;
end.