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

Use the GetTextExtentPoint API function to see how big the text is. (This actually includes some empty space above the text called "internal leading" space. If you needed to know exactly where the text was, you could use the GetTextMetrics API function to see how big the internal leading space was. See my book Visual Basic Graphics Programming for more information on font dimensions.)

Make the form big enough to hold the text and center the form on the screen.

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.

Call BeginPath, write the text, and call EndPath to convert the text into a graphic path again. Then call StrokePath to draw the path. This produces the outlined text. Use a thick DrawWidth so the outline is wide because half of the outline's thickness will be cropped off by the call to SetWindowRgn.

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.

' Shape the form.
Private Sub ShapeForm()
Const TEXT1 = "RAD"
Const TEXT2 = "VB"
Const TEXT_HGT = 250
Const TEXT_WID = 100
Const FONT_NAME = "Times New Roman"
Const GAP = -80
Const DRAW_WIDTH = 5

Dim new_font As Long
Dim old_font As Long
Dim hRgn As Long
Dim sz As Size
Dim wid As Single
Dim hgt As Single
Dim pix_wid As Single
Dim pix_hgt As Single
Dim text1_wid As Single
Dim text1_hgt As Single
Dim text2_wid As Single
Dim text2_hgt As Single
Dim x1 As Long
Dim y1 As Long
Dim x2 As Long
Dim y2 As Long

    ' Prepare the form.
    AutoRedraw = True
    ScaleMode = vbPixels
    BorderStyle = vbBSNone
    BackColor = vbBlue
    ForeColor = vbBlack
    Caption = ""
    DrawWidth = DRAW_WIDTH
    ' ControlBox = False    ' Set at design time.
    ' MinButton = False     ' Set at design time.
    ' MaxButton = False     ' Set at design time.
    ' ShowInTaskbar = False ' Set at design time.

    ' Create the custom font.
    new_font = CustomFont(TEXT_HGT, TEXT_WID, 0, 0, _
        FW_BOLD, False, False, False, _
    old_font = SelectObject(hdc, new_font)

    ' Get the size of the first string.
    GetTextExtentPoint hdc, TEXT1, Len(TEXT1), sz
    text1_wid = sz.cx
    text1_hgt = sz.cy

    ' Get the size of the second string.
    GetTextExtentPoint hdc, TEXT2, Len(TEXT2), sz
    text2_wid = sz.cx
    text2_hgt = sz.cy

    ' Make the form big enough.
    If text1_wid > text2_wid Then
        wid = text1_wid
        wid = text2_wid
    End If
    hgt = text1_hgt + text2_hgt + GAP

    pix_wid = ScaleX(wid, vbPixels, vbTwips)
    pix_hgt = ScaleY(hgt, vbPixels, vbTwips)
    Move (Screen.Width - pix_wid) / 2, _
         (Screen.Height - pix_hgt) / 2, _
         pix_wid, pix_hgt

    ' Position the text.
    x1 = (wid - text1_wid) / 2
    y1 = 0
    x2 = (wid - text2_wid) / 2
    y2 = text1_hgt + GAP

    ' Make the region.
    BeginPath hdc
    CurrentX = x1
    CurrentY = y1
    Print TEXT1
    CurrentX = x2
    CurrentY = y2
    Print TEXT2
    EndPath hdc
    hRgn = PathToRegion(hdc)

    ' Constrain the form to the combined region.
    SetWindowRgn hWnd, hRgn, False

    ' Draw the text again with a hollow font.
    BeginPath hdc
    CurrentX = x1
    CurrentY = y1
    Print TEXT1
    CurrentX = x2
    CurrentY = y2
    Print TEXT2
    EndPath hdc
    StrokePath hdc

    ' Restore the original font.
    SelectObject hdc, old_font

    ' Free font resources (important!)
    DeleteObject new_font
End Sub
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.