Argumentos

Argumento	Descripción
FileName	Requerido. Un valor de tipo cadena que contendrá la ruta y nombre del archivo de imagen que quiere mostrarse. El tipo de imagen deberá ser un icono (*.ico), cursor (*.cur) o cursor animado (*.ani).
Wait	Opcional. Este argumento indica el tiempo de espera durante el cual se quiere mostrar el puntero personalizado. Puede tomar los siguientes valores: - True (-1): Querrá decir que el puntero se mostrará indefinidamente. Puede usarse esta opción cuando el tiempo de espera sea indeterminado, pues se esté ejecutando un proceso o algo similar. Este tipo de puntero no responderá a ningún click del ratón. - Un número mayor de 0: Querrá decir que el puntero se mostrará durante los segundos que este argumento indique. Este tipo de puntero no responderá a ningún click del ratón. - False (0) (predeterminado): Querrá decir que el puntero se mostrará indefinidamente hasta que el usuario haga click o presione alguna tecla relacionada con eventos del ratón (espaciador). En los dos primeros casos, se necesitará llamar a la función RestorePointer para restaurar el puntero del ratón al predeterminado.

' cargamos el puntero representado por "icono.ico" 
' durante un tiempo indefinido
Call fMousePointer("c:\icono.ico", True)

' ...
' aquí se ejecuta algún proceso que pueda llevar
' un cierto tiempo
' ....

' restauramos el puntero predeterminado 
 Call RestorePointer

' cargamos el puntero representado por "icono.ico" 
' durante un tiempo de 5 segundos
Call fMousePointer("c:\icono.ico", 5)

' no necesitamos llamar a RestorePointer pues
' el temporizador TimerProc se encargará de 
' restaurar el puntero predeterminado cuando se
' cumpla el tiempo de espera

' cargamos el puntero representado por "icono.ico" 
' durante un tiempo indefinido, mientras el 
' usuario haga click o presione el espaciador
Call fMousePointer("c:\icono.ico")

' no necesitamos llamar a RestorePointer pues
' el usuario o el temporizador TimerProc se encargarán 
' de  restaurar el puntero predeterminado

'---------------------------------------------------------
' fMousePointer
'
' Código escrito originalmente por Juan M Afán de Ribera.
' Estás autorizado a utilizarlo dentro de una aplicación
' siempre que esta nota de autor permanezca inalterada.
' En el caso de querer publicarlo en una página Web,
' por favor, contactar con el autor en
'
'     accessvba@ya.com
'
' Este código se brinda por cortesía de
' Juan M. Afán de Ribera
'
'---------------------------------------------------------

' función que devuelve el número de milisegundos desde
' que se inició el sistema
Private Declare Function GetTickCount Lib "kernel32" () As Long

' función que crea un Timer de sistema
Private Declare Function SetTimer Lib "user32" _
                (ByVal hWnd As Long, _
                ByVal nIDEvent As Long, _
                ByVal uElapse As Long, _
                ByVal lpTimerFunc As Long) As Long
                
' función que destruye un timer de sistema
Private Declare Function KillTimer Lib "user32" _
                (ByVal hWnd As Long, _
                ByVal nIDEvent As Long) As Long
                
' función que captura el ratón y teclado para una ventana
Private Declare Function SetCapture Lib "user32" _
                (ByVal hWnd As Long) As Long
       
' función que libera el ratón de la captura de una ventana
Private Declare Function ReleaseCapture Lib "user32" () As Long

' función que carga un cursor o icono desde un archivo
Private Declare Function LoadCursorFromFile Lib "user32" _
                Alias "LoadCursorFromFileA" _
                (ByVal lpFileName As String) As Long

' función que devuelve el handle del cursor actual
Private Declare Function GetCursor Lib "user32" () As Long

' función que establece un cursor
Private Declare Function SetCursor Lib "user32" _
                (ByVal hCursor As Long) As Long

' función que destruye un cursor
Private Declare Function DestroyCursor Lib "user32" _
                (ByVal hCursor As Long) As Long

' la función GetTickCount nunca devolverá una
' cifra mayor que ésta (49.7 días)
Private Const TIMELIMIT = 4294080000#
' variables privadas
Private hOldCursor As Long
Private hCursor As Long
' variable que guardará el tiempo de espera
Private Pause As Double
' variable que guarda el handle de la ventana
' asociada al cursor
Private hWnd As Long

' función que carga un cursor personalizado en el puntero
' del ratón
Function fMousePointer(FileName As String, Optional Wait As Long)
Static OldFileName As String

    ' si el nombre de archivo ya existe
    If FileName = OldFileName Then
        ' y existe un cursor personalizado
        If hCursor Then
            ' el puntero ya está en uso,
            ' así que no hacemos nada
            Exit Function
        End If
    ' si el tiempo de espera no es válido
    ElseIf Wait < -1 Then
        Exit Function
    End If
    
    ' si wait vale algo, se ha solicitado un puntero
    ' con un tiempo de espera
    If Wait <> 0 Then
        ' obtenemos el handle de la ventana de Access
        hWnd = Access.hWndAccessApp
        ' si hay un tiempo de espera determinado
        If Wait > 0 Then
            ' establecemos el tiempo de espera
            Pause = GetTickCount + (Wait * 1000)
        Else
            ' si no, querrá decir que Wait = -1 (True)
            ' que significa tiempo de espera indefinido
            Pause = TIMELIMIT
        End If
    Else ' si no se ha solicitado un puntero de espera
        ' hacemos que el temporizador no pueda resetear
        ' el puntero por cuestión de tiempo
        Pause = TIMELIMIT
        ' obtenemos el handle del formulario activo
        hWnd = Screen.ActiveForm.hWnd
    End If
    
    ' cargamos el puntero del archivo solicitado
    hCursor = LoadCursorFromFile(FileName)
    ' si hemos tenido éxito
    If hCursor Then
        ' colocamos la captura del ratón en la
        ' ventana del formulario o de Access,
        ' según se necesite
        Call SetCapture(hWnd)
        ' cambiamos el cursor del ratón
        hOldCursor = SetCursor(hCursor)
        ' lanzamos un timer que controlará el cursor
        Call SetTimer(hWnd, 0&, 100, AddressOf TimerProc)
    End If
    ' guardamos el nombre del archivo
    OldFileName = FileName
    
End Function

' función que destruye un cursor personalizado
' y carga el cursor por defecto
Function RestorePointer()

    ' si el cursor por defecto no está en uso
    If hOldCursor Then
        ' liberamos el ratón
        Call ReleaseCapture
        ' y volvemos a poner el cursor por defecto
        Call SetCursor(0&)
        ' liberamos el cursor personalizado
        Call DestroyCursor(hCursor)
        ' reinicializamos variables
        hCursor = 0
        hOldCursor = 0
        Pause = 0
    End If
    
End Function

' temporizador que controla el tiempo de
' espera de un cursor o bien el que algún
' evento provocado por el usuario haya
' restaurado el cursor por defecto. En ambos
' casos, se llamará a la función RestorePointer
' para liberar memoria
Private Sub TimerProc(ByVal hWnd As Long, _
                      ByVal uMsg As Long, _
                      ByVal idEvent As Long, _
                      ByVal dwTime As Long)
    
    ' si el cursor personalizado ya no es el
    ' cursor activo, o el tiempo de espera
    ' ha finalizado
    If hCursor <> GetCursor Or _
        GetTickCount >= Pause Then
            ' destruimos el cursor
            Call RestorePointer
            ' y paramos el timer
            Call KillTimer(hWnd, 0&)
    End If

End Sub

Ejemplos:

cursores

Temas relacionados: