I haven't been doing much by way of programming due to a minor injury. But today I was working on converting some old VB code over to FB and thought that this might be of interest to someone. It is from my eariler VB days (so you are warned).
It names numbers using the format common in the USA. I have a few mates in the UK and AUS that gave me grief about that but you can change/use the code anyway you like.
In its defense though, it is by far more 'complete' than most other pieces of code that does this task.
NumberToWords
Numbers to words (US English)
..nice..
People don't include the word "quattuornonagintillion" enough in modern programs. I blame big corporations....
-
Hexadecimal Dude!
- Posts: 360
- Joined: Jun 07, 2005 20:59
- Location: england, somewhere around the middle
- Contact:
*In a jumpy tone*
You're right!
It's a conspiracy.... who benifits from us not knowing a big enough number to describe their anual turnover???
The big corporations!
*Glances aroung in a paraniod fashion*
Wait! They'd also benefit from people not finding out!
*Eyes widen*
run to the hills!
...aaaaaahhhhhhhhhhhhhh!
You're right!
It's a conspiracy.... who benifits from us not knowing a big enough number to describe their anual turnover???
The big corporations!
*Glances aroung in a paraniod fashion*
Wait! They'd also benefit from people not finding out!
*Eyes widen*
run to the hills!
...aaaaaahhhhhhhhhhhhhh!
I think this was AGA's codeGablea wrote:@Keeling
I know this is a old post but do you still have the code still? I have been looking for something like this for a while so i can add cheque printing to some EPoS Software I am desgining and this would be perfect
Hope to hear from you soon
Andy
Lot's of errors though but this might help. Assuming you can compile this.
Probably pre-0.20 FB code.
Code: Select all
OPTION EXPLICIT
CONST n2wFALSE AS BYTE = 0
CONST n2wTRUE AS BYTE = NOT n2wFALSEDIM bNumToWordInit AS BYTE
DIM SHARED strNumberWords(19) AS STRING
DIM SHARED strNumberGroups(100) AS STRING
DIM SHARED strNumberTenWords(2 TO 9) AS STRING
DECLARE FUNCTION NumberToWords(BYVAL vNumber AS STRING) AS STRING
DECLARE FUNCTION NumWord(tmpNumber AS STRING, _ Fractional AS BYTE = n2wFALSE) AS STRING
DECLARE FUNCTION n2wReplace (Expression AS STRING, Find AS STRING, _ WithWhat AS STRING) AS STRING DECLARE FUNCTION NumWord3(tmpNum AS STRING) AS STRING
DECLARE FUNCTION n2wIsNumeric(BYVAL vNumber AS STRING) AS BYTE
'array for values 0 to 19
strNumberWords(0) = "zero"
strNumberWords(1) = "one"
strNumberWords(2) = "two"
strNumberWords(3) = "three"
strNumberWords(4) = "four"
strNumberWords(5) = "five"
strNumberWords(6) = "six"
strNumberWords(7) = "seven"
strNumberWords(8) = "eight"
strNumberWords(9) = "nine"
strNumberWords(10) = "ten"
strNumberWords(11) = "eleven"
strNumberWords(12) = "twelve"
strNumberWords(13) = "thirteen"
strNumberWords(14) = "fourteen"
strNumberWords(15) = "fifteen"
strNumberWords(16) = "sixteen"
strNumberWords(17) = "seventeen"
strNumberWords(18) = "eightteen"
strNumberWords(19) = "nineteen"
'array for 10's digit
strNumberTenWords(2) = "twenty"
strNumberTenWords(3) = "thirty"
strNumberTenWords(4) = "forty"
strNumberTenWords(5) = "fifty"
strNumberTenWords(6) = "sixty"
strNumberTenWords(7) = "seventy"
strNumberTenWords(8) = "eighty"
strNumberTenWords(9) = "ninety"
'array for number groups or periods
'This information originally found at http://users.aol.com/AmazingMazeMan/numberingsystems.html
strNumberGroups(0) = "thousand" '1,000
strNumberGroups(1) = "million" '1,000,000
strNumberGroups(2) = "billion" '1,000,000,000
strNumberGroups(3) = "trillion" '1,000,000,000,000
strNumberGroups(4) = "quadrillion" '1,000,000,000,000,000
strNumberGroups(5) = "quintillion" '1,000,000,000,000,000,000
strNumberGroups(6) = "sextillion" '1,000,000,000,000,000,000,000
strNumberGroups(7) = "septillion" '1,000,000,000,000,000,000,000,000
strNumberGroups(8) = "octillion" '1,000,000,000,000,000,000,000,000,000
strNumberGroups(9) = "nonillion" '1,000,000,000,000,000,000,000,000,000,000
strNumberGroups(10) = "decillion" '1,000,000,000,000,000,000,000,000,000,000,000
strNumberGroups(11) = "undecillion" '1,000,000,000,000,000,000,000,000,000,000,000,000
strNumberGroups(12) = "duodecillion"
strNumberGroups(13) = "tredecillion" 'The latin roots of the numbers show the
strNumberGroups(14) = "quattuordecillion" '# of groups of 3-zeroes that follow 1000.
strNumberGroups(15) = "quindecillion" '2 = bi, 3 = tri, 4 = quad, 5 = quin, 6 = sex, 7 = sept
strNumberGroups(16) = "sexdecillion" '8=oct, 9=non, 10=decem, 20=vigin.
strNumberGroups(17) = "septendecillion"
strNumberGroups(18) = "octodecillion" 'Names for groups 3 to 63 come from several
strNumberGroups(19) = "novemdecillion" 'sources, both encyclopedic and dictionary.
strNumberGroups(20) = "vigintillion"
strNumberGroups(21) = "unvigintillion" 'Prefixes un-, duo-, tre-, quattuor, quin-,
strNumberGroups(22) = "duovigintillion" 'sex-, sept-, octo, and novem-, appear to
strNumberGroups(23) = "trevigintillion" 'modify TEN (decem) to make 11 to 19.
strNumberGroups(24) = "quattuorvigintillion"
strNumberGroups(25) = "quinvigintillion" 'I followed the same pattern before
strNumberGroups(26) = "sexvigintillion" 'vigintillion to create 21 to 29 sets
strNumberGroups(27) = "septenvigintillion" 'of 000's after 1,000.
strNumberGroups(28) = "octovigintillion"
strNumberGroups(29) = "novemvigintillion" 'decem = 10, viginti = 20, centi = 100#
strNumberGroups(30) = "trigintillion"
strNumberGroups(31) = "untrigintillion"
strNumberGroups(32) = "duotrigintillion"
strNumberGroups(33) = "tretrigintillion"
strNumberGroups(34) = "quattuortrigintillion"
strNumberGroups(35) = "quintrigintillion"
strNumberGroups(36) = "sextrigintillion"
strNumberGroups(37) = "septtrigintillion"
strNumberGroups(38) = "octotrigintillion"
strNumberGroups(39) = "novemtrigintillion"
strNumberGroups(40) = "quardragintillion"
strNumberGroups(41) = "unquardragintillion"
strNumberGroups(42) = "duoquardragintillion"
strNumberGroups(43) = "trequardragintillion"
strNumberGroups(44) = "quattuorquardragintillion"
strNumberGroups(45) = "quinquardragintillion"
strNumberGroups(46) = "sexquardragintillion"
strNumberGroups(47) = "septquardragintillion"
strNumberGroups(48) = "octoquardragintillion"
strNumberGroups(49) = "novemquardragintillion"
strNumberGroups(50) = "quinquagintillion"
strNumberGroups(51) = "unquinquagintillion"
strNumberGroups(52) = "duoquinquagintillion"
strNumberGroups(53) = "trequinquagintillion"
strNumberGroups(54) = "quattuorquinquagintillion"
strNumberGroups(55) = "quinquinquagintillion"
strNumberGroups(56) = "sexquinquagintillion"
strNumberGroups(57) = "septquinquagintillion"
strNumberGroups(58) = "octoquinquagintillion"
strNumberGroups(59) = "novemquinquagintillion"
strNumberGroups(60) = "sexagintillion"
strNumberGroups(61) = "unsexagintillion"
strNumberGroups(62) = "duosexagintillion"
strNumberGroups(63) = "tresexagintillion"
strNumberGroups(64) = "quattuorsexagintillion"
strNumberGroups(65) = "quinsexagintillion"
strNumberGroups(66) = "sexsexagintillion"
strNumberGroups(67) = "septsexagintillion"
strNumberGroups(68) = "octosexagintillion"
strNumberGroups(69) = "novemsexagintillion"
strNumberGroups(70) = "septuagintillion"
strNumberGroups(71) = "unseptuagintillion"
strNumberGroups(72) = "duoseptuagintillion"
strNumberGroups(73) = "treseptuagintillion"
strNumberGroups(74) = "quattuorseptuagintillion"
strNumberGroups(75) = "quinseptuagintillion"
strNumberGroups(76) = "sexseptuagintillion"
strNumberGroups(77) = "septseptuagintillion"
strNumberGroups(78) = "octoseptuagintillion"
strNumberGroups(79) = "novemseptuagintillion"
strNumberGroups(80) = "octogintillion"
strNumberGroups(81) = "unoctogintillion"
strNumberGroups(82) = "duooctogintillion"
strNumberGroups(83) = "treoctogintillion"
strNumberGroups(84) = "quattuoroctogintillion"
strNumberGroups(85) = "quinoctogintillion"
strNumberGroups(86) = "sexoctogintillion"
strNumberGroups(87) = "septoctogintillion"
strNumberGroups(88) = "octooctogintillion"
strNumberGroups(89) = "novemoctogintillion"
strNumberGroups(90) = "nonagintillion"
strNumberGroups(91) = "unnonagintillion"
strNumberGroups(92) = "duononagintillion"
strNumberGroups(93) = "trenonagintillion"
strNumberGroups(94) = "quattuornonagintillion"
strNumberGroups(95) = "quinnonagintillion"
strNumberGroups(96) = "sexnonagintillion"
strNumberGroups(97) = "septnonagintillion"
strNumberGroups(98) = "octononagintillion"
strNumberGroups(99) = "novemnonagintillion"
strNumberGroups(100) = "centillion" '100 sets of 000 after 1,000.
'--------------------------------------------------------------------------
'A sample driver program
DIM a AS STRING
INPUT "Please enter a number: ", a? "That number is said as:"
? NumberToWords(a)
SLEEP
'--------------------------------------------------------------------------
FUNCTION n2wReplace (Expression AS STRING, Find AS STRING, WithWhat AS STRING) AS STRING DIM ReplaceCounter AS INTEGER DIM Where AS INTEGER DIM TExpression AS STRING DIM Length AS INTEGER TExpression = "" Length = LEN(Expression) ReplaceCounter=0 Where = INSTR(1,Expression,Find) IF Where = 0 THEN n2wReplace = Expression EXIT FUNCTION END IF 'Get The First Part
TExpression = Mid$(Expression,1,Where-1) + WithWhat ReplaceCounter = Where + 1 Where = INSTR(ReplaceCounter,Expression,Find) DO WHILE Where <> 0 IF Where<>ReplaceCounter THEN TExpression = TExpression + Mid$(Expression,ReplaceCounter,Where-ReplaceCounter) + WithWhat ELSE TExpression = TExpression + WithWhat END IF ReplaceCounter = Where + 1 Where = INSTR(ReplaceCounter,Expression,Find) LOOP 'Get The Last Part
IF ReplaceCounter -1 <> Length THEN TExpression = TExpression + Right$(Expression,Length-ReplaceCounter+1) n2wReplace = TExpression END FUNCTION FUNCTION n2wIsNumeric(BYVAL vNumber AS STRING) AS BYTE
DIM i AS INTEGER
DIM l AS INTEGER DIM c AS STRING
DIM t AS INTEGER = 0
l = LEN(vNumber)
FOR i = 1 TO l c = mid$(vNumber,i,1)
IF c = "." THEN t+=1
IF t > 1 THEN n2wIsNumeric = n2wFALSE EXIT FUNCTION
END IF
END IF
IF ASC(c) < 48 AND ASC(c) > 57 THEN
n2wIsNumeric = n2wFALSE EXIT FUNCTION
END IF
NEXT i n2wIsNumeric = n2wTRUEEND FUNCTION
FUNCTION NumberToWords(BYVAL vNumber AS STRING) AS STRING
DIM strTemp AS STRING
DIM lDecimalPos AS INTEGER
DIM strWhole AS STRING
DIM strDecimal AS STRING
DIM answer AS STRING
DIM ReturnAnswer AS STRING = ""
CONST NAN AS STRING = "Not A Number"
strTemp = vNumber 'clean up non-numerics
strTemp = n2wReplace(strTemp, "$", "")
strTemp = n2wReplace(strTemp, ",", "")
strTemp = n2wReplace(strTemp, " ", "")
strTemp = n2wReplace(strTemp, "(", "")
strTemp = n2wReplace(strTemp, ")", "")
strTemp = trim$(strTemp)
'make sure it's a valid number
IF NOT n2wIsNumeric(vNumber) THEN
NumberToWords = NAN EXIT FUNCTION
END IF
IF Left$(strTemp, 1) = "-" THEN
NumberToWords = "negative"
strTemp = Right(strTemp, LEN(strTemp) - 1)
END IF
'find the decimal
lDecimalPos = INSTR(1, strTemp, ".")
'if there is a decimal
IF lDecimalPos > 0 THEN
'get integer part
strWhole = Left$(strTemp, lDecimalPos - 1)
'get the fractional part
strDecimal = Right$(strTemp, LEN(strTemp) - lDecimalPos)
ELSE 'otherwise
strWhole = strTemp strDecimal = ""
END IF
strWhole = NumWord(strWhole)
strDecimal = NumWord(strDecimal, n2wTRUE)
answer = ""
IF strWhole = "" THEN
IF strDecimal = "" THEN
NumberToWords = NAN ELSE
answer = strDecimal END IF
ELSE
IF strDecimal = "" THEN
answer = strWhole ELSE
answer = strWhole + " and " + strDecimal END IF
END IF
ReturnAnswer = ReturnAnswer + " " + answer NumberToWords = trim$(ReturnAnswer)
END FUNCTION
FUNCTION NumWord(tmpNumber AS STRING, Fractional AS BYTE = n2wFALSE) AS STRING
DIM NumberGroup AS INTEGER
DIM tmpNum AS STRING
DIM answer AS STRING
DIM vNum AS STRING
DIM fvNum AS STRING
DIM aLength AS INTEGER
'the number of digits don't have group or period names
DIM numExtra AS INTEGER
answer = ""
vNum = trim$(tmpNumber)
'let's make sure we can handle the number.
IF Fractional THEN numExtra = 2 ELSE numExtra = 3
IF LEN(vNum) > (3 * UBOUND(strNumberGroups) + numExtra) THEN
NumWord = ""
EXIT FUNCTION
END IF
'clean off leading zeros for integer parts and trailing zeros for fractional parts
IF Fractional THEN
DO WHILE Right(vNum, 1) = "0"
vNum = Left(vNum, LEN(vNum) - 1)
LOOP
ELSE
DO WHILE Left(vNum, 1) = "0"
vNum = Right(vNum, LEN(vNum) - 1)
LOOP
END IF
IF vNum = "0" OR vNum = "" THEN
NumWord = ""
EXIT FUNCTION
END IF
'used later on for getting the value of decimal numbers right
fvNum = vNumNumberGroup = -1
'get three numbers at a time
DO WHILE LEN(vNum) > 0
tmpNum = Right(vNum, 3)
'the function NumWord3 assumes three digits, lets not disappoint
tmpNum = "000" + tmpNum tmpNum = Right(tmpNum, 3)
tmpNum = NumWord3(tmpNum)
'if this group is zero, we skip it
IF tmpNum <> strNumberWords(0) THEN
IF NumberGroup = -1 THEN
'this is a special group
answer = tmpNum + " " + answer answer = trim$(answer)
ELSE
answer = tmpNum + " " + strNumberGroups(NumberGroup) + " " + answer answer = trim$(answer)
END IF
END IF
NumberGroup = NumberGroup + 1
'this ensures there isn't an error with the len command
vNum = Space(3) + vNum vNum = Left(vNum, LEN(vNum) - 3)
'now get rid of those spaces
vNum = trim$(vNum)
LOOP
IF Fractional THEN
aLength = LEN(fvNum)
SELECT CASE aLength CASE 1
answer = answer + " tenth"
CASE 2
answer = answer + " hundredth"
CASE ELSE
'note the integer division
SELECT CASE (aLength MOD 3)
CASE 0
answer = answer + " " + strNumberGroups((aLength \ 3) - 1) + "th"
CASE 1
answer = answer + " ten " + strNumberGroups((aLength \ 3) - 1) + "th"
CASE 2
answer = answer + " hundred " + strNumberGroups((aLength \ 3) - 1) + "th"
CASE ELSE
NumWord = "ERROR"
END SELECT
END SELECT
IF VAL(fvNum) <> 1 THEN answer = answer + "s"
END IF
answer = trim$(answer)
NumWord = answerEND FUNCTION
FUNCTION NumWord3(tmpNum AS STRING) AS STRING
DIM i AS INTEGER
DIM answer AS STRING = ""
'get the hundred's
i = CINT(VAL(Left(tmpNum, 1)))
IF i <> 0 THEN answer = strNumberWords(i) + " hundred"
'get through 19 because they have special names in English
i = CINT(VAL(Right(tmpNum, 2)))
IF i < 20 AND i > 0 THEN
answer = answer + " " + strNumberWords(i)
ELSE
i = CINT(VAL(Mid(tmpNum, 2, 1)))
IF i > 0 THEN answer = answer + " " + strNumberTenWords(i)
i = CINT(VAL(Right(tmpNum, 1)))
IF i > 0 THEN answer = answer + "-" + strNumberWords(i)
END IF
answer = trim$(answer)
IF answer = "" THEN answer = strNumberWords(0)
NumWord3 = trim$(answer)
END FUNCTION
here's one I found at http://www.devx.com/vb2themax/Tip/19053
made some changes for FB, not perfect but it might inspire somebody to write a better routine.
made some changes for FB, not perfect but it might inspire somebody to write a better routine.
Code: Select all
'NumberToWords - Convert a number into its string representation
' Convert a number into its textual equivalent.
' by Francesco Balena
' Pass True in the second argument if you want a null string when
' zero is passed.
' This is a recursive routine that is probably the most concise
' routines that solves the problem
Function NumberToWords(ByVal Number As Long, BlankIfZero As integer = 0) As String
const False = 0
const True = not False
dim as string NumWords
dim as string num(27) = {"", "One", "Two", "Three", "Four", _
"Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", _
"Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", _
"Seventeen", "Eighteen", "Nineteen", _
"Twenty", "Thirty", "Fourty", "Fifty", "Sixty", "Seventy", _
"Eighty", "Ninety"}
Select Case Number
Case 0
if BlankIfZero then
NumberToWords = ""
else
NumberToWords = "Zero"
end if
Case 1 To 19
NumberToWords = num(Number)
Case 20 To 99
NumberToWords = num(Number \ 10+18) & NumberToWords(Number Mod 10, True)
Case 100 To 999
NumWords = NumberToWords(Number \ 100) & "Hundred"
if Number >=200 then
NumberToWords = NumWords & " " & NumberToWords(Number Mod 100, True)
else
NumberToWords = NumWords & NumberToWords(Number Mod 100, True)
endif
Case 1000 To 999999
NumWords = NumberToWords(Number \ 1000) & "Thousand"
if Number >=2000 then
NumberToWords = NumWords & " " & NumberToWords(Number Mod 1000, True)
else
NumberToWords = NumWords & NumberToWords(Number Mod 1000, True)
endif
Case 1000000 To 999999999
NumWords = NumberToWords(Number \ 1000000) & "Million"
if Number >=2000000 then
NumberToWords = NumWords & " " & NumberToWords(Number Mod 1000000, True)
else
NumberToWords = NumWords & NumberToWords(Number Mod 1000000, True)
endif
Case Is >= 1000000000
NumWords = NumberToWords(Number \ 1000000000) & "Billion"
if Number >=2000000000 then
NumberToWords = NumWords & " " & NumberToWords(Number Mod 1000000000, True)
else
NumberToWords = NumWords & NumberToWords(Number Mod 1000000000, True)
endif
End Select
End Function
? NumberToWords(18)
? NumberToWords(19)
? NumberToWords(1234567890)
? NumberToWords(30)
? NumberToWords(40)
? NumberToWords(50)
? NumberToWords(60)
? NumberToWords(70)
? NumberToWords(80)
? NumberToWords(90)
? NumberToWords(100)
sleep
here's one found at http://www.demtron.com/blog/post/2009/0 ... Words.aspx
just add this declares at top the code
just add this declares at top the code
Code: Select all
'Main Function
Declare Function GetTens(ByVal TensText As String) As String
Declare Function GetHundreds(ByVal MyNumber As String) As String
Declare Function GetDigit(ByVal Digit As String) As String
-
bcohio2001
- Posts: 556
- Joined: Mar 10, 2007 15:44
- Location: Ohio, USA
- Contact:
Re: Numbers to words (US English)
Found this on one of my old computers.
File date: Oct 1, 2011
File date: Oct 1, 2011
Code: Select all
Declare Function Num2Words(TheNum As String) As String
Declare Function Illions(Power As Integer) As String
Declare Function Up99(ThisBit As Integer) As String
Declare Function WordThis(Part As String) As String
Declare Function DoTrip(Trip As String) As String
'User preference on how to refer to a number less than zero
'minus, negative or in the case of finance "loss"
Dim As String WordIt
'The largest number
'WordIt = String(3003, "9") + "." + String(3002, "9")
'WordIt = "1"+String(3002,"0")
'WordIt = "."+String(3001,"0")+"1"
'Print Num2Words(WordIt)
'or send Str(Abs(x))
'Dim As Double D = 6.02 * 10 ^ -23
'Print Num2Words(Str(Abs(D)))
'D = 3.1415927
'Print Num2Words(Str(Abs(D)))
Dim As Single S = 8.33 * 10 ^ 10
Print Num2Words(Str(Abs(S)))
'S = 3.1415927 'sends 3.141593
'Print Num2Words(Str(Abs(S)))
Sleep
Function Num2Words(TheNum As String) As String
Dim As String Whole,Fract,Full
Dim As Integer x
'
x = InStr(TheNum, Any "Ee")
If x Then
'single or double sent
Dim As Integer e = Val(Right(TheNum, 3)) 'exponent
Dim As Integer f = Len(TheNum) - 7 'Fractional part length
'
'check the sign of exponent
If Mid(TheNum, x + 1, 1) = "-" Then
'move decimal point to left
Full = "."
For x = 2 To e
Full += "0"
Next
Full += Left(TheNum, 1)
Full += Mid(TheNum, 3, f)
Else
'move decimal point to right
Full = Left(TheNum, 1)
Full += Mid(TheNum, 3, f)
For x = f + 1 To e
Full += "0"
Next
EndIf
'
Return Num2Words(Full)
EndIf
x = InStr(TheNum,".")
If x = 0 Then
'is a whole number
Whole = TheNum
Fract = ""
ElseIf x = Len(TheNum) Then
'is a whole number with a decimal point at end
Whole = Left(TheNum, x - 1)
Fract = ""
Else
If Left(TheNum, 1) = "." Or Left(TheNum, 2) = "0." Then
Whole = ""
Else
Whole = Left(TheNum, x-1)
EndIf
Fract = Mid(TheNum, x+1)
EndIf
If Len(Whole) Then
Full = WordThis(Whole)
If Len(Fract) Then Full += " and "
EndIf
If Len(Fract) Then
Full += WordThis(Fract)
Select Case Len(Fract)
Case 1
Full += " tenths"
Case 2
Full += " hundredths"
Case Else
If (Len(Fract) Mod 3) = 1 Then Full += " ten"
If (Len(Fract) Mod 3) = 2 Then Full += " hundred"
x = Int(Len(Fract)/3) + 1
Full += Illions(x)+"ths"
End Select
EndIf
Return Full
End Function
Function Illions(GroupNum As Integer) As String
'http://mrob.com/pub/math/largenum.html
'- Take the power of 10 you're naming and subtract 3.
'- Divide by 3. If the remainder is 0, 1 or 2, put one, ten or one hundred at the beginning of your name (respectively).
Dim As Integer Q = GroupNum - 2
'- For a quotient less than 10, use the standard names thousand, million, billion and so on through nonillion.
Select Case Q
Case -1
Return ""
Case 0
Return " thousand"
Case 1
Return " million"
Case 2
Return " billion"
Case 3
Return " trillion"
Case 4
Return " quadrillion"
Case 5
Return " quintillion"
Case 6
Return " sextillion"
Case 7
Return " septillion"
Case 8
Return " octillion"
Case 9
Return " nonillion"
Case Else
'' Otherwise:
'- Break the quotient up into 1's, 10's and 100's. Find the appropriate name segments for each piece in the table.
/'
1's 10's 100's
0 - - -
1 un, (n) deci,(nx) centi
2 duo ,(ms) viginti ,(n) ducenti
3 tre (*) , (ns) triginta , (ns) trecenti
4 quattuor , (ns) quadraginta , (ns) quadringenti
5 quin, (ns) quinquaginta , (ns) quingenti
6 se (sx), (n) sexaginta, (n) sescenti
7 septe (mn), (n) septuaginta, (n) septingenti
8 octo, (mx) octoginta, (mx) octingenti
9 nove (mn), nonaginta, nongenti
'/
'' (NOTE: The original Conway-Wechsler system specifies quinqua for 5, not quin.)
Dim As String WordIllion = " "
Dim As Integer T,H
Dim As Integer L,R
H = Int(Q/100)
Q -= H * 100
T = Int(Q/10)
Q -= T * 10
'in all cases if Case 0 then nothing is added
Select Case Q
Case 1
WordIllion += "un"
Case 2
WordIllion += "duo"
Case 3
'special!!!!
WordIllion += "tre(*)"
Case 4
WordIllion += "quattuor"
Case 5
WordIllion += "quin"
Case 6
WordIllion += "se(sx)"
Case 7
WordIllion += "septe(mn)"
Case 8
WordIllion += "octo"
Case 9
WordIllion += "nove(mn)"
End Select
Select Case T
Case 1
WordIllion += "(n)deci"
Case 2
WordIllion += "(ms)viginti"
Case 3
WordIllion += "(ns)triginta"
Case 4
WordIllion += "(ns)quadraginta"
Case 5
WordIllion += "(ns)quinquaginta"
Case 6
WordIllion += "(n)sexaginta"
Case 7
WordIllion += "(n)septuaginta"
Case 8
WordIllion += "(mx)octoginta"
Case 9
WordIllion += "nonaginta"
End Select
Select Case H
Case 1
WordIllion += "(nx)centi"
Case 2
WordIllion += "(n)ducenti"
Case 3
WordIllion += "(ns)trecenti"
Case 4
WordIllion += "(ns)quadringenti"
Case 5
WordIllion += "(ns)quingenti"
Case 6
WordIllion += "(n)sescenti"
Case 7
WordIllion += "(n)septingenti"
Case 8
WordIllion += "(mx)octingenti"
Case 9
WordIllion += "nongenti"
End Select
'- String the segments together, inserting an extra letter if the letter shown in parentheses at the end of one segment match a letter
' in parentheses at the beginning of the next.
'For example: septe(mn) + (ms)viginti = septemviginti because the (m)'s match; Another example: se(sx) + (mx)octoginta = sexoctoginta.
T = InStr(WordIllion,"(")
While T
H = InStr(T,WordIllion,")")
Q = 0 'null chr
'is next chr ( ?
If WordIllion[H] = 40 Then
L = T
R = H + 1
If Chr(WordIllion[L]) = "*" Then
'- For the special case of tre, the letter s should be inserted if the following part is marked with either an s or an x.
While WordIllion[R] > 41
If WordIllion[R] = Asc("s") Or WordIllion[R] = Asc("x") Then
Q = Asc("s")
Exit While
EndIf
R += 1
Wend
Else
'normal
While WordIllion[L] > 41
R = H + 1
While WordIllion[R] > 41
If WordIllion[L] = WordIllion[R] Then
Q = WordIllion[R]
Exit While, While
EndIf
R += 1
Wend
L += 1
Wend
EndIf
EndIf
'using T,H remove () and add matching char if any
If Q Then
WordIllion = Left(WordIllion,T-1)+Chr(Q)+Mid(WordIllion,H+1)
Else
WordIllion = Left(WordIllion,T-1)+Mid(WordIllion,H+1)
EndIf
T = InStr(WordIllion,"(")
Wend
'
' Many of the resulting names are only slightly different from one another.
' For example 10^261 is sexoctongintillion and 10^2421 is sexoctingentillion.
' Then there's 10^309 = duocentillion while 10^603 = ducentillion;
' and similarly 10^312 = trescentillion while 10^903 = trecentillion.
'
'- Remove a final vowel, if any.
' (there is no U)
If Right(WordIllion,1) = "a" Or Right(WordIllion,1) = "e" Or Right(WordIllion,1) = "i" Or Right(WordIllion,1) = "o" Then
Q = Len(WordIllion) - 1
WordIllion = Left(WordIllion,Q)
EndIf
'- Add illion at the end. You're done.
WordIllion += "illion"
Return WordIllion
End Select
End Function
Function Up99(ThisBit As Integer) As String
Dim As String LittleBit
Dim As Integer LittleVal
'
If ThisBit = 0 Then Return ""
Select Case ThisBit
Case 1
Return "one"
Case 2
Return "two"
Case 3
Return "three"
Case 4
Return "four"
Case 5
Return "five"
Case 6
Return "six"
Case 7
Return "seven"
Case 8
Return "eight"
Case 9
Return "nine"
Case 10
Return "ten"
Case 11
Return "eleven"
Case 12
Return "twelve"
Case 13
Return "thirteen"
Case 14
Return "fourteen"
Case 15
Return "fifteen"
Case 16
Return "sixteen"
Case 17
Return "seventeen"
Case 18
Return "eighteen"
Case 19
Return "nineteen"
Case Is < 30
LittleBit = Up99(ThisBit Mod 10)
If Len(LittleBit) Then LittleBit = " " +LittleBit
Return "twenty" + LittleBit
Case Is < 40
LittleBit = Up99(ThisBit Mod 10)
If Len(LittleBit) Then LittleBit = " " +LittleBit
Return "thirty" + LittleBit
Case Is < 50
LittleBit = Up99(ThisBit Mod 10)
If Len(LittleBit) Then LittleBit = " " +LittleBit
Return "forty" + LittleBit
Case Is < 60
LittleBit = Up99(ThisBit Mod 10)
If Len(LittleBit) Then LittleBit = " " +LittleBit
Return "fifty" + LittleBit
Case Is < 70
LittleBit = Up99(ThisBit Mod 10)
If Len(LittleBit) Then LittleBit = " " +LittleBit
Return "sixty" + LittleBit
Case Is < 80
LittleBit = Up99(ThisBit Mod 10)
If Len(LittleBit) Then LittleBit = " " +LittleBit
Return "seventy" + LittleBit
Case Is < 90
LittleBit = Up99(ThisBit Mod 10)
If Len(LittleBit) Then LittleBit = " " +LittleBit
Return "eighty" + LittleBit
Case Is < 100
LittleBit = Up99(ThisBit Mod 10)
If Len(LittleBit) Then LittleBit = " " +LittleBit
Return "ninty" + LittleBit
End Select
End Function
Function WordThis(Part As String) As String
Dim As String Ret,PadPart = Part,TestTrip
Dim As Integer TripLoop, TotLoop
'
'pad front
If (Len(PadPart) Mod 3) Then PadPart = "0" + PadPart'
If (Len(PadPart) Mod 3) Then PadPart = "0" + PadPart'
TotLoop = Int(Len(PadPart)/3)
For TripLoop = TotLoop To 1 Step -1
TestTrip = Mid(PadPart, (TotLoop-TripLoop)*3+1,3)
If TestTrip <> "000" Then
Ret += DoTrip(TestTrip)
Ret += Illions(TripLoop)
If TripLoop > 1 Then Ret += " "
EndIf
Next
Return Ret
End Function
Function DoTrip(Trip As String) As String
Dim As String ATrip,Less100,R
'
ATrip = Up99(Val(Left(Trip,1)))
Less100 = Up99(Val(Right(Trip,2)))
'any hundreds?
If Len(ATrip) Then R = ATrip + " hundred"
If Len(Less100) Then
If Len(ATrip) Then R += " "
R += Less100
EndIf
Return R
End Function