VB Forum / General 2 / October 2004

Option Explicit
Private Declare Function CreateFontIndirect Lib "gdi32" Alias _
"CreateFontIndirectA" (lpLogFont As LOGFONT_TYPE) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc _
As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal _
hObject As Long) As Long
Private Const LF_FACESIZE = 32
Private Type LOGFONT_TYPE
 lfHeight As Long
 lfWidth As Long
 lfEscapement As Long
 lfOrientation As Long
 lfWeight As Long
 lfItalic As Byte
 lfUnderline As Byte
 lfStrikeOut As Byte
 lfCharSet As Byte
 lfOutPrecision As Byte
 lfClipPrecision As Byte
 lfQuality As Byte
 lfPitchAndFamily As Byte
 lfFaceName As String * LF_FACESIZE
End Type

Private Sub Command1_Click()
Dim font As LOGFONT_TYPE
Dim prevFont As Long, hFont As Long, ret As Long
font.lfEscapement = 900 ' tenths of a degree
font.lfFaceName = "Arial" + Chr$(0)
' Windows expects the font size to be in pixels and to
' be negative if you are specifying the character height
' you want. The following sets 12 point text.
font.lfHeight = (12 * -20) / Screen.TwipsPerPixelY
hFont = CreateFontIndirect(font)
prevFont = SelectObject(Me.hdc, hFont)
Me.ScaleMode = vbInches
Me.CurrentX = 1
Me.CurrentY = 2
Me.Print "Rotated Text"
' Clean up by restoring original font.
ret = SelectObject(Me.hdc, prevFont)
ret = DeleteObject(hFont)
End Sub