patriciaxxx
Programmer
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)
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]