This program is taken form
It not exaclty what you need but very close
On the Form:
PictureBox Named picDest with AutoRedraw=true
ComboBox Named cmbFontName
TextBoxs Named txtText,txtDegree,txtFontSize
In txtDegree enter degrees for rotating, In txtText the text, In txtFontSize the font size
Try all kind of fonts, some of them don't work
The code:
Option Explicit
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 As String * LF_FACESIZE
End Type
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 Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Sub RotateFont(Dest As Object, Text As String, X As Single, Y As Single, degree As Integer, fontName As String, fontSize As Integer, iColor As Long)
Dim LFont As LOGFONT
Dim prevFont As Long, hFont As Long
With LFont
.lfEscapement = degree * 10 'L ÷áéòú æååéú äñéáåá
.lfFaceName = fontName & Chr$(0) 'L ÷áéòú äâåôï
.lfHeight = (fontSize * -20) / Screen.TwipsPerPixelY 'L ÷áéòú âåãì äâåôï
End With
hFont = CreateFontIndirect(LFont)
prevFont = SelectObject(Dest.hdc, hFont)
Dest.CurrentX = X
Dest.CurrentY = Y
Dest.ForeColor = iColor 'L öáò äâåôï
Dest.Print Text 'L äè÷ñè ìöéåø
' ðé÷åé äàåáéé÷è äðåöø îäæëøåï
SelectObject Dest.hdc, prevFont
DeleteObject hFont
End Sub
Private Sub Form_Load()
Dim i As Integer
For i = 1 To Screen.FontCount - 1
cmbFontName.AddItem Screen.Fonts(i)
Next
cmbFontName.ListIndex = 17
End Sub
Private Sub picDest_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
txtDegree.Text = CInt(txtDegree.Text)
If Err <> 0 Then txtDegree.Text = 90
On Error Resume Next
txtFontSize.Text = CInt(txtFontSize.Text)
If Err <> 0 Then txtFontSize.Text = 90
If CInt(txtFontSize.Text) > 100 Then txtFontSize.Text = 100
RotateFont picDest, _
txtText.Text, _
X, Y, _
CLng(txtDegree.Text), _
cmbFontName.Text, _
CInt(txtFontSize.Text), _
Me.ForeColor
End Sub