Time countdown, urgent [resolved]

[Adrian_struggel]

Hey everyone, i've been seearching for a while now for a countdown timer but i was not able to find any.
I need to build a countdown timer, starting from 35 minutes to 0
and when time is up (when theres 0minutes) open a mesage box, telling the user that the time is up.
please help me...urgent

[RobDog888]

35 minutes is beyond the max limit of the timer control so you need to count in increments in order to extend it.

Add a timer control to your form. Set its interval to something like 21000, one tenth of 35 minutes.

Option Explicit
 
Private intCounter As Integer
 
Private Sub Form_Load()
    intCounter = 2100000 '35 minutes
    Timer1.Interval = 21000 'one one hundreth of 35 minutes
    Timer1.Enabled = True
End Sub
 
Private Sub Timer1_Timer()
    intCounter = intCounter - 21000
    If intCounter = 0 Then
        Timer1.Enabled = False
        MsgBox "Times up"
    End If
End Sub

[Jacob Roman]

Timers are not realtime, RobDog888. It is slow, inacurate, and inconsistant. Not to mention on computers with XP, timers go 10 times faster than usual.

Here ya go. This will do it in realtime too:

Option Explicit
 
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (lpPerformanceCount As Currency) As Long
 
Private Ticks_Per_Second As Currency
Private Start_Time As Currency
 
Private Elapsed_Time As Single
Private Milliseconds As Single
 
Private Running As Boolean
 
Private Function Hi_Res_Timer_Initialize() As Boolean
 
    If QueryPerformanceFrequency(Ticks_Per_Second) = 0 Then
 
        Hi_Res_Timer_Initialize = False
 
    Else
    
        QueryPerformanceCounter Start_Time
     
        Hi_Res_Timer_Initialize = True
     
    End If
 
End Function
 
Private Function Get_Elapsed_Seconds() As Single
    
    Dim Last_Time As Currency
    
    Dim Current_Time As Currency
    
    Dim Seconds As Single
    
    Last_Time = Current_Time - 1
 
    QueryPerformanceCounter Current_Time
    
    Seconds = (Current_Time - Last_Time) / Ticks_Per_Second
    
    Get_Elapsed_Seconds = Seconds
    
End Function
 
Private Sub Main_Loop()
    
    AutoRedraw = True
    
    Running = True
 
    Hi_Res_Timer_Initialize
 
    Milliseconds = Get_Elapsed_Seconds
    
    Do While Running = True
        
        DoEvents
        
        '60 seconds * 35 = 2100 seconds = 35 mintues
        
        Elapsed_Time = 2100 - (Get_Elapsed_Seconds - Milliseconds)
        
        If Elapsed_Time <= 0 Then 
 
             Elapsed_Time = 0       
 
             MsgBox "Time Is Up", vbExclamation
 
             Running = False       
      
        End If
 
        Label1.Caption = Str(Elapsed_Time)
        
        QueryPerformanceCounter Start_Time
        
    Loop
    
    Unload Me
    
End Sub
 
Private Sub Form_Activate()
 
    Main_Loop
 
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
 
    Running = False
 
End Sub

[RobDog888]

True, and I know you have proved it, but just starting out with the basics so as not to confuse the poster. Besides
its not stated that it need pin point accuarcy.

[Adrian_struggel]

hey guys thanks a lot...ur the best...which one is better...the second one looks long..which one should i use

[RobDog888]

Depends on your needs. If you want/need milisecond accuracy then use Jacobs. If not then mine is fine.

[Adrian_struggel]

na its not neccessary to have milisecond accuracy, so i will use yours robdog88,
thanks..a lot..to both of you..
really appriciate it

[Adrian_struggel]

hey robdog, i got a "overflow" error. whats the problem

[RobDog888]

No prob. but I also wanted to ask if you needed to display the timer position/value as it counts down?

[Adrian_struggel]

the problem seems to be in the intCounter = 2100000 '35 minutes

[Adrian_struggel]

oo yer..i need to display it in a label named lblTimer...
thnks
if u can..sory for bothering u...thanks

[RobDog888]

Change it to a Long. Integer is only 32767.

[RobDog888]

Then we nly need to change the Interval to something a bit more shorter.

Option Explicit
 
Private intCounter As Long
 
Private Sub Form_Load()
    intCounter = 2100000 '35 minutes
    Timer1.Interval = 1000 'one second
    Timer1.Enabled = True
End Sub
 
Private Sub Timer1_Timer()
    intCounter = intCounter - 1000
    lblTimer.Caption = intCounter
    If intCounter = 0 Then
        Timer1.Enabled = False
        MsgBox "Times up"
    End If
End Sub

[Adrian_struggel]

i dont really see the countdown. its not displaying anything in the lbltimer...what could be the prblem

[Adrian_struggel]

ooo yer yer..sory...forgot to change the interval in the timer properties.
i see it now..
is there anyway i can format the way it is displayed..
cos now its just a long number ther.
can i isplay it as in mm:ss
minutes : seconds

[RobDog888]

Yes, but we need to convert it from miliseconds to hh:mm:ss etc. Be back.

[Jacob Roman]

Yeah same in mine too.

Mine was counting down from 2100 seconds (35 min)

[Adrian_struggel]

okey, thanks a lot robdog ur the best

[Jacob Roman]

Here ya go incase you wanna use my code. It now shows the elapsed time in hours, minutes, and seconds

Option Explicit
 
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (lpPerformanceCount As Currency) As Long
 
Private Ticks_Per_Second As Currency
Private Start_Time As Currency
 
Private Elapsed_Time As Single
Private Milliseconds As Single
 
Private Hours As Single
Private Minutes As Single
Private Seconds As Single
 
Private Running As Boolean
 
Private Function Hi_Res_Timer_Initialize() As Boolean
 
    If QueryPerformanceFrequency(Ticks_Per_Second) = 0 Then
 
        Hi_Res_Timer_Initialize = False
 
    Else
    
        QueryPerformanceCounter Start_Time
     
        Hi_Res_Timer_Initialize = True
     
    End If
 
End Function
 
Private Function Get_Elapsed_Seconds() As Single
    
    Dim Last_Time As Currency
    
    Dim Current_Time As Currency
    
    Dim Seconds As Single
    
    Last_Time = Current_Time - 1
 
    QueryPerformanceCounter Current_Time
    
    Seconds = (Current_Time - Last_Time) / Ticks_Per_Second
    
    Get_Elapsed_Seconds = Seconds
    
End Function
 
Private Sub Main_Loop()
    
    AutoRedraw = True
    
    Running = True
 
    Hi_Res_Timer_Initialize
 
    Milliseconds = Get_Elapsed_Seconds
    
    Do While Running = True
        
        DoEvents
        
        '60 seconds * 35 = 2100 seconds = 35 mintues
        
        Elapsed_Time = 2100 - (Get_Elapsed_Seconds - Milliseconds)
        
        Hours = Int((Elapsed_Time / 3600))
        
        Minutes = Int((Elapsed_Time / 60)) Mod 60
        
        Seconds = Elapsed_Time Mod 60
        
 
        
        If Elapsed_Time <= 0 Then
 
             Elapsed_Time = 0
 
             MsgBox "Time Is Up", vbExclamation
 
             Running = False
      
        End If
 
        Label1.Caption = Str(Hours) & ":" & Str(Minutes) & ":" & Str(Seconds)
        
        QueryPerformanceCounter Start_Time
        
    Loop
    
    Unload Me
    
End Sub
 
Private Sub Form_Activate()
 
    Main_Loop
 
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
 
    Running = False
 
End Sub

[Adrian_struggel]

Jacob Roman, appriciate ur help....i am in my first year of A-level..
and begginer to VB...ur code looks a bit too advanced...i dont understand it...and the teacher is going to be suspicios..and know that i have deffenetly not done one bit of it.....robdog's one..looks more ok, and i might get away with it..

[Jacob Roman]

It's not that advanced at all, unless you never worked with API's before. If you want, I can put comments in for you to show you what the code does.

Here is what these API's do:

The QueryPerformanceFrequency returns Ticks per second from the internal clock in the computer. The internal clock by the way is reseted every time the computer has rebooted.

The QueryPerformanceCounter returns the elaped time from the internal clock.

Hope this helps.

[RobDog888]

I got my coffee now and I see the JR is picking up quite nicely

Heres what I got.

Private Sub Timer1_Timer()
    Dim lTemp As Long
    Dim lTemp2 As Long
    intCounter = intCounter - 1000
    lTemp = intCounter
    lTemp = lTemp / 1000 'convert to seconds
    lTemp2 = lTemp
    lTemp = (lTemp / 60) Mod 60 'Minutes
    lTemp2 = (lTemp2 Mod 60) 'Seconds
    lblTimer.Caption = lTemp & ":" & lTemp2
    If intCounter = 0 Then
        Timer1.Enabled = False
        MsgBox "Times up"
    End If
End Sub

[Adrian_struggel]

thanks robdog, works perfect...only it starts from 35:60...but dont matter...looks convincing..
lol...thanks both of you

[Jacob Roman]

Why thank you RobDog888. If I were you though, I'd add a couple variables in called Minutes and Seconds and replace these lines

Minutes = (lTemp / 60) Mod 60 'Minutes
    Seconds = (lTemp2 Mod 60) 'Seconds
    lblTimer.Caption = Minutes & ":" & Seconds

Makes the code a little more readable. Remeber not to use his code in a computer with XP cause it would go 10 times faster than usual. Mine is compatible with all Windows OS's starting from Windows 95 and up.

[RobDog888]

I was thinking of making it better reading but I got a headach this morning. Need more coffee

[Jacob Roman]

Speaking of which, I think I better get me some coffee myself. Thanks for the idea. While you are at it, fix the code a bit cause he has a problem:

thanks robdog, works perfect...only it starts from 35:60...but dont matter...looks convincing..
lol...thanks both of you