Ayuda con PageControl

[Badillo]

Saludos a todos

Tengo el siguiente problema con el control TPageControl:

Necesito que al modificarle los caption a los TTabSheet en ejecución se me ajuste el tamaño de la pestaña al tamaño del caption, tal y como lo hace desde la vista de diseño cuando la propiedad TabWidth = 0.

Es decir los Caption los tengo por defecto en la vista de diseño en inglés y cuando entro al formulario los pongo en español, por tanto casi siempre es mayor que el tamaño original.

Una solución que se me ocurrió fué recorrer los TTabSheet calcular el mayor tamaño del texto más valor de ajuste como margen y asignarle ese valor a la propiedad TabWidth = Valor, pero esto hace que sean grandes y me ocupen demasiado espacio.

Cualquier idea será con gusto bien recibida.

Muchas gracias de antemano.

[dec]

Hola a todos,

Es raro: si pongo un "TPageControl" en un formulario y únicamente añado unas cuentas pestañas (sin tocar nada más), ya en tiempo de ejecución, el siguiente código modifica el "Caption" de las pestañas, adaptando el tamaño automáticamente, tal como esperas.

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
begin
  for var I := 0 to PageControl1.PageCount - 1 do
  begin
    PageControl1.Pages[i].Caption := 'aaaaaaa aaaaaa aaaaaaa';
  end;
end;

[Badillo]

Saludos y disculpen, faltó algo por explicar que no había visto:

El PageControl que les comento es uno modificado, por lo que estoy viendo el problema debe estar en el método CNDrawItem.

Código Delphi [-]
procedure TMdPageControl.CNDrawItem(var Message: TWMDrawItem);
var
  SaveIndex:  Integer;
  Caption:    string;
  Size:       TSize;
  x,y:        integer;
  Rgn:        HRGN;
  Color:      TColor;
  Rect:       TRect;
begin
  with Message.DrawItemStruct^ do
  begin
    SelectClipRgn(hDC, 0);  // don't get clipped in the original rectangle
    SaveIndex := SaveDC(hDC);
    Canvas.Lock;
    try
      Canvas.Handle := hDC;

      Canvas.Brush.Color := TabColor;
      Caption := MdThemeConstants.GetTranslation(Self.Tabs.Strings[ItemID]);
      Canvas.Font := Font;
      Rect := rcItem;
      Size := Canvas.TextExtent(Caption);

      case TabPosition of
        tpTop:
          begin
            Dec(Rect.Left, 3);
            Inc(Rect.Right, 5);
            Dec(Rect.Top, 4);
            Canvas.Font.Orientation := 0;
            x := Rect.Left + (Rect.Right - Rect.Left - Size.Width) div 2;
            y := Rect.Top + (Rect.Bottom - Rect.Top - Size.Height) div 2 + 1;
          end;
        tpBottom:
          begin
            if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then
            begin
              Dec(Rect.Top, 2);
              Dec(Rect.Right, 8);
              Inc(Rect.Bottom, 2);
            end
            else
            begin
              Dec(Rect.Top, 6);
              Dec(Rect.Left, 4);
              Dec(Rect.Right, 4);
              Inc(Rect.Bottom, 4);
            end;
            Canvas.Font.Orientation := 0;
            x := Rect.Left + (Rect.Width div 2 - Size.Width div 2);
            y := Rect.Top + (Rect.Height div 2 - Size.Height div 2);
          end;
        tpLeft:
          begin
            if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then
            begin
              Dec(Rect.Left, 2);
              Dec(Rect.Bottom, 8);
              Dec(Rect.Right, 6);
            end
            else
            begin
              Dec(Rect.Left, 4);
              Dec(Rect.Top, 4);
              Dec(Rect.Bottom, 4);
              Dec(Rect.Right, 2);
            end;
            Canvas.Font.Orientation := 900;
            x := Rect.Left + (Rect.Width div 2) - (Size.Height div 2);
            y := Rect.Top + (Rect.Height div 2) + (Size.Width div 2);
          end;
        tpRight:
          begin
            if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then
            begin
              Inc(Rect.Left, 2);
              Dec(Rect.Bottom, 8);
              Dec(Rect.Right, 0);
            end
            else
            begin
              Dec(Rect.Left, 2);
              Dec(Rect.Top, 4);
              Dec(Rect.Bottom, 4);
              Inc(Rect.Right, 2);
            end;
            Canvas.Font.Orientation := -900;
            x := Rect.Left + (Rect.Width div 2) + (Size.Height div 2);
            y := Rect.Bottom - (Rect.Height div 2) - (Size.Width div 2);
          end;
      end;
      if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then Canvas.Font.Color := TabHighlightedColor;
      Canvas.TextRect(Rect, x, y, Caption);

    finally
      Canvas.Handle := 0;
      Canvas.Unlock;
      RestoreDC(hDC, SaveIndex);
    end;

    // Erase Outer border

    Rgn := CreateRectRgn(0, 0, 0, 0);
    SelectClipRgn(hDC, Rgn);
    DeleteObject(Rgn);
  end;

  Message.Result := 1;
end;

Les adjunto la clase completa y un ejemplo de su funcionamiento.

Gracias una vez más por cualquier ayuda, pero creo que la cosa debe estar en las dimensiones del Rect que la utilizan con el texto viejo y no con el nuevo.