00]默认TabSheet表头的宽度和高度
01]用代码动态添加TabSheet
02]动态双击任意一个标签，即关闭被双击的标签TabSheet
03]自画TabSheet
04]重命名TabSheet
05]添加关闭 按钮


00]默认TabSheet表头的宽度和高度

动态改变 TabSheet表头的宽度和高度

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  with PageControl1 do
  begin
    for i := 0 to PageCount - 1 do
    begin
      if (Canvas.TextWidth(Pages[i].Caption) * 2) > TabWidth then
        TabWidth := Canvas.TextWidth(Pages[i].Caption) * 2;
      if (Canvas.TextHeight(Pages[i].Caption) * 2) > TabHeight then
        TabHeight := Canvas.TextHeight(Pages[i].Caption) * 2;
    end;
  end;
end;

01]用代码动态添加TabSheet

var   Ts : TTabSheet;
aUniButton:tbutton;
begin
        Ts := TTabSheet.Create(PageControl1);         // 创建一个新的TabSheet
      Ts.PageControl := PageControl1;                 // 设置它的父容器为PageControl1
//      Ts.Closable := True;
//      Ts.OnClose := TabSheetClose;
      Ts.Tag := 111;
     ts.Caption:= '第'+ InttoStr(PageControl1.PageCount+1)+'页';      // 设置标签的标题
//      Ts.ImageIndex := Nd.ImageIndex;
  aUniButton:=tbutton.Create(ts);
  aUniButton.Caption:='第'+ InttoStr(PageControl1.PageCount+1)+'页';
  aUniButton.Left:=10;
  aUniButton.Top:=20;
  aUniButton.Parent:=ts;

  aUniButton.OnClick:=Button2Click;
PageControl1.ActivePage := Ts;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if sender is tbutton  then
  showmessage(tbutton(sender).Caption);
end;

 02]动态双击任意一个标签，即关闭被双击的标签TabSheet

procedure DoMessage(var Msg: TMsg; var Handled: Boolean) ;

procedure TForm1.DoMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if (Msg.message = WM_LBUTTONDBLCLK) and (Msg.hwnd = PageControl1.Handle) then
  begin
    if PageControl1.ActivePageIndex = 0 then Exit;  //只保留一个TabSheet
    PageControl1.ActivePage.TabVisible := False;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := Self.DoMessage;
end;

03]自画TabSheet

首先将PageControl的OwnerDraw属性设为TRUE

然后在PageControl的OnDrawTab事件里写代码控制：

procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;           TabIndex: Integer; const Rect: TRect; Active: Boolean);
begin
   if Active then
      begin
         Control.Canvas.Font.Color:=clRed;      //  选中 标题设置为红色
         Control.Canvas.Font.Style:=[fsBold];   //文字加粗

        Control.Canvas.Brush.Color := $00FF9184; //设置背景颜色并填充背景
        Control.Canvas.FillRect(Rect);
      END
      else
      begin
         Control.Canvas.Font.Color:=clBlack;
         Control.Canvas.Font.Style:=[];
      END;
    //画出图标
       ImageList1.Draw(Control.Canvas, Rect.Left + 1,
        Rect.Top+3 ,
        PageControl1.Pages[TabIndex].ImageIndex, true);
   //画出 文字
   Control.Canvas.TextOut(rect.left+2+16,rect.top+3,PageControl1.Pages[TabIndex].Caption);
end;

 04]重命名TabSheet

PageControl1.Pages[PageControl1.ActivePageIndex].Caption:='测试';

 05]添加关闭 按钮

uses Vcl.Graphics,  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Buttons;

type

  TPageControl = class(Vcl.ComCtrls.TPageControl)
  private
    { Private declarations }
    FCloseBtn: TSpeedButton;
  protected
    { Protected declarations }
    procedure CloseBtnClick(Sender: TObject);
    procedure DrawTab(TabIndex: Integer; const Rect: TRect;
      Active: Boolean); override;
    property OwnerDraw;
    property OnDrawTab;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
  end;
{ TPageControl }

procedure TPageControl.CloseBtnClick(Sender: TObject);
begin
  if Self.ActivePage <> nil then
    Self.ActivePage.Free;
  if Self.ActivePage = nil then
    FCloseBtn.Hide;
end;

constructor TPageControl.Create(AOwner: TComponent);
begin
  inherited;
  FCloseBtn := TSpeedButton.Create(Self);
  FCloseBtn.Flat := True;
  FCloseBtn.Width := 16;
  FCloseBtn.Height := 16;
  FCloseBtn.Caption := 'X';
  FCloseBtn.OnClick := CloseBtnClick;
  OwnerDraw := True;
end;

destructor TPageControl.Destroy;
begin
  FCloseBtn.Free;
  inherited;
end;

procedure TPageControl.DrawTab(TabIndex: Integer; const Rect: TRect;
  Active: Boolean);
var
  NewTabWidth: Integer;
  R: TRect;
begin
  inherited;
  NewTabWidth := Canvas.TextWidth(Tabs[TabIndex]) + 24;
  if (Rect.Right - Rect.Left) < NewTabWidth then
    TabWidth := NewTabWidth;

  if Active then
  begin
    FCloseBtn.Parent := Self;
    FCloseBtn.Anchors:=[akTop,akRight];
    FCloseBtn.Left := Rect.Right - FCloseBtn.Width-2;
    FCloseBtn.Top := Rect.Top + 2;
    FCloseBtn.Show;
         Canvas.Font.Color:=clRed;      //  选中 标题设置为红色
         Canvas.Font.Style:=[fsBold];   //文字加粗
         Canvas.Brush.Color := $00FF9184; //设置背景颜色并填充背景
         Canvas.FillRect(Rect);

    Canvas.TextOut(rect.left,rect.top+2,self.Pages[TabIndex].Caption);
  end
  else begin
         Canvas.Font.Color:=clBlack;
        Canvas.Font.Style:=[];
    Canvas.TextOut(rect.left,rect.top+2,self.Pages[TabIndex].Caption);
  end;
end;