Draw Rotated Text Directly On Screen

'Add 1 Text Box and 1 Command Button to your form.
'Insert the following code to your form:

Option Explicit
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
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 Const TRANSPARENT = 1
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, _
ByVal nBkMode As Long) As Long
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc As Long, _
ByVal crColor As Long)
Private Declare Function SelectObject& Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long)
Private Declare Function CreateFontIndirect& Lib "gdi32" Alias _
"CreateFontIndirectA" (lpLogFont As LOGFONT)
Const LF_FACESIZE = 32
Const OUT_DEFAULT_PRECIS = 0
Const DEFAULT_QUALITY = 0
Const DEFAULT_PITCH = 0
Const DEFAULT_CHARSET = 1
Const FF_DONTCARE = 0

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(LF_FACESIZE) As Byte
End Type

Private Sub Command1_Click()
Dim ldc As Long
ldc = GetDC(0)
DrawWithFont ldc, Text1.Text
End Sub

Private Sub DrawWithFont(ldc As Long, sMessage As String)
Dim FontToUse As Long
Dim lf As LOGFONT
Dim oldhdc&
Dim TempByteArray() As Byte
Dim dl&, x%
Dim ByteArrayLimit&
'Put here the height of the text
lf.lfHeight = 90
'Put here the width of the text
lf.lfWidth = 90
'Put here rotation angle
lf.lfEscapement = 600
'Put here the thickness of the text
lf.lfWeight = 400
lf.lfOutPrecision = OUT_DEFAULT_PRECIS
lf.lfClipPrecision = OUT_DEFAULT_PRECIS
lf.lfQuality = DEFAULT_QUALITY
lf.lfPitchAndFamily = DEFAULT_PITCH Or FF_DONTCARE
lf.lfCharSet = DEFAULT_CHARSET
'Replace 'Arial' with the Font you want to use.
TempByteArray = StrConv("Arial" & Chr$(0), vbFromUnicode)
ByteArrayLimit = UBound(TempByteArray)
For x% = 0 To ByteArrayLimit
lf.lfFaceName(x%) = TempByteArray(x%)
Next x%
FontToUse = CreateFontIndirect(lf)
If FontToUse = 0 Then Exit Sub
oldhdc = SelectObject(ldc, FontToUse)
'Replace 'vbRed' with your desirable text color
SetTextColor ldc, vbRed
SetBkMode ldc, TRANSPARENT
TextOut ldc, 300, 600, sMessage, Len(sMessage)
oldhdc = SelectObject(ldc, FontToUse)
SelectObject ldc, oldhdc
End Sub