Drawing a rotated text on a form

[XcodeX]

Private Const LF_FACESIZE = 32
 
Private Type LOGFONT
        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(1 To LF_FACESIZE) As Byte
End Type
 
Private Const OBJ_FONT = 6
 
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _
(ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, _
ByVal nCount As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" _
(lpLogFont As LOGFONT) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" _
(ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetCurrentObject Lib "gdi32" _
(ByVal hdc As Long, ByVal uObjectType As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" _
(ByVal hdc As Long, ByVal crColor As Long) 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
 
 
'Create rotated font handle.
Private Function GetFont(hdc As Long, Angle As Double) As Long
    Dim hFont           As Long
    Dim lf              As LOGFONT
    
    'Get the current HFONT handle
    hFont = GetCurrentObject(hdc, OBJ_FONT)
    'Retrieve the LOGFONT structure from the font handle.
    GetObject hFont, Len(lf), lf
    'Change the font angle
    lf.lfEscapement = CInt(Angle * 10)
    lf.lfOrientation = lf.lfEscapement
    'Create a new font
    GetFont = CreateFontIndirect(lf)
End Function
 
Private Sub DrawText(hdc As Long, Text As String, X As Integer, Y As Integer, _
Angle As Double, Color As Long)
    Dim hFont           As Long
    Dim hPrevFont       As Long
    
    SetTextColor hdc, Color
    'Create a font for the rotated text
    hFont = GetFont(hdc, Angle)
    'Select the font into the DC
    hPrevFont = SelectObject(hdc, hFont)
    'Draw the text
    TextOut hdc, X, Y, Text, Len(Text)
    'Select back the previous font
    SelectObject hdc, hPrevFont
    'destroy the font object.
    DeleteObject hFont
End Sub
 
Private Sub Form_Paint()
    Dim TextToDraw      As String
    Dim X               As Integer
    Dim Y               As Integer
    Dim Angle           As Double
    
    'We must use a TrueType font, otherwise the text won't be rotated.
    Font.Name = "Arial"
    Font.Bold = True
    Font.Size = 36
    TextToDraw = "http://www.vbforums.com/"
    
    X = 20: Y = 350
    'You can change the Angle value from 0 and up to 360 degrees in steps of 0.1 degrees.
    Angle = 45
    'Draw the text in 3 colors in order to create 3D effect.
    DrawText hdc, TextToDraw, X - 1, Y - 1, Angle, RGB(0, 0, 255)
    DrawText hdc, TextToDraw, X + 1, Y + 1, Angle, RGB(0, 0, 0)
    DrawText hdc, TextToDraw, X, Y, Angle, RGB(0, 0, 192)
End Sub