'===========================================================================
' Subject: VB Reflex Test                     Date: 12-22-02 (  :  )       
'  Author: michael webster                    Code: VBWIN                  
'  Origin: mfwebster@pdq.net                Packet: VBWIN.ABC
'===========================================================================
'Reflexe tester 
'Michael Webster
'VB Version (first)

Option Explicit 
Dim fTimerWait As Boolean 
Dim state As Integer 
Dim total As Long 
 
Private Sub Command1_Click() 
 
    If fTimerWait Then state = 7 
    Select Case state 
        Case 0 
            Command1.Caption = "" 
            Command1.BackColor = QBColor(12) 
            Label2.Caption = "" 
            Randomize 
            Timer1.Interval = Rnd * 3000 + 2000 
            Timer1.Enabled = True 
            state = state + 1 
            total = 0 
            fTimerWait = True 
        Case 1 To 5 
            total = total + ElapsedMicroSeconds 
            Command1.BackColor = QBColor(12) 
            Randomize 
            Timer1.Interval = Rnd * 3000 + 2000 
            fTimerWait = True 
        Case 6 
            Command1.Caption = "Start" 
            Command1.BackColor = vbButtonFace 
            Timer1.Enabled = False 
            fTimerWait = False 
            state = 0 
            Label2.Caption = "Average response time:" & Str$(total \ 5000) & " ms" 
        Case 7 
            Command1.Caption = "Start" 
            Command1.BackColor = vbButtonFace 
            Timer1.Enabled = False 
            fTimerWait = False 
            state = 0 
            Label2.Caption = "             TEST ABORTED" 
    End Select 
 
End Sub 
 
Private Sub Form_Load() 
    Dim s$ 
     
    If ElapsedMicroSeconds = -1 Then 
        MsgBox "High-resolution performance counter not supported" 
        End 
    End If 
     
    s$ = s$ + "This program measures your response time for random events. " 
    s$ = s$ + "Click the Start button to begin. Each test consists of five " 
    s$ = s$ + "trials.  For each trial, the button will change from red to " 
    s$ = s$ + "green after a random delay of 3-5 seconds. Click the button " 
    s$ = s$ + "as soon as possible after the change.  After the last " 
    s$ = s$ + "trial, your average response time in milliseconds will be " 
    s$ = s$ + "displayed. The test will abort automatically if you click " 
    s$ = s$ + "the button before the change or if you fail to click " 
    s$ = s$ + "the button before the end of the next 3-5 second period." 
    Label1.Caption = s$ 
     
End Sub 
 
Private Sub Timer1_Timer() 
 
    If Not fTimerWait Then 
        state = 7 
        Command1_Click 
        Exit Sub 
    End If 
    Command1.BackColor = QBColor(10) 
    state = state + 1 
    fTimerWait = False 
    ElapsedMicroSeconds 
     
End Sub 
 
 

Code module: Code:
Option Explicit 
 
Declare Function QueryPerformanceFrequency Lib "Kernel32" _ 
                    (lpFrequency As Currency) As Boolean 
Declare Function QueryPerformanceCounter Lib "Kernel32" _ 
                    (lpCount As Currency) As Boolean 
                                         
Static Function ElapsedMicroSeconds() As Long 
    ' Returns the time in microseconds since the last call, 
    ' adjusted for the API call overhead. Returns zero for 
    ' the first call and for any subsequent calls where the 
    ' return value would overflow a long integer (> 2147s). 
    ' Returns -1 if the high-resolution counter is not 
    ' supported or the frequency is less than 1.0 MHz 
    ' (the normal frequency is 1.193182 MHz). 
     
    Dim freq As Currency, overhead As Currency 
    Dim count As Currency, prevCount As Currency 
    Dim microseconds As Currency 
    Dim fStarted As Boolean 
     
    If fStarted Then 
        QueryPerformanceCounter count 
        microseconds = (count - prevCount - overhead) / freq * 1000000 
        If microseconds > 2147483647 Then Exit Function 
        ElapsedMicroSeconds = microseconds 
    Else 
        If QueryPerformanceFrequency(freq) = 0 Or freq < 100 Then 
            ElapsedMicroSeconds = -1 
            Exit Function 
        End If 
        QueryPerformanceCounter prevCount 
        QueryPerformanceCounter count 
        overhead = count - prevCount 
        fStarted = True 
    End If 
    prevCount = count 
End Function 
 
 

Later: 
 
This modified form module eliminates the mouse button release time from the measurement: 
Code:
Option Explicit 
Dim fTimerWait As Boolean 
Dim state As Integer 
Dim total As Long 
 
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    If fTimerWait Then 
   Command1.Caption = "Start" 
   Command1.BackColor = vbButtonFace 
   Timer1.Enabled = False 
   fTimerWait = False 
   state = 0 
   Label2.Caption = "   TEST ABORTED" 
   Exit Sub 
    End If 
    Select Case state 
   Case 0 
  Command1.Caption = "" 
  Command1.BackColor = QBColor(12) 
  Label2.Caption = "" 
  Randomize 
  Timer1.Interval = Rnd * 3000 + 2000 
  Timer1.Enabled = True 
  state = state + 1 
  total = 0 
  fTimerWait = True 
   Case 1 To 5 
  total = total + ElapsedMicroSeconds 
  Command1.BackColor = QBColor(12) 
  Randomize 
  Timer1.Interval = Rnd * 3000 + 2000 
  fTimerWait = True 
   Case 6 
  Command1.Caption = "Start" 
  Command1.BackColor = vbButtonFace 
  Timer1.Enabled = False 
  fTimerWait = False 
  state = 0 
  Label2.Caption = "Average response time:" & Str$(total \ 5000) & " ms" 
    End Select 
End Sub 
 
Private Sub Form_Load() 
    Dim s$ 
     
    If ElapsedMicroSeconds = -1 Then 
   MsgBox "High-resolution performance counter not supported" 
   End 
    End If 
     
    s$ = s$ + "This program measures your response time for random events. " 
    s$ = s$ + "Click the Start button to begin. Each test consists of five " 
    s$ = s$ + "trials.  For each trial, the button will change from red to " 
    s$ = s$ + "green after a random delay of 3-5 seconds. Click the button " 
    s$ = s$ + "as soon as possible after the change.  After the last " 
    s$ = s$ + "trial, your average response time in milliseconds will be " 
    s$ = s$ + "displayed. The test will abort automatically if you click " 
    s$ = s$ + "the button before the change or if you fail to click " 
    s$ = s$ + "the button before the end of the next 3-5 second period. " 
    s$ = s$ + "Note that this program treats the mouse down event as a click." 
     
    Label1.Caption = s$ 
     
End Sub 
 
Private Sub Timer1_Timer() 
 
    If Not fTimerWait Then 
   Command1.Caption = "Start" 
   Command1.BackColor = vbButtonFace 
   Timer1.Enabled = False 
   fTimerWait = False 
   state = 0 
   Label2.Caption = "   TEST ABORTED" 
   Exit Sub 
    End If 
    Command1.BackColor = QBColor(10) 
    state = state + 1 
    fTimerWait = False 
    ElapsedMicroSeconds 
     
End Sub