Ayuda con PageControl y TabSheet

[olbeup]

Perfecto, pero el problema radica cuando el Font del TabSheet es negrita lo cual agranda el texto y se sale del marco del TabSheet.

Dejo el código que realizado con el que habéis aportado todos:

Código Delphi [-]
// Redibuja el PageControl (Tab) el título en color
procedure TForm1.OnEventPageControlDrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);

  procedure SetChangeColorControl(Style: TFontStyles; Color: TColor);
  begin
    Control.Canvas.Font.Style := Style;
    Control.Canvas.Font.Color := Color;
  end;

  function GetTabIndex: Integer;
  var
    I, TIndex, Ind: Integer;
  begin
    // Iniciarlizar variables de seguimiento del TabSheet
    TIndex := -1;
    Ind    := TabIndex;

    // Iniciar bucle y devolver todos los TabSheet visible
    for I := 0 to (PageControl1.PageCount -1) do
    begin
      if (TIndex = TabIndex) then
        Break;

      if (not PageControl1.Pages[i].TabVisible) then
        Inc(Ind)
      else
        Inc(TIndex);
    end;

    Result := Ind;
  end;

var
  R: TRect;
  Texto: String;

begin
  // Comprobar si está activo y hacer cambios en el Font del TabSheet
  if Active then
    SetChangeColorControl([fsBold], clBlue)
  else
    SetChangeColorControl([], clBlack);

  // Guardar el Caption del TabSheet el cual Corresponde
  Texto := (Control as TPageControl).Pages[GetTabIndex].Caption;

  R := Rect;
  Control.Canvas.FillRect(R);

  // Redibujar el TabSheet que corresponde del PageControl
  DrawText(
    Control.Canvas.Handle, PChar(Texto), -1, R,
    DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;