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
