En algunas aplicaciones es necesario controlar el tiempo de una determinada tarea, un procedimiento, y de forma más elaborada en proyectos para control de cybercafés. Básicamente para crear cronómetros se usa el control Timer; sin embargo éste tiene sus limitaciones, como la falta de precisión entre eventos Timer y el contador se detiene al hacer CTRL+ALT+SUPR en Windows 9x, lo que hace que éste control no sea el más adecuado para crear cronómetros en tiempo real. Por ello es recomendable utilizar la API de Windows y esta clase simplifica el uso de la función GetTickCount para la creación de cronómetros de cuenta regresiva y normales.

Código fuente de la clase clsCronómetro:

Option Explicit

'Declaración de la API
Private Declare Function GetTickCount Lib "kernel32" () As Long

'Variables para el control del tiempo
Dim TiempoFinal As Long
Dim TiempoParado As Long
Dim CuandoParó As Long

'Establece una cuenta regresiva, donde
'el argumento "Segundos" es la cantidad de
'segundos que se quiere fijar.
Public Sub EstablecerTiempo(Segundos As Long)
TiempoFinal = QuitarDecimales(GetTickCount / 1000) + Segundos
TiempoParado = 0
End Sub

'Establece una cuenta libre, osea un cronómetro
'común y corriente. Si deseas puedes establecer el
'argumento "TiempoQueHaTranscurrido" para indicar
'desde dónde va a comenzar el cronómetro.
Public Sub EstablecerLibre(Optional TiempoQueHaTranscurrido As Long = 0)
TiempoFinal = QuitarDecimales(GetTickCount / 1000) - TiempoQueHaTranscurrido
TiempoParado = 0
End Sub

'Agrega tiempo a un cronómetro en curso, donde
'"Segundos" es la cantidad de tiempo a agregar.
Public Sub AgregarTiempo(Segundos As Long)
TiempoFinal = QuitarDecimales(TiempoFinal) + Segundos
End Sub

'Utilizar esta función para obtener el tiempo
'en curso de una cuenta regresiva.
Public Function ObtenerTiempo() As Long
ObtenerTiempo = TiempoFinal - QuitarDecimales(GetTickCount / 1000) + TiempoParado
End Function

'Utilizar esta función para obtener el tiempo
'en curso de un cronómetro normal.
Public Function ObtenerTiempoLibre() As Long
ObtenerTiempoLibre = QuitarDecimales(GetTickCount / 1000) - TiempoFinal - TiempoParado
End Function

'Detiene momentaneamente el tiempo de
'un cronómetro en curso.
Public Function CongelarTiempo()
CuandoParó = QuitarDecimales(GetTickCount / 1000)
End Function

'Reanuda el tiempo de un cronómetro en
'curso.
Public Function ReanudarTiempo()
TiempoParado = TiempoParado + QuitarDecimales(GetTickCount / 1000) - CuandoParó
End Function

'Función privada para quitar los decimales que se
'obtienen al llamar a la API GetTickCount.
Private Function QuitarDecimales(ByVal Número) As Long
On Error Resume Next
Dim NúmeroConvertido As String, NúmeroNuevo As String
NúmeroConvertido = Número
If Len(NúmeroConvertido) <> 1 Then
    NúmeroNuevo = Left(NúmeroConvertido, InStr(1, NúmeroConvertido, ".") - 1)
    If Err.Number = 5 Then NúmeroNuevo = NúmeroConvertido
Else
    NúmeroNuevo = NúmeroConvertido
End If
QuitarDecimales = Val(NúmeroNuevo)
End Function

Función FormatoHoras

Adicionalmente a la clase puedes usar esta función para convertir los segundos obtenidos con la función ObtenerTiempo u ObtenerTiempoLibre al formato "hh:mm:ss".

'Función para convertir una cantidad de
'segundos en el formato "hh:mm:ss".
Private Function FormatoHoras(Segundos As Long) As String
Dim Hora As Long, Minuto As Long, Segundo As Long
Dim Tiempo As Single
Tiempo = Segundos
'Separa el tiempo en horas, minutos y segundos
Hora = Int(Tiempo / 3600)
Minuto = Int((Tiempo - Hora * 3600) / 60)
Segundo = Tiempo - Hora * 3600 - Minuto * 60
'Formatea el tiempo como cadena
FormatoHoras = Format(Hora, "00") & ":" & Format(Minuto, "00") & ":" & Format(Segundo, "00")
End Function

Fichero con el código de ejemplo: galegre_CronometroAPI.zip - Tamaño KB