[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]

{$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.

[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]