1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:

procedure TForm1.Button1Click(Sender: TObject);
var
  Text: String;
  Log: TLogFont;
  HFnt: HFont;
begin
  //retrieve current font settings:
  GetObject (Canvas.Font.Handle, SizeOf(Log), @Log);

  //Apply rotation of 90 deg.
  Log.lfEscapement:= 900;
  Log.lfOutPrecision:= OUT_TT_ONLY_PRECIS;

  //create a new font based upon new settings
  HFnt:= CreateFontIndirect (Log);
  SelectObject (Canvas.Handle, HFnt);

  //sample text
  text := 'Vertical';
  Windows.TextOut (Canvas.Handle, 100, 100, @Text[1], Length (Text));

  //free resources
  DeleteObject (HFnt);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

CONST   LF_FACESIZE = 32;
TYPE
  tagLOGFONTA = packed record
    lfHeight: Longint;
    lfWidth: Longint;
    lfEscapement: Longint;
    lfOrientation: Longint;
    lfWeight: Longint;
    lfItalic: Byte;
    lfUnderline: Byte;
    lfStrikeOut: Byte;
    lfCharSet: Byte;
    lfOutPrecision: Byte;
    lfClipPrecision: Byte;
    lfQuality: Byte;
    lfPitchAndFamily: Byte;
    lfFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
  end;