home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / Ulli's_Cod2109154112008.psc / cMP.cls < prev    next >
Text File  |  2008-04-11  |  3KB  |  107 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cMP"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. DefLng A-Z 'we're 32 bits
  16.  
  17. 'Mousepointer Class
  18. 'One advantage of using this wrapper is that it will automatically reset the mousepointer
  19. 'on terminate (whatever caused the termination)
  20.  
  21. Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
  22. Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
  23. Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
  24.  
  25. Public Enum CursorName
  26.  
  27.     MpNone = 0
  28.  
  29.     'standard
  30.     Arrow = 32512
  31.     TextPos = 32513
  32.     Sand = 32514
  33.     CrossHair = 32615
  34.     ArrowUp = 32616
  35.     Pen = 32631
  36.     SquareIcon = 32641
  37.     SizeNWSE = 32642
  38.     SizeNESW = 32643
  39.     SizeWE = 32644
  40.     SizeNS = 32645
  41.     SizeNSWE = 32646
  42.     NoDrop = 32648
  43.     RightHand = 32649
  44.     ArrowSand = 32650
  45.     ArrowQuestion = 32651
  46.  
  47.     'wheel mouse
  48.     NorthDotSouth = 32652
  49.     WestDotEast = 32653
  50.     NSDotWE = 32654
  51.     NorthDot = 32655
  52.     SouthDot = 32656
  53.     WestDot = 32657
  54.     EastDot = 32658
  55.     NorthWestDot = 32659
  56.     NorthEastDot = 32660
  57.     SouthWestDot = 32661
  58.     SouthEastDot = 32662
  59.  
  60.     'special
  61.     ArrowCD = 32663
  62.  
  63.     'probably there are more....
  64.  
  65. End Enum
  66. #If False Then 'Spoof to preserve Enum capitalization
  67. Private MpNone, Arrow, TextPos, Sand, CrossHair, ArrowUp, Pen, SquareIcon, SizeNWSE, SizeNESW, SizeWE, SizeNS, SizeNSWE, NoDrop, RightHand, ArrowSand, ArrowQuestion, NorthDotSouth, WestDotEast, NSDotWE, NorthDot, SouthDot, WestDot, EastDot, NorthWestDot, NorthEastDot, SouthWestDot, SouthEastDot, ArrowCD
  68. #End If
  69.  
  70. Private Sub Class_Terminate()
  71.  
  72.     Do
  73.     Loop Until ShowCursor(True) >= 0
  74.     'default property
  75.     SetPointerIcon Arrow
  76.     Screen.MousePointer = vbNormal
  77.  
  78. End Sub
  79.  
  80. Public Property Let MP(Pointer As MousePointerConstants)
  81.  
  82.     Screen.MousePointer = Pointer
  83.  
  84. End Property
  85.  
  86. Public Property Get MP() As MousePointerConstants
  87. Attribute MP.VB_UserMemId = 0
  88.  
  89.     MP = Screen.MousePointer
  90.  
  91. End Property
  92.  
  93. Public Sub SetPointerIcon(Icon As CursorName)
  94.  
  95.     If IsWindowsSuitable Then
  96.         'prevent discrimination of left handed people
  97.         'we have no LeftHand resource so we just leave the cursor as it is
  98.         If Icon <> RightHand Or MouseButtonsSwapped = False Then
  99.             SetCursor LoadCursor(0, Icon)
  100.         End If
  101.     End If
  102.  
  103. End Sub
  104.  
  105. ':) Ulli's VB Code Formatter V2.24.11 (2008-Apr-11 10:26)  Decl: 55  Code: 37  Total: 92 Lines
  106. ':) CommentOnly: 12 (13%)  Commented: 2 (2,2%)  Filled: 70 (76,1%)  Empty: 22 (23,9%)  Max Logic Depth: 3
  107.