** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - Timer por código. Adaptar a Access 64 bits
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoTimer por código. Adaptar a Access 64 bits

 Responder Responder
Autor
Mensaje
vantorro Ver desplegable
Nuevo
Nuevo
Avatar

Unido: 18/Octubre/2017
Localización: Lejos
Estado: Sin conexión
Puntos: 12
Enlace directo a este mensaje Tema: Timer por código. Adaptar a Access 64 bits
    Enviado: 18/Octubre/2017 a las 15:18
Buenas tardes,

Estoy intentando adaptar un código que crea timers por código. 
Aparentemente, en Access de 32 bits no tiene ningún problema, se puede lanzar, parar, volver a lanzar y parece que la aplicación es estable.

Este código lo utilizé para hacer pruebas con varios carruseles de imágenes usando varios timers, sin depender del timer del propio formulario, en un mismo formulario, y lo pude hacer sin problemas.

El caso es que no consigo adaptarlo para usarlo en Access 64 bits. Puedo lanzar el timer, pero ya no lo puedo parar, y cuando cierro el form, provoca un error irrecuperable de Access. Todo apunta a una gestión de la memoria / punteros incorrecta.

Este código va en dos partes, una,en un módulo llamado Timers y otra en un módulo de clase llamado clsTimer.

Saludos
Xavier

---------------------------------------
Módulo llamado Timers
---------------------------------------
Public Sub TimerProc(ByVal hWnd As Long, _
                     ByVal uMsg As Long, _
                     ByVal oTimer As clsTimer, _
                     ByVal dwTime As Long)
   ' Alert appropriate timer object instance.
   If Not oTimer Is Nothing Then
        oTimer.RaiseTimerEvent
        Debug.Print "evento timer"
   End If
End Sub
---------------------------------------

---------------------------------------
Módulo de clase llamado clsTimer
---------------------------------------
Option Compare Database
Option Explicit

'Windows API Function Declarations
#If Win64 = 1 And VBA7 = 1 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" ( _
        ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
        ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As Long
    
    Private Declare PtrSafe Function KillTimer Lib "user32" ( _
        ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
    Private Declare Function SetTimer Lib "user32" ( _
        ByVal hWnd As Long, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    
    Private Declare Function KillTimer Lib "user32" ( _
        ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#End If

Public Event OnTimer()

Private TimerID As Long

'Start timer
Public Sub Startit(IntervalMs As Long)
    TimerID = SetTimer(Application.hWndAccessApp, ObjPtr(Me), IntervalMs, AddressOf Timers.TimerProc)
End Sub

'Stop timer
Public Sub Stopit()
    If TimerID <> -1 Then
        KillTimer Application.hWndAccessApp, TimerID
        TimerID = 0
    End If
End Sub

'Trigger Public event
Public Sub RaiseTimerEvent()
    RaiseEvent OnTimer
End Sub
---------------------------------------

---------------------------------------
Ejemplo simple en un formulario con 2 botones cmdStartTimer y cmdStopTimer:
---------------------------------------
Option Compare Database
Option Explicit

Public WithEvents oTimer1 As clsTimer

'Start the timer
Private Sub StartMyTimer()
    If oTimer1 Is Nothing Then Set oTimer1 = New clsTimer
    oTimer1.Startit 1000
End Sub

Private Sub cmdStartTimer_Click()
    StartMyTimer
    Debug.Print "Start Timer " & Now
End Sub

Private Sub cmdStopTimer_Click()
    If Not oTimer1 Is Nothing Then
        oTimer1.Stopit
        Debug.Print "Stop Timer " & Now
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Not oTimer1 Is Nothing Then
        oTimer1.Stopit
        Set oTimer1 = Nothing
    End If
End Sub

'Using the timer event from the timer
Private Sub oTimer1_OnTimer()
    Debug.Print "Timer Event " & Now
End Sub
---------------------------------------

-------------------
10 'No code no pain
-------------------
Arriba
emiliove Ver desplegable
Moderador
Moderador


Unido: 16/Junio/2009
Localización: Mexico
Estado: Sin conexión
Puntos: 4991
Enlace directo a este mensaje Enviado: 18/Octubre/2017 a las 16:00
No será que no usas bien cuando es 64 bits. por ejemplo tienes:

Public Sub TimerProc(ByVal hWnd As Long, _
                     ByVal uMsg As Long, _
                     ByVal oTimer As clsTimer, _
                     ByVal dwTime As Long)

Y debe ser:
Public Sub TimerProc(ByVal hwnd As LongPtr, _
                         ByVal wMsg As LongLong, _
                         ByVal idEvent As LongPtr, _
                         ByVal dwTime As LongLong)

Y así en las demás:
Private Declare PtrSafe Function SetTimer Lib "user32" _
                                    (ByVal hwnd As LongPtr, _
                                     ByVal nIDEvent As LongPtr, _
                                     ByVal uElapse As LongLong, _
                                     ByVal lpTimerFunc As LongPtr _
                                     ) As LongLong

Public Declare PtrSafe Function KillTimer Lib "user32" _
                                    (ByVal hwnd As LongPtr, _
                                     ByVal nIDEvent As LongPtr _
                                     ) As LongLong

En mis funciones favoritas el Buho escribió sobre el tema y puso un visor que te escribe casi todas las Apis en 64 bits.

Saludos.

Arriba
vantorro Ver desplegable
Nuevo
Nuevo
Avatar

Unido: 18/Octubre/2017
Localización: Lejos
Estado: Sin conexión
Puntos: 12
Enlace directo a este mensaje Enviado: 18/Octubre/2017 a las 17:06
Muchas gracias por tu respuesta,
me ha ayudado a solicionar el problema pero sigo un poco liado con los tipos de datos, me explico,
estuve leyendo sobre las conversiones a 64 bits en VBA 
https://msdn.microsoft.com/es-es/VBA/Language-Reference-VBA/articles/64-bit-visual-basic-for-applications-overview

Lo que no me queda claro en estas conversiones es si hay alguna diferencia entre usar LongPtr o LongLong en 64 bits. Por lo que veo, LongPtr es una especie de Alias de LongLong no un tipo de datos propiamente.

Estoy confuso, porque aún haciendo que funcione, no se soy estrictamente correctamente en el uso de LongLong o LongPtr.

He convertido los procedimientos, donde havia un Long a LongLong y ha ido bien
y he repetido lo mismo substituyendo Long por LongPtr y también ha ido bien.

Resumiendo ¿Es indifente usar LongLong o LongPtr?

Saludos,
Xavier
-------------------
10 'No code no pain
-------------------
Arriba
emiliove Ver desplegable
Moderador
Moderador


Unido: 16/Junio/2009
Localización: Mexico
Estado: Sin conexión
Puntos: 4991
Enlace directo a este mensaje Enviado: 18/Octubre/2017 a las 17:27
Te digo lo que yo entiendo vas a usar LongLong cuando sea un entero de 64 bits y cuando uses un puntero (HWND, HFILE, HINT) debes usar LongPtr.
Algo sobre el tema:

Edito: Insisto bajate el visor que el Buho puso en mis funciones favoritas que te ayudara con la incertidumbre.
Saludos.


Editado por emiliove - 18/Octubre/2017 a las 17:29
Arriba
vantorro Ver desplegable
Nuevo
Nuevo
Avatar

Unido: 18/Octubre/2017
Localización: Lejos
Estado: Sin conexión
Puntos: 12
Enlace directo a este mensaje Enviado: 18/Octubre/2017 a las 17:47
Gracias de nuevo,
aclarado el tema, me apunto lo del visor Wink

Por si a alguien le puede ser de utilidad, reescribo el código funcional para Access de 32 y 64 bits 

-------------------------------
Módulo Timers
-------------------------------
#If Win64 = 1 And VBA7 = 1 Then
    Public Sub TimerProc(ByVal hwnd As LongPtr, _
                             ByVal uMsg As LongLong, _
                             ByVal oTimer As clsTimer, _
                             ByVal dwTime As LongLong)
       ' Alert appropriate timer object instance.
       If Not oTimer Is Nothing Then
            oTimer.RaiseTimerEvent
            Debug.Print "evento timer"
       End If
    End Sub
#Else
    Public Sub TimerProc(ByVal hwnd As Long, _
                         ByVal uMsg As Long, _
                         ByVal oTimer As clsTimer, _
                         ByVal dwTime As Long)
       ' Alert appropriate timer object instance.
       If Not oTimer Is Nothing Then
            oTimer.RaiseTimerEvent
            Debug.Print "evento timer"
       End If
    End Sub
#End If
-------------------------------
-------------------------------
Módulo de clase clsTimer
-------------------------------
Option Compare Database
Option Explicit

'Windows API Function Declarations
#If Win64 = 1 And VBA7 = 1 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" ( _
        ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
        ByVal uElapse As LongLong, ByVal lpTimerFunc As LongPtr) As LongLong
    
    Private Declare PtrSafe Function KillTimer Lib "user32" ( _
        ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As LongLong
#Else
    Private Declare Function SetTimer Lib "user32" ( _
        ByVal hWnd As Long, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    
    Private Declare Function KillTimer Lib "user32" ( _
        ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#End If

#If Win64 = 1 And VBA7 = 1 Then
    Private TimerID As LongLong
#Else
    Private TimerID As Long
#End If

Public Event OnTimer()

'Start timer
Public Sub Startit(IntervalMs As Long)
    TimerID = SetTimer(Application.hWndAccessApp, ObjPtr(Me), IntervalMs, AddressOf Timers.TimerProc)
End Sub

'Stop timer
Public Sub Stopit()
    If TimerID <> -1 Then
        KillTimer Application.hWndAccessApp, TimerID
        TimerID = 0
    End If
End Sub

'Trigger Public event
Public Sub RaiseTimerEvent()
    RaiseEvent OnTimer
End Sub
-------------------------------
-------------------------------
Ejemplo simple en un formulario con 2 botones cmdStartTimer y cmdStopTimer:
---------------------------------------
Option Compare Database
Option Explicit

Public WithEvents oTimer1 As clsTimer

'Start the timer
Private Sub StartMyTimer()
    If oTimer1 Is Nothing Then Set oTimer1 = New clsTimer
    oTimer1.Startit 1000
End Sub

Private Sub cmdStartTimer_Click()
    StartMyTimer
    Debug.Print "Start Timer " & Now
End Sub

Private Sub cmdStopTimer_Click()
    If Not oTimer1 Is Nothing Then
        oTimer1.Stopit
        Debug.Print "Stop Timer " & Now
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Not oTimer1 Is Nothing Then
        oTimer1.Stopit
        Set oTimer1 = Nothing
    End If
End Sub

'Using the timer event from the timer
Private Sub oTimer1_OnTimer()
    Debug.Print "Timer Event " & Now
End Sub
-------------------------------

-------------------
10 'No code no pain
-------------------
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable