How to Make a Round (Circular) Form

Ever want a round form? This short VB6 code will create it for you. I know it works on XP and Win7. Not tested on Win8.

Open a new VB6 project
I added two shapes and one label to the form---not necessary, but looks pretty! :-)
I use a Double-Click to unload the form, but you can use any ctrl/code you desire.

Code:

---

Option Explicit
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Sub Form_DblClick()
  Unload Me
End Sub
Private Sub Form_Load()
    Dim lngRegion As Long
    Dim lngReturn As Long
    Dim lngFormWidth As Long
    Dim lngFormHeight As Long
    Me.Width = Me.Height
   
    lngFormWidth = Me.Width / Screen.TwipsPerPixelX
    lngFormHeight = Me.Height / Screen.TwipsPerPixelY
    lngRegion = CreateEllipticRgn(0, 0, lngFormWidth, lngFormHeight)
    lngReturn = SetWindowRgn(Me.hWnd, lngRegion, True)
    Shape1.Left = (Me.Width / 2) - (Shape1.Width / 2)
    Shape2.Left = (Me.Width / 2) - (Shape2.Width / 2)
    Shape1.Top = (Me.Height / 2) - (Shape1.Height / 2)
    Shape2.Top = (Me.Height / 2) - (Shape2.Height / 2)
    Label1.Top = (Me.Height / 2) - (Label1.Height / 2)
    Label1.Left = (Me.Width / 2) - (Label1.Width / 2)
End Sub
Private Sub Label1_Click()
  Unload frmRound
End Sub

---

Sorry---those two shapes were circles--to make the form look like a target---one red, one white, the form was red. The Label simply said (Double-Click to unload the form)....I shoulda included this information initially...sorry. BUt, to make the form itself, you can delete all references to the shapes and label and you will have a plain round form.

very cool but maby you can tell me why the text in the form when set to center horizontally and vertically doesnt endup in the middle?

Code:

---

Option Explicit
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Sub Form_DblClick()
  Unload Me
End Sub
Private Sub Form_Load()
    Dim lngRegion As Long
    Dim lngReturn As Long
    Dim lngFormWidth As Long
    Dim lngFormHeight As Long
    Me.Width = Me.Height
   
    lngFormWidth = Me.Width / Screen.TwipsPerPixelX
    lngFormHeight = Me.Height / Screen.TwipsPerPixelY
    lngRegion = CreateEllipticRgn(0, 0, lngFormWidth, lngFormHeight)
    lngReturn = SetWindowRgn(Me.hWnd, lngRegion, True)

End Sub
Private Sub Label1_Click()
  Unload frmRound
End Sub

---

Attachment 102969

Add these two lines (make the label Autosize as well)

Code:

---

Label1.Left = (Me.Width / 2) - (Label1.Width / 2)
Label1.Top = (Me.Height / 2) - (Label1.Height / 2)

---

Also, if you set the form borderstyle to NONE, it looks better, but you can't move it around.

Quote:

---

Originally Posted by SamOscarBrown

Add these two lines (make the label Autosize as well)

Code:

---

Label1.Left = (Me.Width / 2) - (Label1.Width / 2)
Label1.Top = (Me.Height / 2) - (Label1.Height / 2)

---

Also, if you set the form borderstyle to NONE, it looks better, but you can't move it around.

---

Sure you can. Just add this code

Code:

---

Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Const HTCAPTION = 2

Private Const WM_NCLBUTTONDOWN = &HA1

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 If Button = vbLeftButton Then
  ReleaseCapture
  SendMessage Form1.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
 End If
End Sub

---