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 text filled with a color gradient
Keywordsfilled text, outline text, text, gradient text, CreateFont, SetWindowRgn, region
CategoriesGraphics
 
Use the CreateFont API function to make the desired font. Be sure to use a TrueType font. The CustomFont function make this a little easier.
 
' Make a customized font and return its handle.
Private Function CustomFont(ByVal hgt As Long, ByVal wid As _
    Long, ByVal escapement As Long, ByVal orientation As _
    Long, ByVal wgt As Long, ByVal is_italic As Long, ByVal _
    is_underscored As Long, ByVal is_striken_out As Long, _
    ByVal face As String) As Long
Const CLIP_LH_ANGLES = 16   ' Needed for tilted fonts.

    CustomFont = CreateFont( _
        hgt, wid, escapement, orientation, wgt, _
        is_italic, is_underscored, is_striken_out, _
        0, 0, CLIP_LH_ANGLES, 0, 0, face)
End Function
 
After you create the font, install it in the Form or PictureBox where you want to draw with the SelectObject API function.

Call BeginPath, write the text, and call EndPath to convert the text into a graphic path. Then call SetWindowRgn to restrict the Form/PictureBox to the region. Now anything you draw will be clipped to fit the region. Draw the color gradient through the text by drawing a series of lines one pixel apart with slightly different colors.

Use SelectObject to restore the original font and DeleteObject to delete the new font, freeing up its graphic resources. This is impoertant. If you don't do this, the system may run out of resources.

 
Private Sub ShapePicture()
Const TEXT1 = "FLOWERS"

Dim new_font As Long
Dim old_font As Long
Dim hRgn As Long
Dim Y As Single
Dim g As Single
Dim dg As Single

    ' Prepare the PictureBox.
    ScaleMode = vbPixels
    Picture1.AutoRedraw = True
    Picture1.ScaleMode = vbPixels
    Picture1.BorderStyle = vbBSNone
    Picture1.BackColor = vbBlue
    Picture1.ForeColor = vbBlack
    Picture1.DrawWidth = 1

    ' Make a big font.
    new_font = CustomFont(250, 65, 0, 0, _
        FW_BOLD, False, False, False, _
        "Times New Roman")
    old_font = SelectObject(Picture1.hdc, new_font)

    ' Make the region.
    SelectObject Picture1.hdc, new_font
    BeginPath Picture1.hdc
    Picture1.CurrentX = (ScaleWidth - _
        Picture1.TextWidth(TEXT1)) / 2
    Picture1.CurrentY = -40
    Picture1.Print TEXT1
    EndPath Picture1.hdc
    hRgn = PathToRegion(Picture1.hdc)

    ' Constrain the PictureBox to the region.
    SetWindowRgn Picture1.hWnd, hRgn, False

    ' Restore the original font.
    SelectObject hdc, old_font

    ' Free font resources (important!)
    DeleteObject new_font

    ' Draw lines through the PictureBox.
    dg = -255 / Picture1.ScaleHeight
    g = 255
    For Y = 0 To Picture1.ScaleHeight
        Picture1.Line (0, Y)-Step(Picture1.ScaleWidth, 0), _
            RGB(0, g, 0)
        g = g + dg
    Next Y
End Sub
 
Click here to compare this code to the version used for VB .NET.
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated