home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / ch15 / numstr / strclass.cls < prev    next >
Encoding:
Visual Basic class definition  |  1998-07-02  |  4.9 KB  |  165 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "StringClass"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Private BinaryDigits(16) As String
  15. Private NDigits(20) As String
  16. Private NTens(10) As String
  17.  
  18. Private Sub Class_Initialize()
  19. BinaryDigits(0) = "0000"
  20. BinaryDigits(1) = "0001"
  21. BinaryDigits(2) = "0010"
  22. BinaryDigits(3) = "0011"
  23. BinaryDigits(4) = "0100"
  24. BinaryDigits(5) = "0101"
  25. BinaryDigits(6) = "0110"
  26. BinaryDigits(7) = "0111"
  27. BinaryDigits(8) = "1000"
  28. BinaryDigits(9) = "1001"
  29. BinaryDigits(10) = "1010"
  30. BinaryDigits(11) = "1011"
  31. BinaryDigits(12) = "1100"
  32. BinaryDigits(13) = "1101"
  33. BinaryDigits(14) = "1110"
  34. BinaryDigits(15) = "1111"
  35.  
  36. NDigits(1) = "one"
  37. NDigits(2) = "two"
  38. NDigits(3) = "three"
  39. NDigits(4) = "four"
  40. NDigits(5) = "five"
  41. NDigits(6) = "six"
  42. NDigits(7) = "seven"
  43. NDigits(8) = "eight"
  44. NDigits(9) = "nine"
  45. NDigits(10) = "ten"
  46. NDigits(11) = "eleven"
  47. NDigits(12) = "twelve"
  48. NDigits(13) = "thirteen"
  49. NDigits(14) = "fourteen"
  50. NDigits(15) = "fifteen"
  51. NDigits(16) = "sixteen"
  52. NDigits(17) = "seventeen"
  53. NDigits(18) = "eighteen"
  54. NDigits(19) = "nineteen"
  55.  
  56. NTens(2) = "twenty"
  57. NTens(3) = "thirty"
  58. NTens(4) = "forty"
  59. NTens(5) = "fifty"
  60. NTens(6) = "sixty"
  61. NTens(7) = "seventy"
  62. NTens(8) = "eighty"
  63. NTens(9) = "ninety"
  64. End Sub
  65.  
  66.  
  67. Private Function ReadSingle(Number) As String
  68.     If Number > 0 And Number < 20 Then
  69.         ReadSingle = NDigits(Number)
  70.     Else
  71.         ReadSingle = "*****"
  72.     End If
  73. End Function
  74.  
  75. Private Function ReadTenths(Number)
  76.     tnumber = Int(Number / 10)
  77.     If tnumber > 1 And tnumber < 10 Then
  78.         ReadTenths = NTens(tnumber)
  79.     Else
  80.         ReadTenths = "*****"
  81.     End If
  82. End Function
  83.  
  84. 'This is the routine to read numbers
  85. Public Function Number2String(Number)
  86. Dim tenth As Integer
  87. Dim leftover As Integer
  88. Dim hundred As Integer
  89. Dim thousand As Integer
  90.         
  91.     If Number < 20 Then         'Reads unique numbers
  92.         NumString = ReadSingle(Number)
  93.     ElseIf Number < 100 Then    'Reads numbers less than 100
  94.         tenth = Fix(Number / 10)
  95.         NumString = ReadTenths(tenth * 10)
  96.         leftover = Number - (tenth * 10)
  97.         If leftover > 0 Then
  98.             NumString = NumString & " " & ReadSingle(leftover)
  99.         End If
  100.     ElseIf Number < 1000 Then   'Reads numbers between 100 and 999
  101.         hundred = Fix(Number / 100)
  102.         NumString = ReadSingle(hundred) & " hundred"
  103.         leftover = Number - (hundred * 100)
  104.         If leftover > 0 Then
  105.             tenth = Fix(leftover / 10)
  106.             If tenth > 0 Then NumString = NumString & " " & ReadTenths(tenth * 10)
  107.             leftover = Number - (hundred * 100) - (tenth * 10)
  108.             If leftover > 0 Then
  109.                 NumString = NumString & " " & ReadSingle(leftover)
  110.             End If
  111.         End If
  112.     Else                        'Reads number between 1000 and 9999
  113.         thousand = Fix(Number / 1000)
  114.         NumString = ReadSingle(thousand) & " thousand"
  115.         leftover = Number - (thousand * 1000)
  116.         If leftover > 0 Then
  117.             hundred = Fix(leftover / 100)
  118.             If hundred > 0 Then
  119.                 NumString = NumString & " " & ReadSingle(hundred) & " hundred"
  120.             End If
  121.             leftover = Number - (thousand * 1000) - (hundred * 100)
  122.             If leftover > 0 Then
  123.                 tenth = Fix(leftover / 10)
  124.                 If tenth > 0 Then
  125.                     NumString = NumString & " " & ReadTenths(tenth * 10)
  126.                 End If
  127.                 leftover = Number - (thousand * 1000) - (hundred * 100) - (tenth * 10)
  128.                 If leftover > 0 Then
  129.                     NumString = NumString & " " & ReadSingle(leftover)
  130.                 End If
  131.             End If
  132.         End If
  133.     End If
  134.     Number2String = NumString
  135. End Function
  136.  
  137. Public Function LowerCaps(str As String) As String
  138. Dim newWord As String, newStr As String
  139. Dim tempStr As String
  140. Dim WDelimiter As Integer
  141.  
  142.     tempStr = Trim(str)
  143.     WDelimiter = InStr(tempStr, " ")
  144.     While WDelimiter > 0
  145.         newWord = Left(tempStr, WDelimiter)
  146.         tempStr = Right(tempStr, Len(tempStr) - WDelimiter)
  147.         newStr = newStr & UCase(Left(newWord, 1)) & Mid(newWord, 2, Len(newWord) - 1)
  148.         WDelimiter = InStr(tempStr, " ")
  149.     Wend
  150.     newWord = tempStr
  151.     newStr = newStr & UCase(Left(newWord, 1)) & Mid(newWord, 2, Len(newWord) - 1)
  152.     LowerCaps = newStr
  153. End Function
  154.  
  155. Public Function Integer2Binary(ByVal Number As Long) As String
  156.     HexNum = Hex(Number)
  157.     For i = 1 To Len(HexNum)
  158.         BinNum = BinNum & BinaryDigits("&H" & Mid(HexNum, i, 1))
  159.     Next
  160.     Integer2Binary = BinNum
  161. End Function
  162.  
  163.  
  164.  
  165.