Home
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
 
 
Old Pages
 
Old Index
Site Map
What's New
 
Books
How To
Tips & Tricks
Tutorials
Stories
Performance
Essays
Links
Q & A
New in VB6
Free Stuff
Pictures
 
 
 
 
 
 
 
TitleMake an ActiveX rotated label control with transparent background
KeywordsActiveX, rotated text, label, transparent background
CategoriesGraphics
 
Place a PictureBox named picMask on the control.

At design time, set:

    PropertyValue
    UserControl.MaskColorBlack
    UserControl.BackStyleTransparent
    picMask.VisibleFalse
    picMask.BackColorBlack
    picMask.ForeColorRed
    picMask.AutoRedrawTrue

When we need to display text, draw it rotated on picMask. Then set the control's MaskPicture property to picMask's image. The system clips off the part of the control corresponding to places on picMask that have the MaskPicture color.

The following routines draw the rotated text and set MaskPicture.

Note that rotated text works only with True Type fonts such as Times New Roman and Courier New.

 
' 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
 
[Note that my book Custom Controls Library shows how to make a couple kinds of rotated controls.]
 
 
Copyright © 1997-2001 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated