unit UPageControlEx;interfaceuses
  Windows, SysUtils, Classes, Controls, Buttons, ComCtrls, CommCtrl;type
  TPageControlEX = class(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;
procedure Register;implementationprocedure Register;
begin
  RegisterComponents('Samples', [TPageControlEX]);
end;procedure TPageControlEx.CloseBtnClick(Sender: TObject);
begin
  if Self.ActivePage <> nil then
    Self.ActivePage.Free;
  if Self.ActivePage = nil then
    FCloseBtn.Hide;
end;constructor TPageControlEx.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 TPageControlEx.Destroy;
begin
  FCloseBtn.Free;
  inherited;
end;procedure TPageControlEx.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;
  TabCtrl_GetItemRect(Handle, TabIndex, R);
  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.TextOut(R.Left + 5, R.Top + 2, Tabs[TabIndex]); //居左;
  end
  else begin
    Canvas.TextOut(R.Left + 5, R.Top + 2, Tabs[TabIndex]);
  end;
end;
end.