TPageControl: Neuberechnung Reiterbreite, wenn Page-Schrift fett angezeigt wird

[marcibaer]

Hallo zusammen,

ich habe mir 'ne Komponente von TPageControl abgeleitet, bei der die Schrift des aktuellen Reiters in Fettschrift dargestellt wird. Das klappt auch soweit gut - nachdem ich im Netz die Idee mit Perform(WM_SIZE,0,0); gefunden habe. Leider wird die Breite des Reiters nicht angepasst. Hat jemand 'ne Idee, was mir da fehlt!?

Anbei der Komponentencode:

Delphi-Quellcode:

  TMyPageControl = class(TPageControl)
  private
    procedure OnMyChange(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    procedure OnDrawTab(Control:TCustomTabControl;TabIndex:Integer; const Rect:TRect);
  end;

constructor TMyPageControl.Create(AOwner: TComponent);
begin
  inherited;
  OwnerDraw := true;
  OnChange := OnMyChange;
end;

procedure TMyPageControl.OnMyChange(Sender: TObject);
begin
  Perform(WM_SIZE,0,0);
end;

procedure TMyPageControl.OnDrawTab(Control:TCustomTabControl;
  TabIndex:Integer;const Rect:TRect);
var
  TabText: String;
  APoint: TPoint;
begin
  with Canvas do
    begin
      if Boolean(Pages[TabIndex].Tag) then
        Brush.Color := clBtnFace
      else
        Brush.Color := ClRed;
      FillRect(Rect);
      TabText := Pages[TabIndex].Caption;
      if (TabIndex = ActivePageIndex) then
        Font.Style := [fsBold]
      else
        Font.Style := [];
      APoint.x := (Rect.Right - Rect.Left) div 2 - TextWidth(TabText) div 2;
      APoint.y := (Rect.Bottom - Rect.Top) div 2 - TextHeight(TabText) div 2;
      TextRect(Rect, Rect.Left + APoint.x, Rect.Top + APoint.y, TabText);
    end;
end;

Ja, ich weiss - with ... do ist böse ...

Vielen Dank,

Marc