Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX


Tip of the Day
Language: VB4,VB5,VB6,VBS
Expertise: Intermediate
Oct 9, 1999

TimeToString - Convert time to a descriptive string

' convert a date value into a string in the format
'     YY years, MM months, DD days, HH hours, MM minutes, SS.HH seconds)
' you can also opt for time short format (HH h, MM m, SS s)

Function TimeToString(ByVal aDate As Date, Optional ShortTimeFormat As Boolean, _
    Optional showHundredths As Boolean) As String

    Dim y As Long, m As Long, d As Long
    Dim ho As Long, mi As Long, se As Long, hu As Long
    Dim res As String
    Dim days As Double
    
    days = CDbl(aDate)
    
    ' evaluate (approximate) year, month, and day
    y = Int(days / 365.25)
    m = (days - Int(y * 365.25)) \ 30
    d = (days - Int(y * 365.25) - m * 30)
    
    ' make some adjustments
    If d >= 30 Then
        m = m + 1
        d = d Mod 30
    End If
    If m >= 12 Then
        y = y + 1
        m = m Mod 12
    End If
    
    ' evaluate hours, minutes, and seconds
    ' 8640000 = number of Hundredths of seconds in a day
    hu = (days - Int(days)) * 8640000
    ho = (hu \ 360000)
    mi = (hu - ho * 360000) \ 6000
    se = (hu - ho * 360000 - mi * 6000) \ 100
    hu = hu Mod 1000
    
    ' build the result string
    If y Then
        res = CStr(y) & " year" & IIf(y <> 1, "s", "") & ", "
    End If
    
    If m Or Len(res) Then
        res = res & CStr(m) & " month" & IIf(m <> 1, "s", "") & ", "
    End If
    
    If d Or Len(res) Then
        res = res & CStr(d) & " day" & IIf(d <> 1, "s", "") & ", "
    End If
    
    If ho Or Len(res) Then
        res = res & CStr(ho) & IIf(ShortTimeFormat, " h", " hour" & IIf(ho <> 1, _
            "s", "")) & ", "
    End If

    If mi Or Len(res) Then
        res = res & CStr(mi) & IIf(ShortTimeFormat, " m", _
            " minute" & IIf(mi <> 1, "s", "")) & ", "
    End If
        
    ' always display seconds
    res = res & CStr(se) & IIf(ShortTimeFormat, " s", " second" & IIf(se <> 1, _
        "s", ""))
    
    TimeToString = res
    
End Function
Francesco Balena
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
Thanks for your registration, follow us on our social networks to keep up-to-date