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