|
|
|
| Title | Draw stretched, squeezed, and rotated text |
|---|
| Description | This 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. |
|---|
| Keywords | font, text, CreateFont, stretch, squeeze, rotate, stretched, squeezed, rotated |
|---|
| Categories | Graphics, 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
|
| |
|
| |
|
|
