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
iXSize = ScaleWidth / Screen.TwipsPerPixelX
iYSize = ScaleHeight / Screen.TwipsPerPixelY
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
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
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
bCaptured = False
ReleaseCapture
End If
End Sub
Private Sub Form_Paint()
Dim hPen As Long
Dim hPrevPen As Long
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
|