ALTERNATIVE TIMER POUR VBA

'Contenu de ma classe Timer

Option Explicit

Private localInterval As Long
Private localEnabled As Boolean

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private TimeOptions As FILETIME  ' Durée transmise à la fonction SetWaitableTimer

Private Declare Function CreateWaitableTimer Lib "kernel32" Alias "CreateWaitableTimerA" (ByVal lpSemaphoreAttributes As Long, ByVal bManualReset As Long, ByVal lpName As String) As Long
Private Declare Function SetWaitableTimer Lib "kernel32" (ByVal hTimer As Long, lpDueTime As FILETIME, ByVal lPeriod As Long, ByVal pfnCompletionRoutine As Long, ByVal lpArgToCompletionRoutine As Long, ByVal fResume As Long) As Long
Private Declare Function CancelWaitableTimer& Lib "kernel32" (ByVal hTimer As Long)
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function MsgWaitForMultipleObjects Lib "user32" (ByVal nCount As Long, pHandles As Long, ByVal fWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long

Private TimerhWait As Long
Private CancelTimer As Boolean
Private TimerRunning As Boolean

Public Event Timer()

'--------------------------------------------------------------
'Routine de temporisation...
'<vdata> : milisecondes
'<vdata> : <= 0 Annuler l'attente
'<vdata> : > 0 Démarrer la boucle d'attente

Public Property Let interval(vdata As Long)
'Si le Timer est activé
If localEnabled Then
        
    'Reset le drapeau d'annulation
    CancelTimer = False
    
    'Si la durée est inférieur ou égale à zéro
    If vdata <= 0 Then
        'Durée de la temporisation : <vdata> ms
        TimeOptions.dwLowDateTime = -1
        'Mettre à jour la variable locale
        localInterval = vdata
    'Sinon
    Else
        'Si le timer tourne déjà
        If TimerRunning Then
            'Annule le décompte en cours
            CancelWaitableTimer TimerhWait
            'Convertir la nouvelle durée
            TimeOptions.dwLowDateTime = CLng(vdata * -10000)
            'Programmer le déclenchement de l'évènement 'TimerhWait' dans 'TimeOptions' ms
            SetWaitableTimer TimerhWait, TimeOptions, 0, 0, 0, 0
            'Mettre à jour la variable locale
            localInterval = vdata
        'Sinon
        Else
            'Définir localement le timer comme tournant
            TimerRunning = True
            'Mettre à jour la variable locale
            localInterval = vdata
            'Convertir la nouvelle durée
            TimeOptions.dwLowDateTime = CLng(vdata * -10000)
            
            'Boucle infinie (jusqu'à annulation)
            Do Until TimeOptions.dwLowDateTime = -1
                
                'Programmer le déclenchement du prochain évènement 'TimerhWait' dans 'Timeoptions' ms
                SetWaitableTimer TimerhWait, TimeOptions, 0, 0, 0, 0
                
                'Boucle d'attente sans stress (Attendre le déclenchement de l'évènement 'TimerhWait')
                Do While MsgWaitForMultipleObjects(1, TimerhWait, False, &HFFFF, &HFF) > 0
                    DoEvents
                    'If CancelTimer Then Exit Do
                Loop
                
                'Si annulation, sortir de la boucle infinie
                If TimeOptions.dwLowDateTime = -1 Then Exit Do
                
                'Déclenchement de l'évènement 'Timer'
                RaiseEvent Timer
            
            Loop
            
            'Définir localement le timer à l'arrêt
            TimerRunning = False
            
        End If
    End If
'Sinon
Else
    'Mettre à jour la variable locale
    localInterval = vdata
End If
End Property

Public Property Get interval() As Long
    interval = localInterval
End Property

'--------------------------------------------------------------
Public Property Let Enabled(vdata As Boolean)

'Si changement
If vdata <> localEnabled Then
    'Si activation
    If vdata Then
        'Mettre à jour la variable locale
        localEnabled = vdata
        'Si l'intervalle est supérieur à zéro
        If localInterval > 0 Then
            'Mise en route du timer
            Me.interval = localInterval
        End If
    'Sinon
    Else
        'Annulation
        TimeOptions.dwLowDateTime = -1
        'Mettre à jour la variable locale
        localEnabled = vdata
    End If
End If
End Property

Public Property Get Enabled() As Boolean
    Enabled = localEnabled
End Property

'--------------------------------------------------------------
Private Sub Class_Initialize()
    'Création de l'horloge
    TimerhWait = CreateWaitableTimer(0, True, "Timer6RatsMorts")
    'Initialisation de la durée
    TimeOptions.dwHighDateTime = -1
    TimeOptions.dwLowDateTime = -1
End Sub

Private Sub Class_Terminate()
    TimeOptions.dwHighDateTime = -1
    TimeOptions.dwLowDateTime = -1
    CloseHandle TimerhWait
End Sub

Télécharger le zip

10 février 2007 20:08:30 :

RAS

10 février 2007 20:22:26 :

Correction de la présentation du code