What's New
Q & A
Tip Jar
C# Helper...
Follow VBHelper on Twitter
MSDN Visual Basic Community
TitleMake a text-shaped form
KeywordsCreateFont, SetWindowRgn, region, text-shaped form, shaped form
CategoriesGraphics, Controls, API
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 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 to the region.

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()

Dim new_font As Long
Dim old_font As Long
Dim hRgn As Long

    ' Prepare the form.
    ScaleMode = vbPixels
    BackColor = vbBlue
    'Me.ForeColor = vbBlack
    'Me.DrawWidth = 1

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

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

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

    ' Restore the original font.
    SelectObject hdc, old_font

    ' Free font resources (important!)
    DeleteObject new_font

    ' Draw text in the PictureBox.
    With Me.Font
        .Name = "Times New Roman"
        .Size = 8
        .Bold = False
    End With
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.