home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / numconv / numconv.ex_ / numconv.ex / 3081 / SOURCE / 4 < prev    next >
Encoding:
Text File  |  1999-07-20  |  5.2 KB  |  174 lines
  1. Attribute VB_Name = "mdlNum2Word"
  2. Enum rModes
  3.     Normal = 0
  4.     Placement = 1
  5. End Enum
  6.  
  7. Function Num2Word(Number As Double, rMode As rModes)
  8. On Error GoTo error
  9. Dim Num As Long
  10. Num = Int(Abs(Number))
  11. If Number < 0 Then Num2Word = "negative "
  12. If Len(CStr(Num)) > 9 Then GoTo error
  13. Dim Un As Integer, Th As Integer, Mi As Integer
  14. Un = (Num Mod 1000)
  15. If Num > 999 Then Th = Int((Num Mod 1000000 - Un) / 1000)
  16. If Num > 999999 Then Mi = Int((Num Mod 1000000000 - Th) / 1000000)
  17. If Mi > 0 Then
  18.     Num2Word = Num2Word & Group(Mi) & " million"
  19.     If Th = 0 And Un = 0 And rMode = Placement Then
  20.         Num2Word = Num2Word & "th"
  21.         GoTo Fraction
  22.     End If
  23. End If
  24. If Th > 0 Then
  25.     If Mi <> 0 Then Num2Word = Num2Word & ", "
  26.     Num2Word = Num2Word & Group(Th) & " thousand"
  27.     If Un = 0 And rMode = Placement Then
  28.         Num2Word = Num2Word & "th"
  29.         GoTo Fraction
  30.     End If
  31. End If
  32. If Un > 0 Then
  33.     If Mi > 0 Or Th > 0 Then
  34.         If Un < 100 Then
  35.             Num2Word = Num2Word & " and "
  36.         Else
  37.             Num2Word = Num2Word & ", "
  38.         End If
  39.     End If
  40.     Num2Word = Num2Word & Group(Un, rMode)
  41. End If
  42. Fraction:
  43. If rMode = Normal And Fr(Number) <> 0 Then Num2Word = Num2Word & Fraction(Number)
  44. Exit Function
  45. error:
  46. Num2Word = "Error"
  47. End Function
  48.  
  49. Function Group(ByVal Number As Integer, Optional rMode As rModes = Normal)
  50. If Number > 99 Then
  51.     Group = BaseNorm(Left(CStr(Number), 1)) & " hundred"
  52.     If rMode = Placement And Number Mod 100 = 0 Then Group = Group & "th"
  53.     If Number Mod 100 <> 0 Then Group = Group & " and "
  54. End If
  55. If Mid(Format(Number, "000"), 2, 1) <> "0" And Mid(Format(Number, "000"), 2, 1) <> "1" Then
  56.     If rMode = Placement And Number Mod 10 = 0 Then
  57.         Group = Group & BasePlace(Val(Mid(Format(Number, "000"), 2, 1) & "0"))
  58.     Else
  59.         Group = Group & BaseNorm(Val(Mid(Format(Number, "000"), 2, 1) & "0"))
  60.     End If
  61.     If Number Mod 10 <> 0 Then Group = Group & "-"
  62. End If
  63. If Number < 20 Then
  64.     If rMode = Normal Then Group = BaseNorm(Number) Else Group = BasePlace(Number)
  65.     Exit Function
  66. End If
  67. Number = Number Mod 100
  68. If Number > 19 Then Number = Number Mod 10
  69. If Number = 0 Then Exit Function
  70. If rMode = Normal Then
  71.     Group = Group & BaseNorm(Number)
  72. Else
  73.     Group = Group & BasePlace(Number)
  74. End If
  75. End Function
  76.  
  77. Private Function BaseNorm(ByVal Number As Integer)
  78. Select Case Number
  79. Case 0: BaseNorm = "zero"
  80. Case 1: BaseNorm = "one"
  81. Case 2: BaseNorm = "two"
  82. Case 3: BaseNorm = "three"
  83. Case 4: BaseNorm = "four"
  84. Case 5: BaseNorm = "five"
  85. Case 6: BaseNorm = "six"
  86. Case 7: BaseNorm = "seven"
  87. Case 8: BaseNorm = "eight"
  88. Case 9: BaseNorm = "nine"
  89. Case 10: BaseNorm = "ten"
  90. Case 11: BaseNorm = "eleven"
  91. Case 12: BaseNorm = "twelve"
  92. Case 13: BaseNorm = "thirteen"
  93. Case 14: BaseNorm = "fourteen"
  94. Case 15: BaseNorm = "fifteen"
  95. Case 16: BaseNorm = "sixteen"
  96. Case 17: BaseNorm = "seventeen"
  97. Case 18: BaseNorm = "eighteen"
  98. Case 19: BaseNorm = "nineteen"
  99. Case 20: BaseNorm = "twenty"
  100. Case 30: BaseNorm = "thirty"
  101. Case 40: BaseNorm = "forty"
  102. Case 50: BaseNorm = "fifty"
  103. Case 60: BaseNorm = "sixty"
  104. Case 70: BaseNorm = "seventy"
  105. Case 80: BaseNorm = "eighty"
  106. Case 90: BaseNorm = "ninety"
  107. End Select
  108. End Function
  109.  
  110. Private Function BasePlace(ByVal Number As Long)
  111. Select Case Number
  112. Case 1: BasePlace = "first"
  113. Case 2: BasePlace = "second"
  114. Case 3: BasePlace = "third"
  115. Case 4: BasePlace = "forth"
  116. Case 5: BasePlace = "fifth"
  117. Case 6: BasePlace = "sixth"
  118. Case 7: BasePlace = "seventh"
  119. Case 8: BasePlace = "eighth"
  120. Case 9: BasePlace = "nineth"
  121. Case 10: BasePlace = "tenth"
  122. Case 11: BasePlace = "eleventh"
  123. Case 12: BasePlace = "twelfth"
  124. Case 13: BasePlace = "thirteenth"
  125. Case 14: BasePlace = "fourteenth"
  126. Case 15: BasePlace = "fifteenth"
  127. Case 16: BasePlace = "sixteenth"
  128. Case 17: BasePlace = "seventeenth"
  129. Case 18: BasePlace = "eighteenth"
  130. Case 19: BasePlace = "nineteenth"
  131. Case 20: BasePlace = "twentieth"
  132. Case 30: BasePlace = "thirtieth"
  133. Case 40: BasePlace = "fortieth"
  134. Case 50: BasePlace = "fiftieth"
  135. Case 60: BasePlace = "sixtieth"
  136. Case 70: BasePlace = "seventieth"
  137. Case 80: BasePlace = "eightieth"
  138. Case 90: BasePlace = "ninetieth"
  139. End Select
  140. End Function
  141.  
  142. Function Fraction(Number As Double)
  143. Dim Num As String: Num = Fr(Number)
  144. Select Case Num
  145.     Case "5": Fraction = " and a half"
  146.     Case "25": Fraction = " and a quarter"
  147.     Case "75": Fraction = " and three quarters"
  148.     Case "2": Fraction = " and a fifth"
  149.     Case "4": Fraction = " and two fifths"
  150.     Case "6": Fraction = " and three fifths"
  151.     Case "8": Fraction = " and four fifths"
  152.     Case "125": Fraction = " and an eighth"
  153.     Case "375": Fraction = " and three eighths"
  154.     Case "625": Fraction = " and five eighths"
  155.     Case "875": Fraction = " and seven eighths"
  156.     Case Else
  157.         Fraction = " point"
  158.         For i = 1 To Len(Num)
  159.             Fraction = Fraction & " " & BaseNorm(Mid(Num, i, 1))
  160.         Next i
  161. End Select
  162. End Function
  163.  
  164. Private Function Fr(Number As Double)
  165. For i = 1 To Len(CStr(Number))
  166.     If Mid(CStr(Number), i, 1) = "." Then
  167.         For j = i + 1 To Len(CStr(Number))
  168.             Fr = Fr & Mid(CStr(Number), j, 1)
  169.         Next j
  170.         Exit Function
  171.     End If
  172. Next i
  173. End Function