Vb precise to 4 milliseconds?

[Izno]

hi, I'm new to the forums here and I did a quick search but I couldn't find out exactly.. anyways my question is, can I make a VB program that will have a break of precisely 4 milliseconds or will it be variant? and if its possible what would I have to do to start that break? Thanks alot for any help

[Joacim Andersson]

See the following thread that discuss multimedia timers.
http://www.vbforums.com/showthread.php?t=326071

[szlamany]

Keep in mind that timer controls are extremely inaccurate - so if you use a timer make it fire more than once in your 4 ms window (many, many times!) and then check a "clock" figure to see if the 4 ms threshold has been reached.

[Jacob Roman]

Option Explicit
 
Private Declare Function GetTickCount Lib "Kernel32" () As Long
 
Private Game_Active As Boolean
 
Private Milliseconds As Long
 
Private Sub Form_Activate()
 
    Milliseconds = GetTickCount
    
    Game_Active = True
    
    While Game_Active = True
        
        DoEvents
        
        If GetTickCount - Milliseconds >= 4 Then '4 milliseconds
            
            MsgBox GetTickCount - Milliseconds           
 
            Game_Active = False 'Breaks out of the loop
            
        End If
        
    Wend
            
    Unload Me
 
End Sub

[Joacim Andersson]

GetTickCount only have an accurasy of about 10ms. If you need lower resolution you need to use multimedia timers. The built in Timer in VB can not be used for such low resolution.

[NoteMe]

GetPerformanceFrequence and GetPerformanceQuerery is the best. The timer that was used in the contest on this forum relied on it. I belice the source code is still in a thread there.


ØØ

[NoteMe]

Here you go.

http://vbforums.com/showpost.php?p=1783665&postcount=52

Even a sample to go with it. But I guess you have to tweak it a bit to make use of it in your app.




ØØ

[Joacim Andersson]

GetPerformanceFrequence and GetPerformanceQuerery is the best. The timer that was used in the contest on this forum relied on it. I belice the source code is still in a thread there.

The forum link I posted in the first reply discuss these.

[Jacob Roman]

GetTickCount only have an accurasy of about 10ms. If you need lower resolution you need to use multimedia timers. The built in Timer in VB can not be used for such low resolution.

On the conterary, it has the accuracy of 1 ms. I use it all the time and it works in real time. Don't believe me? Try my code and fiddle with the milliseconds to break out of.

[Joacim Andersson]

On the conterary, it has the accuracy of 1 ms. I use it all the time and it works in real time. Don't believe me? Try my code and fiddle with the milliseconds to break out of.

Not true! At least not according to Microsoft:
http://support.microsoft.com/kb/q172338/

[NoteMe]

On the conterary, it has the accuracy of 1 ms. I use it all the time and it works in real time. Don't believe me? Try my code and fiddle with the milliseconds to break out of.

It is OS dependent.



MSDN:

The following table describes the resolution of the system timer.

System Resolution
Windows NT 3.5 and later The system timer runs at approximately 10ms.
Windows NT 3.1 The system timer runs at approximately 16ms.
Windows 95 and later The system timer runs at approximately 55ms.

[Jacob Roman]

That's funny. Works fine on my comp that has Windows ME and my dads comp that has Windows XP Pro SP2

[szlamany]

Hey everyone - this timer debate has been done before...

BTW - Izno - welcome to the forum.

Maybe we should ask what you are trying to do with this 4 ms window?

[Joacim Andersson]

That's funny. Works fine on my comp that has Windows ME and my dads comp that has Windows XP Pro SP2

So between two calls to GetTickCount you might get the result down to 1ms, but that in real time it might have past 10.
You can NOT get lower accuracy with the system timer, you need to use a hardware multimedia timer to get a better resolution. Why would they otherwise bother to build computers that has them if you could get the same accuracy using a software timer?

[NoteMe]

The forum link I posted in the first reply discuss these.

I read thgough it now. You wrote Multimeda Timer before the link, so I though it was discussing the multimeda timer API, not the other Timer APIs. I can't see that they are discussing the multimedia timer API at all on that page actualy.



ØØ

[NoteMe]

Finaly I found it. Kedas thread where all the timers are tested against each other.

http://vbforums.com/showthread.php?t...ltimedia+timer




ØØ

[Izno]

thanks for the replies so far I'm still waiting for the answers to a few of my questions before I will be putting it in, but I want a to build a program that flashes a dot and then displays a word for 4 milliseconds, and then that will be built into an array of words, it's for a psychology experiment

[dglienna]

I don't think the eye can pick up anything near that fast. The eye gets fooled at 60 fps, i thought, as that is what motion pictures frame out at?

[moeur]

I don't know if the eye can handle it, but your monitor probably can't.
Let's save you have a refresh rate of 85Hz, that's a refresh every 12ms. so, the best you could do if you snyc'd it right, is put something on the screen every 12ms.

[Joacim Andersson]

I don't think the eye can pick up anything near that fast. The eye gets fooled at 60 fps, i thought, as that is what motion pictures frame out at?

The eye get's fooled at about 15 fps. Motion pictures at the cinema use 24 fps and the VHS system use 25 fps.

[dglienna]

a lot slower than 85hz

http://www.100fps.com/how_many_frame...humans_see.htm

[moeur]

This is probably an experiment on subliminal messages which is a crock anyway.

[Izno]

hey guys, I've tried coding it but I'm a VB noob and I could use some help with my code. What I want is for some words to appear for 4 milliseconds (although as expressed here 17 seems to be the quickest Vb can handle but that will work) and some words to appear for 5 full seconds. I also want a dot to appear before all of the words for 4 seconds and a bunch of X's to appear after the word has been presented for its amount of time. Any help would be greatly appreciated this is what I have thus far but right now all I get is the line of X's, with no dot or words being presented whatsoever.

Private Sub cmdSecond_Click()
'clicking the button that does the real testing
'setting array value appropriately
If IntSecondArray > 19 Then
IntSecondArray = 0
End If

'assigning array values to the second array for the words in the timed list
If StrSecondWordArray(0) = "" Then
StrSecondWordArray(0) = "Climb"
StrSecondWordArray(1) = "Ballet"
StrSecondWordArray(2) = "Sight"
StrSecondWordArray(3) = "Cat"
StrSecondWordArray(4) = "Might"
StrSecondWordArray(5) = "With"
StrSecondWordArray(6) = "Valid"
StrSecondWordArray(7) = "Doll"
StrSecondWordArray(8) = "Consent"
StrSecondWordArray(9) = "Time"
StrSecondWordArray(10) = "Sew"
StrSecondWordArray(11) = "Smite"
StrSecondWordArray(12) = "Dog"
StrSecondWordArray(13) = "Scripts"
StrSecondWordArray(14) = "Yacht"
StrSecondWordArray(15) = "Conscience"
StrSecondWordArray(16) = "Chic"
StrSecondWordArray(17) = "Chalet"
StrSecondWordArray(18) = "Limb"
StrSecondWordArray(19) = "Hat"
End If
'setting variables to zero prior to measurement of time and loop

curFinishTime = 0
dblTime = 0

QueryPerformanceCounter curStartTime 'taking starting time then starting the timer
Do Until dblTime >= 4
'coding for the fixation dot
lblword.Caption = "*"

QueryPerformanceCounter curFinishTime
dblTime = curFinishTime - curStartTime
Loop


'clearing the timer variables before timing again
curFinishTime = 0
dblTime = 0


QueryPerformanceCounter curStartTime 'taking starting time then starting the timer
Select Case IntSecondArray 'coding for the 4 millisecond displays
Case 1, 3, 5, 6, 8, 10, 11, 12, 14, 15
Do Until dblTime >= 0.004
lblword.Caption = StrSecondWordArray(IntSecondArray)
QueryPerformanceCounter curFinishTime
dblTime = curFinishTime - curStartTime
Loop

Case Else 'coding for the 5 second displays
Do Until dblTime >= 5
lblword.Caption = StrSecondWordArray(IntSecondArray)
QueryPerformanceCounter curFinishTime
dblTime = curFinishTime - curStartTime
Loop

End Select

lblword.Caption = "XXXXXXXXXXXXX"
IntSecondArray = IntSecondArray + 1

End Sub

[Izno]

could anyone please help me improve on this?

[moeur]

could anyone please help me improve on this?

We could, but I'm not sure you'd listen.

Let me try it again: You cannot display something at a rate faster than your monitor scan rate. So for example, if your refresh rate is 75Hz then the fastest you could do would be once every 14ms. That is assuming you could sync your program to the monitor. Failing that you would have to leave the word there for a little longer just to make sure. With this in mind you might want to make a few changes to your loops

Select Case IntSecondArray
Case 1, 3, 5, 6, 8, 10, 11, 12, 14, 15
    lblword.Caption = StrSecondWordArray(IntSecondArray)
    DoEvents
    QueryPerformanceCounter curStartTime
    Do Until dblTime >= MyRefreshRate
      QueryPerformanceCounter curFinishTime
      dblTime = curFinishTime - curStartTime
    Loop

[Izno]

thanks for the help so far, I changed the timer so that it should be within reasonable limits for the monitor (20 ms) . I changed most of the code to work with the subs provided by Noteme here's what I have now. all I'm trying to do is display the asterisk for 4 seconds, then either display a word for 20 milliseconds, or for 5 seconds depending on which array position it is in then the row of X's. all I am getting at the moment is a pause followed by a white box around where the label box is located followed by the X's, it shouldn't be a problem with refresh rate though since the 5 second word display isn't working either. q.rettime returns the value of time that has elapsed from q.starttime to q.stoptime

q.Init
 
'coding the fixation point
lblword.Caption = "*"
q.StartTime
Do Until q.RetTime >= 4
    q.StopTime
Loop
 
 
Select Case IntSecondArray 'coding for the 20 millisecond displays
    Case 1, 3, 5, 6, 8, 10, 11, 12, 14, 15
        lblword.Caption = StrSecondWordArray(IntSecondArray)
        q.StartTime
        Do Until q.RetTime >= 0.02
        q.StopTime
    Loop
 
 
    Case Else 'coding for the 5 second displays
        lblword.Caption = StrSecondWordArray(IntSecondArray)
        q.StartTime
        Do Until q.RetTime >= 5
        q.StopTime
    Loop
 
   
End Select
 
 
IntSecondArray = IntSecondArray + 1
lblword.Caption = "XXXXXXXXXXXXXXX"
End Sub

[moeur]

post your q class,
what is q.starttime, stoptime etc...
If it's not too much trouble, post the whole things so I can run it here.
if you want to post a subset of your code, include everything needed to make it work.

[Izno]

no problem thanks again
there is a label button called lblword and the command button cmdsecond is the one with the issues, the first is just a list with no timers.

Option Explicit
'word array variables
Dim IntFirstArray As Integer 'the varibles used to keep track of position in the two buttons
Dim IntSecondArray As Integer
Dim StrWordStore As String
Dim StrStartWordArray(0 To 9) As String 'array for first list, easy scroll through
Dim StrSecondWordArray(0 To 20) As String 'array for second button with timing involved
 
'timer variables
Private tFreq As Currency
Private tStart As Currency
Private tStop As Currency
Private gTC As Boolean
 
 
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 GetTickCount Lib "kernel32" () As Long
'these above are functions that are used in calculating the time using an API function for maximum accuracy
 
Public Property Get RetTime() As Double
    RetTime = in_RetTime 'Returns Seconds
End Property
 
Public Sub Init()
    QueryPerformanceFrequency tFreq
    If tFreq = 1000 Then
        gTC = True
    Else
        gTC = False
    End If
End Sub
 
Public Sub StopTime()
    If gTC Then
        tStop = CCur(GetTickCount)
    Else
        QueryPerformanceCounter tStop
    End If
    in_RetTime = (tStop - tStart) / tFreq
End Sub
 
Public Sub StartTime()
    If gTC Then
        tStart = CCur(GetTickCount)
    Else
        QueryPerformanceCounter tStart
    End If
End Sub
 
 
Private Sub cmdFirst_Click()
'this is the coding for the button that merely displays the words one after another in a loop
 
 
 
 
If IntFirstArray > 9 Then
MsgBox "End of List, restarting"
IntFirstArray = 0
End If
 
StrStartWordArray(0) = "Slight"
StrStartWordArray(1) = "Benign"
StrStartWordArray(2) = "Yacht"
StrStartWordArray(3) = "Climb"
StrStartWordArray(4) = "Ballet"
StrStartWordArray(5) = "Bind"
StrStartWordArray(6) = "Although"
StrStartWordArray(7) = "Psyche"
StrStartWordArray(8) = "Might"
StrStartWordArray(9) = "Fetus"
 
 
lblword.Caption = StrStartWordArray(IntFirstArray)
 
IntFirstArray = IntFirstArray + 1
 
 
End Sub
 
Private Sub Form1_Load()
IntFirstArray = 0
IntSecondArray = 0
CmdNext.SetFocus
 
 
 
lblword.Caption = StrStartWordArray(IntArray)
 
End Sub
 
 
Private Sub cmdSecond_Click()
Dim q As New sTime 'this is the variable used to call the time subs
'clicking the button that does the real testing
'setting array value appropriately
If IntSecondArray > 19 Then
IntSecondArray = 0
End If
 
 
 
'assigning array values to the second array for the words in the timed list
If StrSecondWordArray(0) = "" Then
    StrSecondWordArray(0) = "Climb"
    StrSecondWordArray(1) = "Ballet"
    StrSecondWordArray(2) = "Sight"
    StrSecondWordArray(3) = "Cat"
    StrSecondWordArray(4) = "Might"
    StrSecondWordArray(5) = "With"
    StrSecondWordArray(6) = "Valid"
    StrSecondWordArray(7) = "Doll"
    StrSecondWordArray(8) = "Consent"
    StrSecondWordArray(9) = "Time"
    StrSecondWordArray(10) = "Sew"
    StrSecondWordArray(11) = "Smite"
    StrSecondWordArray(12) = "Dog"
    StrSecondWordArray(13) = "Scripts"
    StrSecondWordArray(14) = "Yacht"
    StrSecondWordArray(15) = "Conscience"
    StrSecondWordArray(16) = "Chic"
    StrSecondWordArray(17) = "Chalet"
    StrSecondWordArray(18) = "Limb"
    StrSecondWordArray(19) = "Hat"
End If
'setting variables to zero prior to measurement of time and loop
 
 
q.Init
 'taking starting time then starting the timer
 
'coding the fixation point
lblword.Caption = "*"
q.StartTime
Do Until q.RetTime >= 4
    q.StopTime
Loop
 
 
Select Case IntSecondArray 'coding for the 4 millisecond displays
    Case 1, 3, 5, 6, 8, 10, 11, 12, 14, 15
        lblword.Caption = StrSecondWordArray(IntSecondArray)
        q.StartTime
        Do Until q.RetTime >= 0.02
        q.StopTime
    Loop
 
 
    Case Else 'coding for the 5 second displays
        lblword.Caption = StrSecondWordArray(IntSecondArray)
        q.StartTime
        Do Until q.RetTime >= 5
        q.StopTime
    Loop
 
   
End Select
 
 
IntSecondArray = IntSecondArray + 1
lblword.Caption = "XXXXXXXXXXXXXXX"
End Sub

[moeur]

OK, I have it in a project, but

Dim q As New sTime

don't have this sTime thing
is it a class that you can include the code for?

[Izno]

yeah, here it is

'******* sTime.cls *******
'PROPERTY:
Private in_RetTime As Double
 
'VARIABLES:
Private tFreq As Currency
Private tStart As Currency
Private tStop As Currency
Private gTC As Boolean
 
'DECLARATIONS:
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Public Property Get RetTime() As Double
    RetTime = in_RetTime 'Returns Seconds
End Property
 
Public Sub Init()
    QueryPerformanceFrequency tFreq
    If tFreq = 1000 Then
        gTC = True
    Else
        gTC = False
    End If
End Sub
 
Public Sub StopTime()
    If gTC Then
        tStop = CCur(GetTickCount)
    Else
        QueryPerformanceCounter tStop
    End If
    in_RetTime = (tStop - tStart) / tFreq
End Sub
 
Public Sub StartTime()
    If gTC Then
        tStart = CCur(GetTickCount)
    Else
        QueryPerformanceCounter tStart
    End If
End Sub

[moeur]

OK,
Here is a change you need to make. Each time you change a label you will need to force the label to repaint by calling the Refresh method.

lblword.Caption = StrSecondWordArray(IntSecondArray)
        lblword.Refresh
        q.StartTime

[Izno]

Awesome, thank you a ton Moeur I think I've finally got it! thanks a bunch to the rest of you guys too it was definately a group effort

[dglienna]

Post it. I'd like to see what my laptop can do as far as fast refresh rate.

[VBAhack]

Here's a timer that supposedly has millisecond accuracy.

http://vb.mvps.org/samples/project.asp?id=StopWatch

VBAhack

[moeur]

Here's a timer that supposedly has millisecond accuracy.

Dude, we're beyond that. He's got much better than millisecond resolution.