Contributor: GAYLE DAVIS
{$S-,R-,V-,I-,N-,B-,F-}
{
Converts REAL number to ENGLISH strings
GAYLE DAVIS 1/21/94
Amounts up to and including 19,999,999ドル.99 are supported.
If you write amounts larger than that, you don't need a computer !!
======================================================================
Dedicated to the PUBLIC DOMAIN, this software code has been tested and
used under BP 7.0/DOS and MS-DOS 6.2.
}
{$IFNDEF Ver40}
{Allow overlays}
{$F+,O-,X+,A-}
{$ENDIF}
USES CRT;
CONST
Dot : CHAR = #42;
VAR
SS : STRING;
AA : REAL;
FUNCTION EnglishNumber (Amt : REAL) : STRING;
TYPE
Mword = STRING [10];
Amstw = STRING [80]; {for function TenUnitToWord output}
CONST
NumStr : ARRAY [0..27] OF Mword =
('', 'ONE ', 'TWO ', 'THREE ', 'FOUR ', 'FIVE ', 'SIX ', 'SEVEN ',
'EIGHT ','NINE ', 'TEN ', 'ELEVEN ', 'TWELVE ', 'THIRTEEN ',
'FOURTEEN ', 'FIFTEEN ', 'SIXTEEN ', 'SEVENTEEN ', 'EIGHTEEN ',
'NINETEEN ', 'TWENTY ', 'THIRTY ', 'FORTY ', 'FIFTY ', 'SIXTY ',
'SEVENTY ', 'EIGHTY ', 'NINETY ');
VAR
S : STRING;
Temp : REAL;
DigitA, DigitB : INTEGER;
Ams : STRING;
Ac : STRING [2];
FUNCTION TenUnitToWord (TeUn : INTEGER) : Amstw;
{ convert tens and units to words }
BEGIN
IF TeUn < 21 THEN TenUnitToWord := NumStr [TeUn] ELSE TenUnitToWord := NumStr [TeUn DIV 10 + 18] + NumStr [TeUn MOD 10]; END; {function TenUnitToWord} BEGIN { Nothing bigger than 20 million } IF (Amt> 20000000.0) OR (Amt <= 0.0) THEN BEGIN EnglishNumber := ''; {null string if out of range} EXIT; END; { Convert 1,000,000 decade } Ams := ''; DigitA := TRUNC (Amt / 1E6); IF DigitA> 0 THEN Ams := Ams + NumStr [DigitA] + 'MILLION ';
Temp := Amt - DigitA * 1E6;
{ Convert 100,000, 10,000, 1,000 decades }
DigitA := TRUNC (Temp / 1E5); {extract 100,000 decade}
IF DigitA> 0 THEN Ams := Ams + NumStr [DigitA] + 'HUNDRED ';
Temp := Temp - DigitA * 1E5;
DigitB := TRUNC (Temp / 1000); {extract sum of 10,000 and 1,000 decades}
Ams := Ams + TenUnitToWord (DigitB);
IF ( (DigitA> 0) OR (DigitB> 0) ) THEN Ams := Ams + 'THOUSAND ';
{Convert 100, 10, unit decades}
Temp := Temp - DigitB * 1000.0;
DigitA := TRUNC (Temp / 100); {extract 100 decade}
IF DigitA> 0 THEN Ams := Ams + NumStr [DigitA] + 'HUNDRED ';
DigitB := TRUNC (Temp - DigitA * 100.0); {extract sum of 10 and unit decades}
Ams := Ams + TenUnitToWord (DigitB);
{Convert cents to form XX/100}
IF INT (Amt)> 0.0 THEN Ams := Ams + 'AND ';
DigitA := ROUND ( (FRAC (Amt) * 100) );
IF DigitA> 0 THEN
BEGIN
STR (DigitA : 2, Ac);
IF Ac [1] = ' ' THEN Ac [1] := '0';
Ams := Ams + Ac + '/100'
END
ELSE Ams := Ams + 'NO/100';
EnglishNumber := Ams + ' Dollars';
END;
BEGIN
ClrScr;
WriteLn(EnglishNumber (1234.55));
WriteLn(EnglishNumber (991234.55));
WriteLn(EnglishNumber (19891234.55));
Readkey;
END.