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
[-]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
TIndex := -1;
Ind := TabIndex;
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
if Active then
SetChangeColorControl([fsBold], clBlue)
else
SetChangeColorControl([], clBlack);
Texto := (Control as TPageControl).Pages[GetTabIndex].Caption;
R := Rect;
Control.Canvas.FillRect(R);
DrawText(
Control.Canvas.Handle, PChar(Texto), -1, R,
DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;