home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / strings.swg / 0088_number conversion.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  2.3 KB  |  73 lines
  1. {
  2.  JS> I, remember way back which could be a while I saw a basic routine
  3.  JS> that would convert numbers to their written form like 120= one
  4.  JS> hundred and twenty. If anyone has such a routine it would be
  5.  JS> appreciated..
  6.  
  7.  
  8.  This was quite a challenge..I did find a bug so have a look at the
  9.  test. To really put this to the test you'd have to get it to return
  10.  every single number (0-64K) and observe the output.
  11.  
  12.  
  13. {Returns the written format of any number between 0-65535}
  14. { Could be useful in a checkbook program }
  15.  
  16. USES Crt;
  17.  
  18. {----------------------------------------------------}
  19. FUNCTION LZ(Num:Word; Times:Byte; Ch:Char):String;
  20. VAR S:String;
  21. BEGIN
  22.  Str(Num,S); WHILE Length(S)<Times DO S:=Ch+S; LZ:=S;
  23. END;
  24. {------------------------------------------------}
  25. FUNCTION Convert(Num:Word):String;
  26. CONST
  27.  Hu='hundred'; Th='thousand';
  28.  Units:Array[0..9] OF String[5]=   {60 bytes}
  29.  ('','one','two','three','four','five','six','seven','eight','nine');
  30.  Tens:Array[0..9] OF String[7]=    {80 bytes}
  31.  ('','ten,','twenty','thirty','fourty','fifty','sixty','seventy','eighty',
  32.  'ninety');
  33.  Ones:Array[0..9] OF String[9]=    {100 bytes}
  34.  ('','eleven','twelve','thirteen','fourteen','fifteen','sixteen',
  35.   'seventeen','eighteen','nineteen');
  36. VAR S1,S2:String; X:Byte;
  37. BEGIN
  38.  S1:=LZ(Num,5,' '); S2:='';
  39.  FOR Num:=Length(S1) DOWNTO 1 DO
  40.   IF S1[Num]<>' ' THEN
  41.    BEGIN
  42.     X:=Ord(S1[Num])-48;
  43.     CASE Num OF
  44.      1: S2:=Tens[X]+' '+S2;
  45.      2: IF S1[1]='1' THEN
  46.          BEGIN
  47.           S2:=Ones[X]+' '+Th+' '+S2; Break;
  48.          END ELSE S2:=Units[X]+' '+Th+' '+S2;
  49.      3: IF S1[3]='0' THEN
  50.          BEGIN
  51.           IF (S1[2]<>'0') AND (S1[1]<>' ') THEN S2:='and '+S2;
  52.          END ELSE
  53.           IF S1[4]<>'0' THEN S2:=Units[X]+' '+Hu+' and '+S2
  54.            ELSE S2:=Units[X]+' '+Hu;
  55.      4: S2:=Tens[X]+' '+S2;
  56.      5: IF S1[4]='1' THEN
  57.          BEGIN
  58.           S2:=Ones[X]; Break;
  59.          END ELSE S2:=Units[X];
  60.     END;
  61.    END; Convert:=S2;
  62. END;
  63. {------------------------------------------------}
  64. BEGIN
  65.  ClrScr;
  66.  Writeln(Convert(23452));     {ok}
  67.  Writeln(Convert(60201));    {Bug!}
  68.  Writeln(Convert(9900));      {ok}
  69.  Writeln(Convert(534));       {ok}
  70.  Writeln(Convert(18770));     {ok}
  71.  Writeln(Convert(4));         {ok}
  72. END.
  73.