GPWiki.org
GPWiki.org
It is currently Fri May 24, 2013 9:52 am

All times are UTC




Post new topic Reply to topic  [ 1 post ] 
Author Message
PostPosted: Sun Aug 21, 2011 6:31 pm 
Prolific Poster

Joined: Sat Apr 23, 2011 4:39 pm
Posts: 15
i build 1 timer control for catch the precision of 1ms(the multimedia timers are very instable).
i have tested and works, but when i put more than 1 instances only 1 instance works(at time). how can i avoid these error?
Code:
Option Explicit

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long

Event Timer()

Private lngInterval As Long
Private blnTimer As Boolean

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
                'For Each UserControl In UserControl.Parent.Controls
                    RaiseEvent Timer
                    API_DoEvents
                    Exit Do  'wait for current count to exceed
                'Next
            End If
        Loop
        If blnTimer = False Or Extender.Enabled = False Then Exit Do
    Loop

End Sub

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

Public Property Let Enabled(ByVal vNewValue As Boolean)
    If lngInterval < 1 Then Exit Property
    If blnTimer = vNewValue Then Exit Property
    blnTimer = vNewValue
    If Ambient.UserMode = False Then Exit Property
    If blnTimer = True Then WaitMs lngInterval
    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_ReadProperties(PropBag As PropertyBag)
    Interval = PropBag.ReadProperty("Interval", 0)
    Enabled = PropBag.ReadProperty("Enabled", 0)
End Sub

Private Sub UserControl_Terminate()
    blnTimer = False
End Sub

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

thanks


Top
 Profile  
 
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 1 post ] 

All times are UTC


Who is online

Users browsing this forum: No registered users and 2 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  
Powered by phpBB® Forum Software © phpBB Group