' Draw the text at the correct angle.
Private Sub DrawValue(ByVal txt As String)
Const FW_BOLD = 700
Const FW_NORMAL = 400
Dim wgt As Long
Dim X As Single
Dim Y As Single
' Clear the control.
Cls
' See whether the text should be bold.
If m_Font.Bold Then
wgt = FW_BOLD
Else
wgt = FW_NORMAL
End If
' Estimate where the text should begin. My book
' "Visual Basic Graphics Programming" shows how to
' calculate this exactly but it's work so we won't
' do it here. For more information, go to:
'
' http://www.vb-helper.com/vbgp.htm
'
' This only works for 0 <= Angle <= 90.
X = 0
Y = ScaleY(Height, vbTwips, ScaleMode) - _
ScaleY(m_Font.Size, vbPoints, ScaleMode)
' Draw the text.
DrawRotatedText txt, X, Y, m_Font.Name, _
ScaleX(m_Font.Size, vbPoints, vbPixels), _
wgt, Angle * 10, _
m_Font.Italic, m_Font.Underline, _
m_Font.Strikethrough
End Sub
' Draw the text.
Private Sub DrawRotatedText(ByVal txt As String, _
ByVal X As Single, ByVal Y As Single, _
ByVal font_name As String, ByVal Size As Long, _
ByVal weight As Long, ByVal escapement As Long, _
ByVal use_italic As Boolean, ByVal use_underline As _
Boolean, _
ByVal use_strikethrough As Boolean)
Const CLIP_LH_ANGLES = 16 ' Needed for tilted fonts.
Const PI = 3.14159625
Const PI_180 = PI / 180#
Dim newfont As Long
Dim oldfont As Long
Dim hRgn As Long
picMask.Move 0, 0, ScaleWidth, ScaleHeight
picMask.Font = m_Font
picMask.Cls
newfont = CreateFont(Size, 0, _
escapement, escapement, weight, _
use_italic, use_underline, _
use_strikethrough, 0, 0, _
CLIP_LH_ANGLES, 0, 0, font_name)
' Select the new font.
oldfont = SelectObject(picMask.hdc, newfont)
' Draw the text on picMask.
picMask.CurrentX = X
picMask.CurrentY = Y
picMask.Print txt
' Restore the original font.
newfont = SelectObject(picMask.hdc, oldfont)
' Free font resources (important!)
DeleteObject newfont
' Make the control use picMask as a mask picture.
UserControl.MaskPicture = picMask.Image
End Sub
|