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
 
 
 
 
TitleMake a shaped form scroll across the desktop
DescriptionThis example shows how to make a shaped form scroll across the desktop in Visual Basic 6. The program uses API region functions to make a text-shaped form. It makes the form topmost and then uses a timer to move it across the screen.
Keywordsscroll, banner, shaped form, desktop, CreateFont, SetWindowRgn, region, text-shaped form, shaped form
CategoriesAPI, Graphics, Controls
 
The program uses 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 creating the font, the program installs it in the Form with the SelectObject API function.

It calls BeginPath, writes the text, and calls EndPath to convert the text into a graphic path. It then calls SetWindowRgn to restrict the Form to the region.

The program uses 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 = "VB Helper    www.vb-helper.com"

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

    ' Prepare the form.
    AutoRedraw = True
    BorderStyle = vbBSNone
    ScaleMode = vbPixels
    BackColor = vbBlue

    ' Make a big font.
    new_font = CustomFont(50, 0, 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 = 10
    Me.CurrentY = 10
    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
End Sub
 
The program's Timer moves the form slightly to the left. When the form has moved off the left edge of the screen, it starts over at the right.
 
Private Sub tmrMove_Timer()
    Me.Left = Me.Left - 120
    If Me.Left < -9000 Then Me.Left = Screen.Width
End Sub
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated