Download code

Jump to: navigation, search

Back to Convert_integer_to_words_(QBASIC)

Download for Windows: single file, zip

Download for UNIX: single file, zip, tar.gz, tar.bz2

NUM2LANG.BAS

  1 REM The authors of this work have released all rights to it and placed it
  2 REM in the public domain under the Creative Commons CC0 1.0 waiver
  3 REM (http://creativecommons.org/publicdomain/zero/1.0/).
  4 REM 
  5 REM THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  6 REM EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  7 REM MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  8 REM IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
  9 REM CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
 10 REM TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 11 REM SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 12 REM 
 13 REM Retrieved from: http://en.literateprograms.org/Convert_integer_to_words_(QBASIC)?oldid=19031
 14 
 15 DECLARE FUNCTION Num2Lang$ (aNumber AS LONG, aLang AS STRING)
 16 
 17 DIM mStatus AS STRING
 18 DIM mTest AS STRING
 19 DIM mLang AS STRING
 20 DIM mNumber AS LONG
 21 DIM mExpected AS STRING
 22 DIM mGot AS STRING
 23 
 24 CLS
 25 RESTORE TestCases
 26 mStatus = ""
 27 DO WHILE mStatus = ""
 28    READ mTest
 29    IF mTest = "" THEN
 30       mStatus = "All tests Succeeded"
 31    ELSE
 32       READ mLang, mNumber, mExpected
 33       mGot = Num2Lang$(mNumber, mLang)
 34       PRINT LEFT$(mLang + ": " + LTRIM$(STR$(mNumber)) + SPACE$(15), 15) + "'" + mGot + "'"
 35       IF mExpected <> mGot THEN
 36          mStatus = "Last test failed (Expected '" + mExpected + "')"
 37       END IF
 38    END IF
 39 LOOP
 40 PRINT mStatus
 41 SYSTEM
 42 
 43 TestCases:
 44    DATA "*","en-uk",0,"zero"
 45    DATA "*","en-uk",1,"one"
 46    DATA "*","en-uk",9,"nine"
 47    DATA "*","en-uk",10,"ten"
 48    DATA "*","en-uk",11,"eleven"
 49    DATA "*","en-uk",19,"nineteen"
 50    DATA "*","en-uk",20,"twenty"
 51    DATA "*","en-uk",21,"twenty-one"
 52    DATA "*","en-uk",100,"one hundred"
 53    DATA "*","en-uk",101,"one hundred and one"
 54    DATA "*","en-us",101,"one hundred one"
 55    DATA "*","en-uk",1000,"one thousand"
 56    DATA "*","en-uk",1001,"one thousand and one"
 57    DATA "*","en-uk",1958,"one thousand nine hundred and fifty-eight"
 58    DATA "*","fr",10,"dix"
 59    DATA "*","fr",11,"onze"
 60    DATA "*","fr",21,"vingt et un"
 61    DATA "*","fr",22,"vingt-deux"
 62    DATA "*","fr",29,"vingt-neuf"
 63    DATA "*","fr",60,"soixante"
 64    DATA "*","fr",61,"soixante et un"
 65    DATA "*","fr",62,"soixante-deux"
 66    DATA "*","fr",71,"soixante et onze"
 67    DATA "*","fr",79,"soixante-dix-neuf"
 68    DATA "*","fr",80,"quatre-vingts"
 69    DATA "*","fr",90,"quatre-vingts-dix"
 70    DATA "*","fr",99,"quatre-vingts-dix-neuf"
 71    DATA "*","fr",100,"cent"
 72    DATA "*","fr",101,"cent un"
 73    DATA "*","fr",999,"neuf cent quatre-vingts-dix-neuf"
 74    DATA "*","fr",1000,"mille"
 75    DATA "*","fr",1100,"mille cent"
 76    DATA "*","fr",1000000,"un million"
 77    DATA ""
 78 FUNCTION Num2Lang$ (aNumber AS LONG, aLang AS STRING)
 79 
 80    STATIC dLang AS STRING, dLog10 AS DOUBLE
 81    STATIC dUnits() AS STRING, dTens() AS STRING, dPowers() AS STRING
 82 
 83    DIM dBuffer AS STRING, dDigitGroup AS LONG, dRange AS INTEGER
 84    IF dLang <> aLang THEN
 85       GOSUB Num2LangInit
 86       dLang = aLang
 87    END IF
 88    SELECT CASE aNumber
 89 
 90    CASE 0 TO 19
 91       dBuffer = dUnits(INT(aNumber))
 92    CASE 20 TO 99
 93       dDigitGroup = INT(aNumber / 10)
 94       dBuffer = dTens(dDigitGroup)
 95       IF dBuffer = "" THEN
 96          dDigitGroup = dDigitGroup - 1
 97          dBuffer = dTens(dDigitGroup)
 98       END IF
 99       dDigitGroup = aNumber - dDigitGroup * 10
100       IF aLang = "fr" AND dDigitGroup MOD 10 = 1 THEN
101          dBuffer = dBuffer + " et " + Num2Lang(dDigitGroup, aLang)
102       ELSEIF dDigitGroup > 0 THEN
103          dBuffer = dBuffer + "-" + Num2Lang(dDigitGroup, aLang)
104       END IF
105    CASE 100 TO 2147483647
106       dRange = INT(LOG(aNumber + .4) / dLog10)
107       IF dRange > 3 THEN dRange = INT(dRange / 3) * 3
108       dDigitGroup = INT(aNumber / 10 ^ dRange)
109       IF aLang = "fr" AND dDigitGroup = 1 AND dRange < 5 THEN
110          dBuffer = ""
111       ELSE
112          dBuffer = Num2Lang(dDigitGroup, aLang)
113       END IF
114       dBuffer = LTRIM$(dBuffer + dPowers(dRange))
115       dDigitGroup = aNumber - dDigitGroup * 10 ^ dRange
116       IF dDigitGroup > 0 THEN
117          IF dDigitGroup < 100 AND aLang = "en-uk" THEN
118             dBuffer = dBuffer + " and"
119          END IF
120          dBuffer = dBuffer + " " + Num2Lang(dDigitGroup, aLang)
121       END IF
122    CASE ELSE
123       dBuffer = LTRIM$(STR$(aNumber))
124    END SELECT
125 
126    Num2Lang = dBuffer
127 
128    EXIT FUNCTION
129 Num2LangInit:
130    REDIM dUnits(19), dTens(9), dPowers(9)
131    SELECT CASE aLang
132    CASE "fr"
133       dUnits(0) = "zero": dUnits(10) = "dix": dTens(0) = "": dPowers(0) = ""
134       dUnits(1) = "un": dUnits(11) = "onze": dTens(1) = "": dPowers(1) = ""
135       dUnits(2) = "deux": dUnits(12) = "douze": dTens(2) = "vingt": dPowers(2) = " cent"
136       dUnits(3) = "trois": dUnits(13) = "treize": dTens(3) = "trente": dPowers(3) = " mille"
137       dUnits(4) = "quatre": dUnits(14) = "quatorze": dTens(4) = "quarante": dPowers(4) = ""
138       dUnits(5) = "cinq": dUnits(15) = "quinze": dTens(5) = "cinquante": dPowers(5) = ""
139       dUnits(6) = "six": dUnits(16) = "seize": dTens(6) = "soixante": dPowers(6) = " million"
140       dUnits(7) = "sept": dUnits(17) = "dix-sept": dTens(7) = "": dPowers(7) = ""
141       dUnits(8) = "huit": dUnits(18) = "dix-huit": dTens(8) = "quatre-vingts": dPowers(8) = ""
142       dUnits(9) = "neuf": dUnits(19) = "dix-neuf": dTens(9) = "": dPowers(9) = " milliard"
143    CASE ELSE
144       dUnits(0) = "zero": dUnits(10) = "ten": dTens(0) = "": dPowers(0) = ""
145       dUnits(1) = "one": dUnits(11) = "eleven": dTens(1) = "": dPowers(1) = ""
146       dUnits(2) = "two": dUnits(12) = "twelve": dTens(2) = "twenty": dPowers(2) = " hundred"
147       dUnits(3) = "three": dUnits(13) = "thirteen": dTens(3) = "thirty": dPowers(3) = " thousand"
148       dUnits(4) = "four": dUnits(14) = "fourteen": dTens(4) = "forty": dPowers(4) = ""
149       dUnits(5) = "five": dUnits(15) = "fifteen": dTens(5) = "fifty": dPowers(5) = ""
150       dUnits(6) = "six": dUnits(16) = "sixteen": dTens(6) = "sixty": dPowers(6) = " million"
151       dUnits(7) = "seven": dUnits(17) = "seventeen": dTens(7) = "seventy": dPowers(7) = ""
152       dUnits(8) = "eight": dUnits(18) = "eighteen": dTens(8) = "eighty": dPowers(8) = ""
153       dUnits(9) = "nine": dUnits(19) = "nineteen": dTens(9) = "ninety": dPowers(9) = " billion"
154    END SELECT
155    dLog10 = LOG(10)
156    RETURN
157 END FUNCTION
158 


hijacker
hijacker
hijacker
hijacker