[AccessD] Expressing seconds in hours / minutes / seconds

Joshua B lists at jbsolutions.com.au
Thu Feb 12 22:06:32 CST 2004


Hi John,

I have no idea where I got this from, but it's been sitting in my code snippets for ages and works like a dream converting numbers to strings...

Function ConvertNumberToEnglishString(ByVal N As Long) As String
    Const Thousand = 1000&
    Const Million = Thousand * Thousand
    Const Billion = Thousand * Million
    'Const Trillion = Thousand * Billion

    Dim Buf As String: Buf = ""

    If (N = 0) Then ConvertNumberToEnglishString = "zero": Exit Function

    If (N < 0) Then Buf = "negative ": N = -N

    If (N >= Billion) Then
        Buf = Buf & EnglishDigitGroup(N \ Billion) & " billion"
        N = N Mod Billion
        If (N) Then Buf = Buf & " "
    End If

    If (N >= Million) Then
        Buf = Buf & EnglishDigitGroup(N \ Million) & " million"
        N = N Mod Million
        If (N) Then Buf = Buf & " "
    End If

    If (N >= Thousand) Then
        Buf = Buf & EnglishDigitGroup(N \ Thousand) & " thousand"
        N = N Mod Thousand
        If (N) Then Buf = Buf & " "
    End If

    If (N > 0) Then
        Buf = Buf & EnglishDigitGroup(N)
    End If

    ConvertNumberToEnglishString = Buf
End Function

Private Function EnglishDigitGroup(ByVal N As Integer) As String
    Const Hundred = " hundred"
    Const One = "one"
    Const Two = "two"
    Const Three = "three"
    Const Four = "four"
    Const Five = "five"
    Const Six = "six"
    Const Seven = "seven"
    Const Eight = "eight"
    Const Nine = "nine"
    Dim Buf As String: Buf = ""
    Dim Flag As Integer: Flag = False

    'Do hundreds
    Select Case (N \ 100)
    Case 0: Buf = "":  Flag = False
    Case 1: Buf = One & Hundred: Flag = True
    Case 2: Buf = Two & Hundred: Flag = True
    Case 3: Buf = Three & Hundred: Flag = True
    Case 4: Buf = Four & Hundred: Flag = True
    Case 5: Buf = Five & Hundred: Flag = True
    Case 6: Buf = Six & Hundred: Flag = True
    Case 7: Buf = Seven & Hundred: Flag = True
    Case 8: Buf = Eight & Hundred: Flag = True
    Case 9: Buf = Nine & Hundred: Flag = True
    End Select
   
    If (Flag) Then N = N Mod 100
    If (N) Then
        If (Flag) Then Buf = Buf & " "
    Else
        EnglishDigitGroup = Buf
        Exit Function
    End If
      
    'Do tens (except teens)
    Select Case (N \ 10)
    Case 0, 1: Flag = False
    Case 2: Buf = Buf & "twenty": Flag = True
    Case 3: Buf = Buf & "thirty": Flag = True
    Case 4: Buf = Buf & "forty": Flag = True
    Case 5: Buf = Buf & "fifty": Flag = True
    Case 6: Buf = Buf & "sixty": Flag = True
    Case 7: Buf = Buf & "seventy": Flag = True
    Case 8: Buf = Buf & "eighty": Flag = True
    Case 9: Buf = Buf & "ninety": Flag = True
    End Select
   
    If (Flag) Then N = N Mod 10
    If (N) Then
        If (Flag) Then Buf = Buf & "-"
    Else
        EnglishDigitGroup = Buf
        Exit Function
    End If
    
    'Do ones and teens
    Select Case (N)
    Case 0: ' do nothing
    Case 1: Buf = Buf & One
    Case 2: Buf = Buf & Two
    Case 3: Buf = Buf & Three
    Case 4: Buf = Buf & Four
    Case 5: Buf = Buf & Five
    Case 6: Buf = Buf & Six
    Case 7: Buf = Buf & Seven
    Case 8: Buf = Buf & Eight
    Case 9: Buf = Buf & Nine
    Case 10: Buf = Buf & "ten"
    Case 11: Buf = Buf & "eleven"
    Case 12: Buf = Buf & "twelve"
    Case 13: Buf = Buf & "thirteen"
    Case 14: Buf = Buf & "fourteen"
    Case 15: Buf = Buf & "fifteen"
    Case 16: Buf = Buf & "sixteen"
    Case 17: Buf = Buf & "seventeen"
    Case 18: Buf = Buf & "eighteen"
    Case 19: Buf = Buf & "nineteen"
    End Select

    EnglishDigitGroup = Buf
End Function


======= At 2004-02-12, 22:47:00 you wrote: =======

>Well... I was really hoping for a "check writer" kind of interpretation,
>Three minutes and fifty one seconds.
>
>However I can always revisit this later if necessary so I'll go with yours.
>
>Thanks,
>
>John W. Colby
>www.ColbyConsulting.com

= = = = = = = = = = = = = = = = = = = =
			

Best regards.				 
Joshua B
lists at jbsolutions.com.au
www.jbsolutions.com.au
2004-02-13




More information about the AccessD mailing list