type
  TForm1 = class(TForm)
  procedure FormResize(Sender: TObject);
  procedure FormPaint(Sender: TObject);
  private
  procedure VerticalTitleBar(Texto: string; Size: Integer);
  end;

  const
  MY_TITLE_TEXT = 'Vertical Text';
  var
  Form1: TForm1;

  implementation

  {$R *.DFM}

  procedure TForm1.VerticalTitleBar(TexTo: string; Size: Integer);
  var
  LogFont: TLogFont;
  tmpCanvas: TCanvas;
  tmpRect: TRect;
  x1, x2, y1, y2: integer;
  begin
  tmpCanvas := TCanvas.Create;
  tmpCanvas.Handle := GetWindowDc(Handle);
  try
  GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont);
  with LogFont do
  begin
  lfEscapement := 90 * 10;
  lfOrientation := 90 * 10;
  lfOutPrecision := OUT_TT_ONLY_PRECIS;
  lfFaceName := 'Arial';
  lfHeight := Size;
  lfWeight := FW_BOLD;
  lfQuality := PROOF_QUALITY;
  end;
  with tmpCanvas do
  begin
  Font.Handle := CreateFontIndirect(LogFont);
  Font.Color := clWhite;
  Brush.Color := clNavy;
  end;
  x1 := GetSystemMetrics(SM_CXEDGE) + GetSystemMetrics(SM_CXBORDER);
  x2 := 20;
  y1 := GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYEDGE) +
  GetSystemMetrics(SM_CYBORDER) + 1;
  y2 := Height - GetSystemMetrics(SM_CYEDGE) - GetSystemMetrics(SM_CYBORDER);
  tmpRect := Rect(x1, y1, x2, y2);
  tmpCanvas.FillRect(tmpRect);
  DrawText(tmpCanvas.Handle, PChar(Texto), - 1, tmpRect, DT_BOTTOM or
  DT_SINGLELINE);
  finally
  tmpCanvas.Free;
  end;
  end;

  procedure TForm1.FormResize(Sender: TObject);
  begin
  VerticalTitleBar(MY_TITLE_TEXT, 12);
  end;

  procedure TForm1.FormPaint(Sender: TObject);
  begin
  VerticalTitleBar(MY_TITLE_TEXT, 12);
  end;

  end.