102 lines
4.1 KiB
VB.net
102 lines
4.1 KiB
VB.net
Attribute VB_Name = "ProgressDialogue"
|
|
Option Explicit
|
|
|
|
Dim Cancelled As Boolean, showTime As Boolean, showTimeLeft As Boolean
|
|
Dim startTime As Long
|
|
Dim BarMin As Long, BarMax As Long, BarVal As Long
|
|
|
|
Private Declare PtrSafe Function GetTickCount Lib "Kernel32" () As Long
|
|
|
|
'Title will be the title of the dialogue.
|
|
'Status will be the label above the progress bar, and can be changed with SetStatus.
|
|
'Min is the progress bar minimum value, only set by calling configure.
|
|
'Max is the progress bar maximum value, only set by calling configure.
|
|
'CancelButtonText is the caption of the cancel button. If set to vbNullString, it is hidden.
|
|
'optShowTimeElapsed controls whether the progress bar computes and displays the time elapsed.
|
|
'optShowTimeRemaining controls whether the progress bar estimates and displays the time remaining.
|
|
'calling Configure sets the current value equal to Min.
|
|
'calling Configure resets the current run time.
|
|
Public Sub Configure(ByVal title As String, ByVal status As String, _
|
|
ByVal Min As Long, ByVal Max As Long, _
|
|
Optional ByVal CancelButtonText As String = "Cancel", _
|
|
Optional ByVal optShowTimeElapsed As Boolean = True, _
|
|
Optional ByVal optShowTimeRemaining As Boolean = True)
|
|
Me.Caption = title
|
|
lblStatus.Caption = status
|
|
BarMin = Min
|
|
BarMax = Max
|
|
BarVal = Min
|
|
CancelButton.Visible = Not CancelButtonText = vbNullString
|
|
CancelButton.Caption = CancelButtonText
|
|
startTime = GetTickCount
|
|
showTime = optShowTimeElapsed
|
|
showTimeLeft = optShowTimeRemaining
|
|
lblRunTime.Caption = ""
|
|
lblRemainingTime.Caption = ""
|
|
Cancelled = False
|
|
End Sub
|
|
|
|
'Set the label text above the status bar
|
|
Public Sub SetStatus(ByVal status As String)
|
|
lblStatus.Caption = status
|
|
DoEvents
|
|
End Sub
|
|
|
|
'Set the value of the status bar, a long which is snapped to a value between Min and Max
|
|
Public Sub SetValue(ByVal value As Long)
|
|
If value < BarMin Then value = BarMin
|
|
If value > BarMax Then value = BarMax
|
|
Dim progress As Double, runTime As Long
|
|
BarVal = value
|
|
progress = (BarVal - BarMin) / (BarMax - BarMin)
|
|
ProgressBar.Width = 292 * progress
|
|
lblPercent = Int(progress * 10000) / 100 & "%"
|
|
runTime = GetRunTime()
|
|
If showTime Then lblRunTime.Caption = "Time Elapsed: " & GetRunTimeString(runTime, True)
|
|
If showTimeLeft And progress > 0 Then _
|
|
lblRemainingTime.Caption = "Est. Time Left: " & GetRunTimeString(runTime * (1 - progress) / progress, False)
|
|
DoEvents
|
|
End Sub
|
|
|
|
'Get the time (in milliseconds) since the progress bar "Configure" routine was last called
|
|
Public Function GetRunTime() As Long
|
|
GetRunTime = GetTickCount - startTime
|
|
End Function
|
|
|
|
'Get the time (in hours, minutes, seconds) since "Configure" was last called
|
|
Public Function GetFormattedRunTime() As String
|
|
GetFormattedRunTime = GetRunTimeString(GetTickCount - startTime)
|
|
End Function
|
|
|
|
'Formats a time in milliseconds as hours, minutes, seconds.milliseconds
|
|
'Milliseconds are excluded if showMsecs is set to false
|
|
Private Function GetRunTimeString(ByVal runTime As Long, Optional ByVal showMsecs As Boolean = True) As String
|
|
Dim msecs&, hrs&, mins&, secs#
|
|
msecs = runTime
|
|
hrs = Int(msecs / 3600000)
|
|
mins = Int(msecs / 60000) - 60 * hrs
|
|
secs = msecs / 1000 - 60 * (mins + 60 * hrs)
|
|
GetRunTimeString = IIf(hrs > 0, hrs & " hours ", "") _
|
|
& IIf(mins > 0, mins & " minutes ", "") _
|
|
& IIf(secs > 0, IIf(showMsecs, secs, Int(secs + 0.5)) & " seconds", "")
|
|
End Function
|
|
|
|
'Returns the current value of the progress bar
|
|
Public Function GetValue() As Long
|
|
GetValue = BarVal
|
|
End Function
|
|
|
|
'Returns whether or not the cancel button has been pressed.
|
|
'The ProgressDialogue must be polled regularily to detect whether cancel was pressed.
|
|
Public Function cancelIsPressed() As Boolean
|
|
cancelIsPressed = Cancelled
|
|
End Function
|
|
|
|
'Recalls that cancel was pressed so that they calling routine can be notified next time it asks.
|
|
Private Sub CancelButton_Click()
|
|
Cancelled = True
|
|
lblStatus.Caption = "Cancelled By User. Please Wait."
|
|
End Sub
|
|
|
|
|