You are not connected. Please login or register

View previous topic View next topic Go down  Message [Page 1 of 1]

1 VB Creating a circle shaped window on Tue Aug 24, 2010 3:50 am

Top


Contributor
Loading
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.
Code:
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

2 Re: VB Creating a circle shaped window on Tue Aug 24, 2010 2:50 pm

Syn


Spoiler
Loading
Nice.

View previous topic View next topic Back to top  Message [Page 1 of 1]

Related topics

Permissions in this forum:
You cannot reply to topics in this forum