Friday, July 25, 2008

Creating a circle shaped window

Creating a circle shaped window

The following code snippet shows you how to create a circle shaped window, by using a few Win32 API calls. You can also drag the window on the screen by using the mouse. 

'The following code snippet creates a circle shaped window.
'Written by Nir Sofer
'Web site: http://nirsoft.mirrorz.com

Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
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 Ellipse Lib "gdi32" _
(ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreatePen Lib "gdi32" _
(ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long

Private Const PS_SOLID = 0

Private Type RECT
       Left As Long
       Top As Long
       Right As Long
       Bottom As Long
End Type

Private Type POINTAPI
       x As Long
       y As Long
End Type


Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long


Private Const SWP_NOZORDER = &H4
Private Const SWP_NOSIZE = &H1


Private iXSize          As Integer
Private iYSize          As Integer
Private ptStartCursor   As POINTAPI
Private rcStartPos      As RECT
Private bCaptured       As Boolean

Private Sub cmdExit_Click()
   End
End Sub

Private Sub Form_Load()
   Dim hRgn        As Long
  
   'Get the size of the form in pixels
   iXSize = ScaleWidth / Screen.TwipsPerPixelX
   iYSize = ScaleHeight / Screen.TwipsPerPixelY
  
   'Create the region with circle shape.
   hRgn = CreateEllipticRgn(0, 0, iXSize, iYSize)
  
   SetWindowRgn hwnd, hRgn, True
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
   If Button = 1 Then
       'Start window dragging
       bCaptured = True
       GetCursorPos ptStartCursor
       GetWindowRect hwnd, rcStartPos
       SetCapture hwnd
   End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
   Dim ptCurrentCursor         As POINTAPI
   Static bInEvent             As Boolean
  
  
   If bCaptured And Button = 1 And Not bInEvent Then
       bInEvent = True
       DoEvents
      
       'Drag the window to the right position
       GetCursorPos ptCurrentCursor
      
       SetWindowPos hwnd, 0, rcStartPos.Left + ptCurrentCursor.x - ptStartCursor.x, _
                    rcStartPos.Top + ptCurrentCursor.y - ptStartCursor.y, 0, 0, SWP_NOZORDER Or SWP_NOSIZE
       bInEvent = False
   End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   If Button = 1 And bCaptured Then
       'Stop window dragging
       bCaptured = False
       ReleaseCapture
   End If
End Sub

Private Sub Form_Paint()
   Dim hPen            As Long
   Dim hPrevPen        As Long
  
   'Draw a gray circle around the circle shaped window:
   hPen = CreatePen(PS_SOLID, 4, RGB(64, 64, 64))
   hPrevPen = SelectObject(hdc, hPen)
   Ellipse hdc, 0, 0, iXSize - 1, iYSize - 1
   SelectObject hdc, hPrevPen
   DeleteObject hPen
End Sub

Download this sample project
Posted by at
Labels:

No comments:

Post a Comment

Subscribe to: Post Comments (Atom)