Source Code
provided by Planet Source Code


VB icon CPerformance
Submitted on: 10/10/98
By: Ricardo Saat
Category: VB 5.0/6.0,VB 4.0/32
Users have accessed this code 1498 times.

This class encapsulate QueryPerfomanceXXX API functions to mesure small time intervals. You can use this class to mesure how much time your code take. This function can mesure time intervals near 0.1 ms , 10 times better then timeGetTime() API or GetTickCount() that have an error of 50ms. Example: Dim m_performance As CPerformance Dim i As integer Set m_performance = new CPerformance m_performance.StartCounter() 'Do something For i = 1 to 1000 next i m_performance.StopCounter() Debug.print m_performance.TimeElapsed() 'Time in ms (1/1000) s 'this is a float number 'ex: 1.54 ms
     

 

Windows API/Global Declarations:

Note:This code is formatted to be pasted directly into VB.
Pasting it into other editors may or may not work.


			
'***************************************************************
'Windows API/Global Declarations for :CPerformance
'***************************************************************
		
		

						

Source Code:

Note:This code is formatted to be pasted directly into VB.
Pasting it into other editors may or may not work.


		
'***************************************************************
' Name: CPerformance
' Description:This class encapsulate QueryPerfomanceXXX 
API functions to mesure small time intervals. You can use this class 
to mesure how much time your code take. This Function can mesure time 
intervals near 0.1 ms , 10 times better Then timeGetTime() API or 
GetTickCount() that have an Error of 50ms.
Example:
Dim m_performance As CPerformance
Dim i As Integer 
Set m_performance = new CPerformance
m_performance.StartCounter()
'Do something


For i = 1 to 1000
Next i 


m_performance.StopCounter()
Debug.print m_performance.TimeElapsed() 'Time in ms (1/1000) s 
					'this is a float number 
					'ex: 1.54 ms
' By: Ricardo Saat
'
'
' Inputs:None
'
' Returns:Time interval in ms.
'
'Assumes:None
'
'Side Effects:The API function maybe not work, but it's very rare
'     .
'
'Code provided by Planet Source Code(tm) (http://www.Planet-Sourc
'     e-Code.com) 'as is', without warranties as to performance, fitnes
'     s, merchantability,and any other warranty (whether expressed or i
'     mplied).
'This code is for personal private or personal business use only 
'     and may not be redistributed or duplicated in any format without 
'     express written consent from Planet Source Code or Exhedra Soluti
'     ons, Inc.
'***************************************************************

Option Explicit


Private Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
    End Type


Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long


Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
    Private m_PerfFrequency As LARGE_INTEGER
    Private m_CounterStart As LARGE_INTEGER
    Private m_CounterEnd As LARGE_INTEGER
    Private m_crFrequency As Currency
    Private m_bEnable As Boolean
    'mesure time that the code take jus to call functions


Property Get Delay() As Double


    Dim i As Integer
    Dim crTotalcount As Currency
    


    For i = 1 To 100
        Me.StartCounter
        Me.StopCounter
        crTotalcount = crTotalcount + (Large2Currency(m_CounterEnd) - Large2Currency(m_CounterStart))
    Next i


    Delay = ((crTotalcount / 100) / m_crFrequency) * 1000#
End Property




Private Function Large2Currency(largeInt As LARGE_INTEGER) As Currency




    If (largeInt.lowpart) > 0& Then
        Large2Currency = largeInt.lowpart
    Else
        Large2Currency = CCur(2 ^ 31) + CCur(largeInt.lowpart And &H7FFFFFFF)
    End If


    Large2Currency = Large2Currency + largeInt.highpart * CCur(2 ^ 32)
End Function




Private Sub Class_Initialize()


    Dim lResp As Long
    m_bEnable = CBool(QueryPerformanceFrequency(m_PerfFrequency))


    If m_bEnable Then
    End If


    m_crFrequency = Large2Currency(m_PerfFrequency)
    Debug.Assert m_bEnable 'Computer does not suport PerfCounter
End Sub




Public Sub StartCounter()


    Dim lResp As Long
    lResp = QueryPerformanceCounter(m_CounterStart)
End Sub




Public Sub StopCounter()


    Dim lResp As Long
    lResp = QueryPerformanceCounter(m_CounterEnd)
End Sub




Property Get TimeElapsed() As Double


    Dim crStart As Currency
    Dim crStop As Currency
    Dim crFrequency As Currency
    crStart = Large2Currency(m_CounterStart)
    crStop = Large2Currency(m_CounterEnd)
    TimeElapsed = ((crStop - crStart) / m_crFrequency) * 1000#
End Property




							

notes User Feedback on this Submission
Comments, Questions, Bug Fixes, etc.


  There are no comments on this submission.
 

Questions, comments, bug fixes, etc. ? Post them here!
Your feedback will be posted here and an email will be sent to the original author.

NOTICE: Rude or harrassing feedback is not acceptable.
If you see inappropriate feedback, please let me know!
Please post only feedback pertaining to THIS submission.
You can post feedback on more general topics by clicking here.

 

Name:
Email:
Comment:


Code Display Options

Display Format
List
Text Box


Menu*

Home |  Intro |  Search |  Browse |  Top Code |  Newest Code |  Submit |  Discuss |  Code of the Day |  Recommended Reading |  Advertising |  Other sites |  Feedback |  About

*Click here for an explanation of menu options.



Copyright© 1997 by Juggernaut Solutions, Inc.
All Rights Reserved

Email webmaster@planet-source-code.com


Find out about the cheapest and most efficent way to target your vb customers!

Free Downloads from: