ccursor.cls

很好的教程原代码！

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cCursor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
DefLng A-Z

Private Type POINTAPI
        X As Long
        Y As Long
End Type

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

Private CurVisible As Boolean

Private Declare Function GetCursorPos Lib "user32" _
    (lpPoint As POINTAPI _
    ) As Long

Private Declare Function SetCursorPos Lib "user32" _
    (ByVal X As Long, _
    ByVal Y As Long _
    ) As Long

Private Declare Function ClientToScreen Lib "user32" _
    (ByVal hWnd As Long, _
    lpPoint As POINTAPI _
    ) As Long

Private Declare Function ClipCursor Lib "user32" _
    (lpRect As RECT _
    ) As Long

Private Declare Function ShowCursor Lib "user32" _
    (ByVal bShow As Long _
    ) As Long

'获取鼠标X
Public Property Get X() As Long
    Dim tmpPoint As POINTAPI
    Call GetCursorPos(tmpPoint)
    X = tmpPoint.X
End Property

'设置鼠标X
Public Property Let X(ByVal vNewValue As Long)
    Call SetCursorPos(vNewValue, Y)
End Property

'获取鼠标Y
Public Property Get Y() As Long
    Dim tmpPoint As POINTAPI
    Call GetCursorPos(tmpPoint)
    Y = tmpPoint.Y
End Property

'设置鼠标Y
Public Property Let Y(ByVal vNewValue As Long)
    Call SetCursorPos(X, vNewValue)
End Property

'将鼠标置于给定控件的中心
Public Sub SnapTo(ctl As Control)
    Dim pnt As POINTAPI
    Dim xx As Long
    Dim yy As Long
    '
    pnt.X = pnt.Y = 0
    Call ClientToScreen(ctl.hWnd, pnt)
    xx = pnt.X + (ctl.Width \ 2)
    yy = pnt.Y + (ctl.Height \ 2)
    Call SetCursorPos(xx, yy)
End Sub

'限制鼠标在某个方形区域
Public Sub ClipTo(ToCtl As Object)
    On Error Resume Next
    '
    Dim tmpRect As RECT
    Dim pt As POINTAPI
    '
    With ToCtl
        ' 如果ToCtl是窗体
        If TypeOf ToCtl Is Form Then
            tmpRect.Left = (.Left \ Screen.TwipsPerPixelX)
            tmpRect.Top = (.Top \ Screen.TwipsPerPixelY)
            tmpRect.Right = (.Left + .Width) \ Screen.TwipsPerPixelX
            tmpRect.Bottom = (.Top + .Height) \ Screen.TwipsPerPixelY
        ' 如果ToCtl是屏幕
        ElseIf TypeOf ToCtl Is Screen Then
            tmpRect.Left = 0
            tmpRect.Top = 0
            tmpRect.Right = (.Width \ Screen.TwipsPerPixelX)
            tmpRect.Bottom = (.Height \ Screen.TwipsPerPixelY)
        Else
            pt.X = 0
            pt.Y = 0
            Call ClientToScreen(.hWnd, pt)
            tmpRect.Left = pt.X
            tmpRect.Top = pt.Y
            pt.X = .Width
            pt.Y = .Height
            Call ClientToScreen(.hWnd, pt)
            tmpRect.Bottom = pt.Y
            tmpRect.Right = pt.X
        End If
        '
        Call ClipCursor(tmpRect)
    End With
End Sub

'类模块初始化
Private Sub Class_Initialize()
    CurVisible = True
End Sub

'获取鼠标Visible
Public Property Get Visible() As Boolean
    Visible = CurVisible
End Property

'设置鼠标Visible
Public Property Let Visible(ByVal vNewValue As Boolean)
    CurVisible = vNewValue
    Call ShowCursor(CurVisible)
End Property