Public Enum eFormShapes

An enumerator with all the supported form shapes. Currently this class only supports one, eShapeElliptic.

Public FormObject As Form

This should be set to the form that you want to change the shape of. It must be set before any other methods or properties are used.

Public Property Let Shape(eShape As eFormShapes)

Public Sub CenterForm()

This is a bonus routine to center a form. Since we are changing the shape of a form, we thought a centering routine would be useful.

Public Sub Move(Button As Integer)

This source code will show how change the shape of a form into an ellipse. This code assumes you have created a new form and changed the BorderStyle property to 0.

Option Explicit

Dim moFormShaper As New cFormShaper

Private Sub cmdQuit_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Set moFormShaper.FormObject = Me      ' sets the form object to shape
    moFormShaper.Shape = eShapeElliptic   ' selects the shape to change the form into.
    moFormShaper.CenterForm      ' centers the form.
End Sub

' Allows movement of the form
Private Sub Form_Mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    moFormShaper.Move Button
End Sub

Just paste this code into any module and change the name of the module to cFormShaper.

'----------------------------------------------------------------------
'
'   Module Name:    cFormShaper
'   Written By:     C&D Programming Corp.
'   Create Date:    3/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'
'
'----------------------------------------------------------------------
Option Explicit

Private Declare Function CreateEllipticRgn& Lib "gdi32" (ByVal X1 As Long, _
                        ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)

Private Declare Function SetWindowRgn Lib "User32" (ByVal hWnd As Long, _
                        ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Declare Function SendMessage Lib "User32" _
            Alias "SendMessageA" (ByVal hWnd As Long, _
                                    ByVal wMsg As Long, _
                                    ByVal wParam As Long, _
                                    lParam As Any) As Long

Private Declare Sub ReleaseCapture Lib "User32" ()

Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2

Public Enum eFormShapes
    eShapeElliptic
    ' add additional shapes here.  Make sure to include the appropriate
    ' code in the Shape property
End Enum

Public FormObject As Form       ' You must set this property before using any
                                ' other routines.

'
'   This is where all the good shaping stuff happens.  You just set the
'   shape and the form is automatically shaped.
'
Public Property Let Shape(eShape As eFormShapes)
    Dim lRegion As Long
    Dim lResult As Long

    Select Case eShape
        Case eShapeElliptic
            ' fit the ellipse into the current form size.
            lRegion = CreateEllipticRgn(0, 0, FormObject.Width / Screen.TwipsPerPixelX, FormObject.Height / Screen.TwipsPerPixelY)
            ' set the window reigon
            lResult = SetWindowRgn(FormObject.hWnd, lRegion, True)
        '
        ' add other shapes here
    End Select

End Property

'
'   Bonus routine to center the form
'
Public Sub CenterForm()
    FormObject.Top = (Screen.Height - FormObject.Height) / 2
    FormObject.Left = (Screen.Width - FormObject.Width) / 2
End Sub

'
'   If you need the form to move when a user clicks on the form and drags, call this
'   routine from the Form_MouseDown event.
'
Public Sub Move(Button As Integer)
    Dim lReturnValue As Long

    If Button = vbKeyLButton Then ' look for left mouse button
        ' release move mouse capture
        Call ReleaseCapture
        ' fake windows out by making it think we just clicked on the caption bar and
        ' dragged to a new location.
        lReturnValue = SendMessage(FormObject.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If

End Sub