La utilización del código es muy sencillo:
El siguiente código hay que copiarlo pegarlo en un módulo llamado “Cursor”.
Insertar cualquier etiqueta en un formulario. Y establecer las propiedades ForeColor en azul y FontUnderline en on.
Establecer en el evento MouseMove con el valor “=UseHand()”.
Create a module called “Cursor” and paste the code below into it.
Guardar establecer el formulario en modo vista. Al mover el curso alrededor de la etiqueta éste cambiará.
Cuando el cursor del ratón se mueve sobre el etiqueta éste cambia al tipo mano y cuando se mueve fuera de la etiqueta el cursor del ratón vuelve a su estado normal.
Option Compare Database
Option Explicit
‘ Control the look of the cursor
‘ Replacement for Screen.MousePointer function
‘
‘ CONSTANTS
‘ Standard cursor IDs
Public Enum SystemCursorID
IDC_arrow = 32512&
IDC_IBEAM = 32513&
IDC_WAIT = 32514&
IDC_CROSS = 32515&
IDC_UPARROW = 32516&
IDC_SIZE = 32640& ‘ OBSOLETE: use IDC_SIZEALL
IDC_ICON = 32641& ‘ OBSOLETE: use IDC_ARROW
IDC_SIZENWSE = 32642&
IDC_SIZENESW = 32643&
IDC_SIZEWE = 32644&
IDC_SIZENS = 32645&
IDC_SIZEALL = 32646&
IDC_NO = 32648& ‘ not in win3.1
IDC_HAND = 32649&
IDC_APPSTARTING = 32650& ‘ not in win3.1
IDC_HELP = 32651&
End Enum
‘
‘ TYPES
Private Type POINT ‘ declared here because a point is a rectangle of 1 unit width and eight
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
‘
‘ DECLARES
Private Declare Function LoadCursor Lib “user32″ Alias “LoadCursorA” ( _
ByVal hInstance As Long, _
ByVal pCursorName As Long) As Long
Private Declare Function ShowCursor Lib “user32″ ( _
ByVal bShow As Long) As Long
Private Declare Function SetCursorPos Lib “user32″ ( _
ByVal X As Long, _
ByVal Y As Long) As Long
Private Declare Function SetCursor Lib “user32″ ( _
ByVal hCursor As Long) As Long
Private Declare Function GetCursorPos Lib “user32″ ( _
lpPoint As POINT) As Long
Private Declare Function ClipCursor Lib “user32″ ( _
lpRect As Any) As Long
Private Declare Function GetCursor Lib “user32″ () As Long
Private Declare Function GetClipCursor Lib “user32″ ( _
lprc As RECT) As Long
‘
‘ GLOBALS
Dim hLastCursor As Long
”
”’ Changes cursors to a hand, normally used to indicate the item below the cursor
”’ is a link that can be followed.
”’
”’
”’ Example
”’ Call in the OnMouseMove Event (instead of calling an [Event Procedure]) of a label
”’ to change the cursor to a hand. Doing it this way seems to reset the cursor back to
”’ default when you move out of the control’s area. Miraculous!
”’
Public Function UseHand()
Cursor.UseSystemCursor IDC_HAND
End Function
‘ Sets the cursor to a system shape
‘
‘
Public Function UseSystemCursor(CursorID As SystemCursorID)
‘ Restore previous cursor before loading new one
RestoreCursor
‘ Load new cursor and, if successful, set
hLastCursor = LoadCursor(0, CLng(CursorID))
If (hLastCursor > 0) Then
hLastCursor = SetCursor(hLastCursor)
End If
End Function
‘ Undoes the last cursor change
‘
Public Sub RestoreCursor()
If hLastCursor > 0 Then
SetCursor hLastCursor
hLastCursor = 0
End If
End Sub
Fuente: misterslimm.wordpress.com
