ccursor.cls

一个模块,VB语言的,比较好用,我试过的

    
  '===============cCursor.cls===============   
  'Purpose:   To   provide   quick   and   easy   access   
  '                   to   cursor   functions.   
  '   
  'Functions/Subs/Properties:   
  '   --   X   (Get/Let):   Sets   cursor   X   position   
  '   --   Y   (Get/Let):   Sets   cursor   Y   position   
  '   --   SnapTo:   Puts   a   cursor   in   the   center   
  '                         of   a   control.   
  '   --   ClipTo:   Restricts   the   cursor   to   any   
  '                         square   area   of   movement.   
  '=========================================   
    
  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