Как в sPageContol недопустить выхода за рамки заголовка

[-=Virus=-]

Подскажите как сделать так чтобы не заходило название вкладки на кнопку закрытия вкладки.
И чтоб название вкладки тображалась самое начало а не середина.



Вот промер как создаётся вкладка программно,и откуда берётся название вкладок.
Хочется чтобы название вкладки как у оперы по центр,и не превышал размер.

unit frmMain;

interface

uses
  Classes, Controls, Forms, OleCtrls, EmbeddedWB, ComCtrls, StdCtrls,
  IEAddress, ExtCtrls, SysUtils;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    Panel1: TPanel;
    Button1: TButton;
    IEAddress1: TIEAddress;
    cbNewTab: TCheckBox;
    StatusBar1: TStatusBar;
    procedure PageControl1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    procedure DownloadCompleteEvent(Sender: TObject);
    function GetActiveEWB: TEmbeddedWB;
    procedure UpdateAddress;
    procedure UpdateTab;
    function CreateNewTabBrowser(Url: string): TTabSheet;
    procedure NewWindowEvent(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
    procedure NewWebStatusTextChange(Sender: TObject;
      const Text: WideString);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  DesignTimeWB: TEmbeddedWB;
  NewTab: TTabSheet;
  i: integer;

implementation

{$R *.dfm}

//--------Private Section---------------------------------------------

procedure TForm1.UpdateTab;
begin
  PageControl1.ActivePage := NewTab;
  UpdateAddress;
end;

function TForm1.GetActiveEWB: TEmbeddedWB;
var
  i: Integer;
begin
  Result := nil;
  if PageControl1.ActivePage <> nil then
    for i := 0 to PageControl1.ActivePage.ControlCount - 1 do
    begin
      if PageControl1.ActivePage.Controls[i] is TEmbeddedWB then
      begin
        Result := TEmbeddedWB(PageControl1.ActivePage.Controls[i]);
        Exit;
      end;
    end;
end;

procedure TForm1.UpdateAddress;
var
  WB: TEmbeddedWB;
begin
  WB := GetActiveEWB;
  if Assigned(WB) then
  begin
    IEAddress1.EmbeddedWB := WB;
    IEAddress1.Text := WB.LocationURL;
    PageControl1.ActivePage.Caption := WB.LocationName;
  end;
end;

procedure TForm1.DownloadCompleteEvent(Sender: TObject);
begin
  UpdateAddress;
end;

function TForm1.CreateNewTabBrowser(Url: string): TTabSheet;
begin
  NewTab := TTabSheet.Create(PageControl1);
  with NewTab do
  begin
    PageControl := PageControl1;
    Parent := PageControl1;
    PageIndex := PageControl1.ActivePageIndex;
  end;
  DesignTimeWB := TEmbeddedWB.Create(NewTab);
  TControl(DesignTimeWB).Parent := NewTab;
  with DesignTimeWB do
  begin
    EnableMessageHandler := True;
    LoadSettings;
    Align := alClient;
    OnStatusTextChange := NewWebStatusTextChange;
    OnNewWindow2 := NewWindowEvent;
    OnDownloadComplete := DownloadCompleteEvent;
    if Trim(URL) <> '' then
      DesignTimeWB.NavigateWait(URL);
  end;
  PageControl1.ActivePage := NewTab;
  Result := NewTab;
end;

procedure TForm1.NewWindowEvent(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
begin
  CreateNewTabBrowser(DesignTimeWB.LocationURL);
  PageControl1.ActivePage := NewTab;
  ppdisp := DesignTimeWB.Application;
  UpdateTab;
end;

procedure TForm1.PageControl1Change(Sender: TObject);
begin
  UpdateAddress;
end;

procedure TForm1.NewWebStatusTextChange(Sender: TObject;
  const Text: WideString);
begin
  StatusBar1.SimpleText := Text;
end;

//--------End Of Private Section---------------------------------------------

procedure TForm1.FormShow(Sender: TObject);
begin
  CreateNewTabBrowser(DesignTimeWB.GetIEHomePage);
  UpdateTab;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if cbNewtab.Checked then
  begin
    CreateNewTabBrowser(IEAddress1.Text);
    UpdateTab;
  end
  else
  begin
    DesignTimeWB.Go(IEAddress1.Text);
    UpdateTab;
  end;
end;

end.

Спокойно ждите ответа и не нужно флудить.

[-=Virus=-]

Решено.
Кому интересно

function TruncCaption(Text: String; NeedWidth: Integer; Canvas: TCanvas): string;
var
  NewTextW: Integer;
begin
  NewTextW := Round(length(Text) * (NeedWidth/Canvas.TextWidth(Text))) - 3;
  Result := Copy(Text, 1, NewTextW) + '...';
end;

procedure TBrowser.UpdateAddress;
var
WB: TEmbeddedWB;
r: TRect;
begin
WB := GetActiveEWB;
if Assigned(WB) then
begin
IEAddress1.EmbeddedWB := WB;
IEAddress1.Text := WB.LocationURL;
r := sPageControl1.TabRect(sPageControl1.ActivePage.TabIndex);
sPageControl1.ActivePage.Caption := TruncCaption(WB.LocationName, r.Right-r.Left, sPageControl1.Canvas);
end;
end;