[VB6] - why these code can't be used more than once?

[joaquim]

i buid these code for try build 1 timer with 1ms of precision:

Private Sub WaitMs(ByVal ms As Long) 'wait a given number of milliseconds
    Dim t As Currency
    Dim f As Currency
    Dim e As Currency
    Dim i As Long
    
    On Error Resume Next
    Do
        f = 0
        t = 0
        e = 0
        QueryPerformanceFrequency f   'get number of counts/second
        t = f * ms / 1000# 'multiply f by number of seconds to get number of counts to wait
        QueryPerformanceCounter e  'get current count number
        e = e + t  'add number of counts to wait to current count
        'API_DoEvents
        Do
            QueryPerformanceCounter t
            If t > e Then
                RaiseEvent Timer
                API_DoEvents
                Exit Do  'wait for current count to exceed e
            End If
        Loop
        If blnTimer = False Then Exit Do
    Loop
End Sub

these code works fine. i put in an activex control and stills works. but why i can't use 2 controls in same form(in same application not tested)?
i have tested and i see that 1 timer stills works but the other not or chage it(the 1st timer is desactivated and the 2nd timer is actived)

[joaquim]

the best way is use 1 array, in these sub.

Private Sub WaitMs(ByVal ms As Long) 'wait a given number of milliseconds
    Dim t As Currency
    Dim f As Currency
    Dim e As Currency
    Dim i As Long
    
    On Error Resume Next
    Do
        f = 0
        t = 0
        e = 0
        QueryPerformanceFrequency f   'get number of counts/second
        t = f * ms / 1000# 'multiply f by number of seconds to get number of counts to wait
        QueryPerformanceCounter e  'get current count number
        e = e + t  'add number of counts to wait to current count
        'API_DoEvents
        Do
            QueryPerformanceCounter t
            If t > e Then
                i = 1
                Do While i < 3
                    'lngTimer(1)=1ms
                    'lngTimer(2)=1000
                    If e Mod lngTimer(i) = 0 Then
                        RaiseEvent Timer(i)
                        DoEvents
                    End If
                    i = i + 1
                Loop
                Exit Do
            End If
        Loop
        If blnTimer = False Then Exit Do
    Loop
End Sub

and works... but why the 2nd timer works, only, sometimes?
isn't the if condicition correct?

[joaquim]

finally i found something:

Option Explicit

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Event Timer()

Dim lngInterval As Long
Dim blnTimer As Boolean

Private Const WM_KEYDOWN = &H100

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

Public Property Let Enabled(ByVal vNewValue As Boolean)
    If lngInterval = 0 Then Exit Property
    lngHwnd = UserControl.ContainerHwnd
    If blnTimer = vNewValue Then Exit Property
    blnTimer = vNewValue
    If Ambient.UserMode = False Then Exit Property
    If blnTimer = True Then
        WaitMs 1
    End If
    PropertyChanged "Enabled"
End Property

Public Property Get Interval() As Long
    Interval = lngInterval
End Property

Public Property Let Interval(ByVal vNewValue As Long)
    If vNewValue < 0 Then vNewValue = 0
    If Enabled = True Then Exit Property
    lngInterval = vNewValue
    If lngInterval = 0 Then Enabled = False
    PropertyChanged "Interval"
End Property

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 1000 Then RaiseEvent Timer
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    Interval = PropBag.ReadProperty("Interval", 0)
    Enabled = PropBag.ReadProperty("Enabled", 0)
End Sub

Private Sub UserControl_Resize()
    UserControl.Width = 240
    UserControl.Height = 240
    UserControl.MaskColor = GetPixel(UserControl.hdc, 0, 0)
End Sub

Private Sub UserControl_Initialize()
    UserControl.MaskPicture = UserControl.Image
End Sub

Private Sub UserControl_Terminate()
    If blnTimer <> False Then blnTimer = False
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "Interval", Interval, 0
    PropBag.WriteProperty "Enabled", Enabled, 0
End Sub

'2 mod 1 = 0 thinking that interval is 1 ms
'20 mod 10 = 0 thinking that interval is 10 ms
'if e mod interval = 0 then raiseevent timer
'**********
'if e+100>3600 000 then e =3600 000 - ( e + NextTimerInterval )
Private Sub WaitMs(ByVal ms As Long) 'wait a given number of milliseconds
    Dim t As Currency
    Dim f As Currency
    Dim e As Currency
    Dim tmrcontrol As TimerMS
    Dim i As Long
    
    On Error Resume Next
    Do
        f = 0
        t = 0
        e = 0
        QueryPerformanceFrequency f   'get number of counts/second
        t = f * ms / 1000# 'multiply f by number of seconds to get number of counts to wait
        QueryPerformanceCounter e  'get current count number
        e = e + t  'add number of counts to wait to current count
        Do
            QueryPerformanceCounter t
            If t > e Then
                For Each tmrcontrol In UserControl.Parent.Controls
                    If e * 1000 Mod tmrcontrol.Interval = 0 And tmrcontrol.Enabled = True Then
                        PostMessage tmrcontrol.hwnd, WM_KEYDOWN, 1000, 0
                        Debug.Print tmrcontrol.Interval; tmrcontrol.Enabled
                    End If
                    API_DoEvents
                Next tmrcontrol
                Exit Do
            End If
            If blnTimer = False Or Extender.Enabled = False Then Exit Sub
        Loop
        If blnTimer = False Or Extender.Enabled = False Then Exit Do
    Loop
End Sub

Public Function hwnd() As Long
    hwnd = UserControl.hwnd
End Function

the 2 timers controls works. but for disable i need click 2 times in same command(that disable both).
i belive that the bug is in for each...in..next... or even the variable. can anyone advice me?

[LaVolpe]

Try removing that DoEvents in your loop

[joaquim]

Try removing that DoEvents in your loop

i try that, but can "block" the program and vb6.... what i mean is that i can't use it and for close it i must do ctrl+alt+delete(combination keys)