ccursor.cls

大量优秀的vb编程

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

Public Property Get X() As Long

Dim tmpPoint As POINTAPI
Call GetCursorPos(tmpPoint)
X = tmpPoint.X

End Property

Public Property Let X(ByVal vNewValue As Long)

Call SetCursorPos(vNewValue, Y)

End Property

Public Property Get Y() As Long

Dim tmpPoint As POINTAPI
Call GetCursorPos(tmpPoint)
Y = tmpPoint.Y

End Property

Public Property Let Y(ByVal vNewValue As Long)

Call SetCursorPos(X, vNewValue)

End Property

Public Sub SnapTo(ctl As Control)

'Snaps the cursor to the center of
'a given control.

Dim pnt As POINTAPI
Dim xx As Long
Dim yy As Long

pnt.X = pnt.Y = 0
'Get Left-Top corner of control
Call ClientToScreen(ctl.hWnd, pnt)
xx = pnt.X + (ctl.Width \ 2)
yy = pnt.Y + (ctl.Height \ 2)
'xx = pnt.X + ctl.Width / (2 * (Screen.ActiveForm.Left + ctl.Left) / pnt.X)
'yy = pnt.Y + ctl.Height / (2 * (Screen.ActiveForm.Top + ctl.Top) / pnt.Y)
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

 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
 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



Public Property Get Visible() As Boolean

Visible = CurVisible

End Property

Public Property Let Visible(ByVal vNewValue As Boolean)

CurVisible = vNewValue
Call ShowCursor(CurVisible)

End Property