GFTimeRemaining/Testfrm.frm

VERSION 5.00
Begin VB.Form Testfrm
   Caption         =   "GFTimeRemaining"
   ClientHeight    =   3075
   ClientLeft      =   60
   ClientTop       =   465
   ClientWidth     =   4635
   LinkTopic       =   "Form1"
   ScaleHeight     =   3075
   ScaleWidth      =   4635
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.CommandButton Command1
      Caption         =   "Loop Test"
      Height          =   315
      Left            =   2580
      TabIndex        =   0
      Top             =   2400
      Width           =   1935
   End
End
Attribute VB_Name = "Testfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2002 by Louis. Use to calculate the remaining time during any larger process.
'GFTimeRemaining
Private Declare Function GetTickCount Lib "kernel32" () As Long
'GFTimeRemainingStruct
Private Type GFTimeRemainingStruct
    ProcessStartedFlag As Boolean 'if data below is valid
    ProcessStartTickCount As Long
    ProcessValueCurrent As Double
    ProcessValueMax As Double
    SecondsRemainingMin As Long
End Type
Dim GFTimeRemainingStructVar As GFTimeRemainingStruct
'DEBUG
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'END OF DEBUG

'DEBUG

Private Sub Command1_Click()
    'on error resume next
    Dim Temp As Long
    'begin
    Call GFTimeRemaining_Start
    For Temp = 1 To 10000
        Call Sleep(Int((50 ‑ 10 + 1) * Rnd(1) + 10))
        Call GFTimeRemaining_ReceiveTime(CDbl(Temp), CDbl(10000))
        Debug.Print GFTimeRemaining_GetTimePassed, GFTimeRemaining_GetTimeRemaining
    Next Temp
    Call GFTimeRemaining_Stop
End Sub

'END OF DEBUG

'************************************GFTIMEREMAINING************************************
'NOTE: the GFTimeRemaining code can be used to calculate and display the
'remaining time a process requires before it will be finished.
'Note that the current code is v1.0 (not so good yet).

Private Sub GFTimeRemaining_Start()
    'on error resume next
    If GFTimeRemainingStructVar.ProcessStartedFlag = False Then 'verify
        GFTimeRemainingStructVar.ProcessStartTickCount = GetTickCount()
        GFTimeRemainingStructVar.SecondsRemainingMin = 256& ^ 3&
        GFTimeRemainingStructVar.ProcessStartedFlag = True
    End If
End Sub

Private Sub GFTimeRemaining_ReceiveTime(ByVal ProcessValueCurrent As Double, ByVal ProcessValueMax As Double)
    'on error resume next
    If GFTimeRemainingStructVar.ProcessStartedFlag = True Then 'verify
        GFTimeRemainingStructVar.ProcessValueCurrent = ProcessValueCurrent
        GFTimeRemainingStructVar.ProcessValueMax = ProcessValueMax
    End If
End Sub

Private Function GFTimeRemaining_GetTimeRemaining() As String
    'on error resume next 'returns a string giving information about the remaining process time
    Dim SecondsPassed As Long
    Dim SecondsPassedDouble As Double
    Dim SecondsRemaining As Long
    'verify
    If GFTimeRemainingStructVar.ProcessStartedFlag = False Then 'verify
        GFTimeRemaining_GetTimeRemaining = "internal error in GFTimeRemaining_GetTimeRemaining() !" 'error
        Exit Function
    End If
    'begin
    If ((GFTimeRemainingStructVar.ProcessValueCurrent / GFTimeRemainingStructVar.ProcessValueMax) > 0.05) And _
        ((CSng(GetTickCount ‑ GFTimeRemainingStructVar.ProcessStartTickCount) / 1000!) > 2.5!) Then
        '
        'NOTE: the progress must exceed 5 percent and the passed time must
        'exceed 2.5 seconds until the calculated remaining time is returned.
        '
        SecondsPassed = CLng(CSng(GetTickCount ‑ GFTimeRemainingStructVar.ProcessStartTickCount) / 1000!)
        SecondsPassedDouble = CDbl(GetTickCount ‑ GFTimeRemainingStructVar.ProcessStartTickCount) / 1000#
        SecondsRemaining = CLng((GFTimeRemainingStructVar.ProcessValueMax / GFTimeRemainingStructVar.ProcessValueCurrent * CDbl(SecondsPassedDouble)) ‑ SecondsPassedDouble) 'do not used the rounded value of SecondsPassed
        If SecondsRemaining < 0 Then SecondsRemaining = 0 'verify (looks stupid otherwise)
        GFTimeRemaining_GetTimeRemaining = GFTimeRemaining_GetTimeRemainingString(SecondsRemaining) 'ok
    Else
        GFTimeRemaining_GetTimeRemaining = "" 'ok
    End If
End Function

Private Function GFTimeRemaining_GetTimePassed() As String
    'on error resume next 'returns a string giving information about the time passed
    'verify
    If GFTimeRemainingStructVar.ProcessStartedFlag = False Then 'verify
        GFTimeRemaining_GetTimePassed = "internal error in GFTimeRemaining_GetTimePassed() !" 'error
        Exit Function
    End If
    'begin
    GFTimeRemaining_GetTimePassed = _
        GFTimeRemaining_GetTimeRemainingString((GetTickCount ‑ GFTimeRemainingStructVar.ProcessStartTickCount) / 1000&)
End Function

Private Function GFTimeRemaining_GetTimeRemainingString(ByVal SecondsPassed As Long) As String
    'on error resume next 'to be called by GFTimeRemaining_GetTimeRemaining() only
    Dim TimeHours As Long
    Dim TimeHoursString As String
    Dim TimeMinutes As Long
    Dim TimeMinutesString As String
    Dim TimeSeconds As Long
    Dim TimeSecondsString As String
    'begin
    '
    TimeHours = Int(CSng(SecondsPassed) / 3600!)
    SecondsPassed = SecondsPassed ‑ TimeHours * 3600&
    TimeMinutes = Int(CSng(SecondsPassed) / 60!)
    SecondsPassed = SecondsPassed ‑ TimeMinutes * 60&
    TimeSeconds = SecondsPassed
    '
    TimeHoursString = LTrim$(Str$(TimeHours))
    If Len(TimeHoursString) = 1 Then TimeHoursString = "0" + TimeHoursString
    TimeMinutesString = LTrim$(Str$(TimeMinutes))
    If Len(TimeMinutesString) = 1 Then TimeMinutesString = "0" + TimeMinutesString
    TimeSecondsString = LTrim$(Str$(TimeSeconds))
    If Len(TimeSecondsString) = 1 Then TimeSecondsString = "0" + TimeSecondsString
    '
    GFTimeRemaining_GetTimeRemainingString = TimeHoursString + ":" + TimeMinutesString + ":" + TimeSecondsString
End Function

Private Sub GFTimeRemaining_Stop()
    'on error resume next
    GFTimeRemainingStructVar.ProcessStartedFlag = False
End Sub

'********************************END OF GFTIMEREMAINING*********************************


[END OF FILE]