Progress Meter Duration and Increment 1

[patriciaxxx]

I have the code below which works as follows:

On the form when you click the command button it sets the Forms Timer Interval to 3 seconds and then calls a function. The function takes a varying time to run depending on how much it does. The DoEvents makes sure it completes before moving on.

The Forms Timer event increments the meter and resets it after the Timer Interval has elapsed.

My problem is, while this all works, it doesn’t work how I would like it to.

What I mean is, the duration of the Meter is currently determined by the Timer Interval set to 3 seconds [highlight #EDD400]but I want it last for however long it takes the ‘Call WorkArounds” to run.[/highlight]

I can’t work out a way to do this, usually I increment progress meters using loops but there are no loops in any of the code to use which is why I’m using the Forms Timer.

Any help would be much appreciated.

Option Compare Database
Option Explicit

Private Sub cmdSaveChanges_Click()
Me.TimerInterval = 3000
DoEvents
Call WorkArounds

Me.cboLinkedTables.Enabled = True
Me.cboLinkedTables.SetFocus
Me.cmdSaveChanges.Enabled = False
End Sub


Private Sub Form_Timer()

Static intCounter As Integer
intCounter = intCounter + 1

If intCounter <> 21 Then Me.Controls("Box" & intCounter).Visible = True
If intCounter <> 21 Then Me.lblStatus.Caption = intCounter * 5 & "% Complete"
If intCounter = 21 Then
  
  Me.lblStatus.Caption = ""
  Me.TimerInterval = 0
  intCounter = 0
  Dim i As Integer
  For i = 1 To 20
    Me.Controls("Box" & i).Visible = False
  Next i
End If

End Sub

 

[strongm]

I thought we'd pretty much covered this in thread705-1702261

 

[patriciaxxx]

I couldn’t find a way to use the example in that thread to drive the meter for the duration of the call as I describe in this thread. But thank you for your reply.

 

[strongm]

You don't have a lot of choice about this. VBA is single-threaded. You cannot run an atomic function and expect VBA to do anything else at the "same time", even if you use a Form timer (timer runs in the same thread as the rest of the program). The only way you can do it is the way I illustrated (run the atomic function asynchronously in its own thread).

Of course if the function is not atomic (i.e. we can yield to the OS now and again) then we have some leeway. But you still have the issue - as was also covered in the referenced thread - that if you do not know how long the function takes to run then you cannot have a progress bar. You want a thinking or activity bar.

This example requires a Form with a command button on it, a frame control (sized to how you want the activity bar to be), and a label

[blue]Option Compare Database
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Command0_Click()
    StartActivity
    Call Workarounds
    StopActivity
End Sub

' This is only here to set up the label to display the way we want
Private Sub Form_Open(Cancel As Integer)
    With Frame4
        lblStatus.Move .Left, .Top, 0#, .Height
    End With
    lblStatus.BackStyle = 1
    lblStatus.BackColor = &H7D491F
End Sub

Private Sub StartActivity()
    lblStatus.Width = 0
    Me.TimerInterval = 50
End Sub

Private Sub StopActivity()
    lblStatus.Width = 0
    Me.TimerInterval = 0
End Sub

Private Sub Form_Timer()
    lblStatus.Width = (lblStatus.Width + Frame4.Width / 100) Mod Frame4.Width
End Sub

Private Sub Workarounds()
    Dim lp As Long
    For lp = 1 To 300 ' Change this to change how long Workarounds runs for
        Sleep 50
        DoEvents 'Defer to OS to allow Form timer to do something
    Next
End Sub[/blue]

 

[patriciaxxx]

Many thanks strongm
I have implemented your ‘thinking bar’.
It’s a good solution.

 

[patriciaxxx]

I’m trying to modify the thinking bar example kindly provided by strongm and have come up with 2 problems.

Firstly I need to free up the FormTimer event, so how do I use the Timer function instead. Having the Thinking bar stop when the Timer function has completed whatever duration I set also variable for rate/speed at which it moves.

And second how do I have the label set to a fixed width which I set, then have the label move to the end of the ‘Frame4’ and repeat this action for the duration set by the Timer function.

I have tried the following line of code where I set the lblStatus width to 1cm :

lblStatus.Left = (lblStatus.Left + Frame4.Width / 100) Mod Frame4.Width

Which moves the label and repeats the action for whatever duration was set, but the label runs short and/or over the Frame4 width, the end and start position of the label is all over the place.

Any help fixing this and using it with the Timer function would be much appreciated.

 

[strongm]

>so how do I use the Timer function instead

What Timer function?

>how do I have the label set to a fixed width which I set, then have the label move to the end of the ‘Frame4’ and repeat this action

Not quite sure that I follow exactly what you are trying to achieve with this.

 

[patriciaxxx]

Hello strongm, thank you for your reply.

I found this Timer function in the Access help file, but I couldn’t work out how to use it as I describe in this thread:

‘Timer Function Example
‘This example uses the Timer function to pause the application. The example also uses 
‘DoEvents to yield to other processes during the pause.
Dim PauseTime, Start, Finish, TotalTime
If (MsgBox("Press Yes to pause for 5 seconds", 4)) = vbYes Then
    PauseTime = 5    ' Set duration.
    Start = Timer    ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents    ' Yield to other processes.
    Loop
    Finish = Timer    ' Set end time.
    TotalTime = Finish - Start    ' Calculate total time.
    MsgBox "Paused for " & TotalTime & " seconds"
Else
    End
End If

I’m trying to move the label along the width of the Frame4 control.

Let me explain further. In your example the labels width begins as 0 then grows until it fills Frame4 and starts again doing this for however long Workarounds runs for. I want the labels width to start as say 1cm and move, from its left position, to the end of Frame4 (keeping its width as 1cm) and start again doing this for however long Workarounds runs for, and use the above Timer example with duration and speed/rate variables in place of the Forms Timer event.

 

[strongm]

> but I couldn’t work out how to use it as I describe in this thread

No, because it isn't a replacement of any sort for the Form Timer, which raises an event, and without an event we cannot steal program control away from (in this case) your WorkArounds sub even if you include a DoEvents.

The Form timer works by configuring an OS timer to insert a timer event message into the application's message queue which, when VB sees the message, causes it to run the associated OnTimer event. DoEvents works by temporarily suspending the current flow of your VBA program and allowing the OS and VB to process any pending messages in the message queue - which means that VB gets to run the OnTimer event if it finds the right message in the queue. You cannot achieve the same effect with the Timer function, which simply reports an elapsed time.

>I want the labels width to start as say 1cm and move, from its left position, to the end of Frame4 (keeping its width as 1cm)

pretty straightforward. Here's Form_Timer modified to do what I think you re asking for here:

[blue]Private Sub Form_Timer()
    Static LeftPos As Double
    Dim BlockWidth As Long
    
    BlockWidth = 200
    LeftPos = (LeftPos + (Frame4.Width - BlockWidth) / 100) Mod (Frame4.Width - BlockWidth)
    lblStatus.Left = Frame4.Left + LeftPos 
    lblStatus.Width = BlockWidth
End Sub[/blue]

 

[patriciaxxx]

Hello strongm, thank you for explaining the Timer fuction, which I now understand.

The modification to the Form_Timer does achieve what I was looking for, thank you. Is it possible to include 2 adjustment variables one for the left position and one for the right because the label overshoots the Frame a little (with these adjustment variables I can change their values until I get the effect just right).

 

[strongm]

>because the label overshoots the Frame a little


That's simply because this was an illustrative example and does not include all the nuances of a final solution. Basically the issue here is simply that the code does not take into account the width of the frame's border. Two pretty minor changes should deal with that:

[blue]Private Sub Form_Timer()
    Static LeftPos As Double
    Dim BlockWidth As Long
    
    BlockWidth = 200 [red][b]- Frame4.BorderWidth * 2[/b][/red]
    LeftPos = (LeftPos + (Frame4.Width - BlockWidth) / 100) Mod (Frame4.Width - BlockWidth)
    lblStatus.Left = Frame4.Left + LeftPos
    lblStatus.Width = BlockWidth
End Sub[/blue]

and

[blue][green]' This is only here to set up the label to display the way we want[/green]
Private Sub Form_Open(Cancel As Integer)
    With Frame4
        lblStatus.Move .Left, .Top, 0#, .Height [red][b]- .BorderWidth * 2[/b][/red]
    End With
    lblStatus.BackStyle = 1
    lblStatus.BackColor = &H7D491F
End Sub[/blue]

 

[patriciaxxx]

Hello strongm,

I made those changes but whatever value I set I couldn’t see it work, so I changed the * 2 to + 2 (well + and my value) and that did it, now it’s just right.

Thank you for taking the time to pass on some of your knowledge and experience in this thread.