cursor.bas

大家好,今天我来为大家用VB制作一个个人版的挂机锁.

Attribute VB_Name = "Cursor"

Option Explicit '限制鼠标
Private Type RECT
   left As Long
   top As Long
   right As Long
   bottom As Long
End Type

Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Const SM_CYCAPTION = 4
Private Const SM_CXFRAME = 32
Private Const SM_CYFRAME = 33

Public Sub Release()
   Call ClipCursor(ByVal vbNullString)
End Sub

Public Sub RestrictToControl(cntl As Control)
   Dim r As RECT
   On Error Resume Next
   Call GetWindowRect((cntl.hwnd), r)
   If Err.Number = 0 Then
      Call Cursor.RestrictToRect(r)
   End If
End Sub

Public Sub CenterOnControl(cntl As Control)
   Dim r As RECT
   On Error Resume Next
   Call GetWindowRect((cntl.hwnd), r)
   If Err.Number = 0 Then
      Cursor.CenterOnRect r
   End If
End Sub

Public Sub RestrictToForm(frm As Form)
   Dim r As RECT
   Call GetClientScrnRect(frm, r)
   Call Cursor.RestrictToRect(r)
End Sub

Public Sub CenterOnForm(frm As Form)
   Dim r As RECT
   Call GetClientScrnRect(frm, r)
   Call Cursor.CenterOnRect(r)
End Sub

Private Sub RestrictToRect(lpRect As RECT)
   Call ClipCursor(lpRect)
End Sub

Private Sub CenterOnRect(lpRect As RECT)
   Call SetCursorPos(lpRect.left + (lpRect.right - lpRect.left) \ 2, _
                     lpRect.top + (lpRect.bottom - lpRect.top) \ 2)
End Sub

Private Sub GetClientScrnRect(frm As Form, rC As RECT)
   Dim x As Integer
   Dim y As Integer
   Call GetWindowRect((frm.hwnd), rC)
   x = GetSystemMetrics(SM_CXFRAME)
   y = GetSystemMetrics(SM_CYFRAME)
   rC.left = rC.left + x
   rC.right = rC.right - x
   rC.top = rC.top + y + GetSystemMetrics(SM_CYCAPTION)
   rC.bottom = rC.bottom - y
End Sub