Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
 
MSDN Visual Basic Community
 
 
 
 
TitleDraw stretched, squeezed, and rotated text
DescriptionThis example shows how to draw stretched, squeezed, and rotated text in Visual Basic 6. It uses the CreateFont API function to create the desired font.
Keywordsfont, text, CreateFont, stretch, squeeze, rotate, stretched, squeezed, rotated
CategoriesGraphics, API
 
When the form loads, it calls subroutine DrawRotatedText to draw text with various heights, widths, and angles of rotation.
 
Private Sub Form_Load()
Const PI = 3.14159625
Const FW_NORMAL = 400   ' Normal font weight.

Dim I As Long
Dim cx As Long
Dim cy As Long

    AutoRedraw = True

    DrawRotatedText "Stretched", 10, 10, 10, 20, _
        "Times New Roman", FW_NORMAL, 3600, False, _
        False, False
    DrawRotatedText "Stretched", 10, 20, 10, 30, _
        "Times New Roman", FW_NORMAL, 3600, False, _
        False, False
    DrawRotatedText "Stretched", 10, 30, 10, 40, _
        "Times New Roman", FW_NORMAL, 3600, False, _
        False, False
    DrawRotatedText "Squeezed", 30, 10, 10, 50, _
        "Times New Roman", FW_NORMAL, 3600, False, _
        False, False
    DrawRotatedText "Squeezed", 30, 5, 10, 70, _
        "Times New Roman", FW_NORMAL, 3600, False, _
        False, False
    DrawRotatedText "Squeezed", 30, 3, 10, 90, _
        "Times New Roman", FW_NORMAL, 3600, False, _
        False, False

    cx = ScaleWidth - 20
    cy = ScaleHeight - 20
    For I = 90 To 180 Step 20
        DrawRotatedText "     Some Rotated Text", 20, 0, _
            cx + Cos(I / 180 * PI), _
            cy + Sin(I / 180 * PI), _
            "Times New Roman", FW_NORMAL, I * 10, _
            False, False, False
    Next I
End Sub
 
Subroutine DrawRotatedText uses the CreateFont API function to make the desired font. It uses SelectFont to install the font on the form, draws the text, uninstalls the font, and uses DeleteObject to free the font's resources.
 
Private Sub DrawRotatedText(ByVal txt As String, _
    ByVal hgt As Long, ByVal wid As Long, _
    ByVal X As Single, ByVal Y As Single, _
    ByVal font_name As String, _
    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

    newfont = CreateFont(hgt, wid, _
        escapement, escapement, weight, _
        use_italic, use_underline, _
        use_strikethrough, 0, 0, _
        CLIP_LH_ANGLES, 0, 0, font_name)
    
    ' Select the new font.
    oldfont = SelectObject(hdc, newfont)
    
    ' Display the text.
    CurrentX = X
    CurrentY = Y
    Print txt

    ' Restore the original font.
    newfont = SelectObject(hdc, oldfont)
    
    ' Free font resources (important!)
    DeleteObject newfont
End Sub
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated