Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Synchronize timer function. 1

Status
Not open for further replies.

patriciaxxx

Programmer
Jan 30, 2012
277
GB
I have the following function below which compiles and works.

I have width of label (Label2) as 194 points so I set Mod 194

I have SomeEndCondition set to 5 seconds

What I need is for the progress of Label3 to stop exactly at the end of Label2 ie 194poimts exactly when SomeEndCondition is reached (in this example that is 5 seconds, however SomeEndCondition can be any value)

Code:
[COLOR=#204A87]Option Compare Database
Option Explicit

Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public lTimer As Long
Public SomeEndCondition As Long 'We need a way of flagging the end of this, so I'm simply going to be setting a maximum time limit.

Public Sub Timer()
frmTimer.Show False 'vbModeless 'Show the UserForm.
SomeEndCondition = 5000 'Set for 500ms (5 seconds).
lTimer = SetTimer(0&, 0&, 50, AddressOf nTimerHandler)
End Sub

Public Sub nTimerHandler(ByVal hwnd As Long, ByVal uMSG As Long, ByVal idEvent As Long, ByVal dwTime As Long)
Static Progress As Double
Static Tick

Tick = Tick + 50 '50ms is time interval we selected for this timer.

Dim Step As Double

frmTimer.Label1.Caption = "Closing in " & Round((SomeEndCondition - Tick) / 1000, 0) & " seconds" 'Count down display.

Step = 194 / 50 'frmTimer.InsideWidth / 50 'Arbitrary step size.
frmTimer.Label3.Width = (frmTimer.Label3.Width + Step) Mod 194 'frmTimer.InsideWidth
Progress = Progress + Step

If Tick >= SomeEndCondition Then 'Check whether end condition has been met.
    lTimer = SetTimer(0&, lTimer, 50, 0&) 'Reset timer else we get in a mess.
    KillTimer 0&, lTimer 'Kill timer.
    lTimer = 0
    Unload frmTimer 'Unload the UserForm.
End If

End Sub
[/color]
 
So what you are saying is that you DO want to use this code as a progress bar? IN which case I'd have written it differently to start with. However, here are some minor modifications that illustrate how to get it working the way that you now suggest.


Code:
[blue]Option Explicit

Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public lTimer As Long
Public SomeEndCondition As Long 'We need a way of flagging the end of this, so I'm simply going to be setting a maximum time limit.
Public Step As Double


Public Sub Timer()
frmTimer.Show False 'vbModeless 'Show the UserForm.
SomeEndCondition = 5000 'Set for 5000ms (5 seconds).
lTimer = SetTimer(0&, 0&, 50, AddressOf nTimerHandler)

' We know timer will tick every 50ms, and we want it to stop after 5000ms - so it will tick 5000/50 (=100) times.
' so we need to increment the progress bar by (1/100) * max width of progress bar
Step = frmTimer.Label3.Width / 100 ' Or more generally width / (desired elapsed time/tick interval)


End Sub

Public Sub nTimerHandler(ByVal hwnd As Long, ByVal uMSG As Long, ByVal idEvent As Long, ByVal dwTime As Long)
Static Progress As Double
Static Tick

Tick = Tick + 50 '50ms is time interval we selected for this timer.

frmTimer.Label1.Caption = "Closing in " & Round((SomeEndCondition - Tick) / 1000, 0) & " seconds" 'Count down display.

frmTimer.Label3.Width = Progress 'frmTimer.InsideWidth
Progress = Progress + Step

If Tick >= SomeEndCondition Then 'Check whether end condition has been met.
    lTimer = SetTimer(0&, lTimer, 50, 0&) 'Reset timer else we get in a mess.
    KillTimer 0&, lTimer 'Kill timer.
    lTimer = 0
    Unload frmTimer 'Unload the UserForm.
End If

End Sub[/blue]
 
Hello strongm

I tried the code but it only progressed a little bit?

Are the calculations right
 
The calculations are fine. The code works fine.

Examine this line

Step = frmTimer.Label3.Width / 100

And see if you can figure out which element might be causing only a short progress bar to appear ...
 
Hello strongm

I did carefully read through your code and all the comments to try and understand what was going on and interestingly I came to that same line

Step = frmTimer.Label3.Width / 100

having read the comments I thought that maybe the 100 should be replaced with whatever the SomeEndCondition was ie 5 seconds and so I tried

Step = frmTimer.Label3.Width / 5

this progressed further, about 60% of the way, but still wasn’t right, then I was confused.

 
The factor that should control how far the progress bar goes is exactly how wide label3 is when

Step = frmTimer.Label3.Width / 100

is called. And you need to be talking in the same scale units all the time (the function is scale agnostic, but does rather assume that the scale it is working with is consistent). So, for example, I'd be interested to know how you are originally setting the width of the label to 194 points, as you cannot do this (easily) on a userform (which is what this code was originally written for), since userforms do not have a scalemode.
 
Ignore the query about points - I'd forgotten that the default for Userforms, as opposed to VB forms, is indeed points. However, the main point - that the maximum width of the progress bar is defined by the width of Label3 at the point when

Step = frmTimer.Label3.Width / 100

is called.

I'll just repeat that, as written, the code works just as it should do. Can you confirm the result that you get when you use just the code presented (and a userform with the necessary labels on it) in a brand new database?
 
Sorry strongm, my Label was the wrong width but I’ve got there now.

It works just as you said it would.

Thank you as always.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top