DataMuseum.dk

top - metrics - download

    Length: 2816 (0xb00)
    Types: TextFile
    Names: »WRITNUM.PAS«

└─⟦dd59903ef⟧ Bits:30005887 Klub diskette for udveksling af software
    └─⟦this⟧ »WRITNUM.PAS« 

TextFile

          æModified from Z/PUG Vol. 16 by John A. McCullochå
æ	This was part of a Pascal Course, as program listing #5 of Welsh &å  
æElder, Page 101. It has been modified from the listing in Volume 16 as   å
æformatted by Gerald Hewett. Furthur changes may be made to expand the    å
ærange of amounts handled. As set up it will handle amounts to $9,999.99. å
æ	Addition of the fixed point package, or conversion of numerical   å
ædata to strings will allow this to work within a computational package.  å

Program Writnum;


Var
	     k,h,t,u : char;
             i,ct,cu : char;
	      amount : array Æ1..7Å of char;
		   x : integer;

Procedure units (i : char);
	Begin
		Case i of
			'0' : write( 'NO ');
			'1' : write( 'One ');
			'2' : write( 'Two ');
			'3' : write( 'Three ');
			'4' : write( 'Four ');
			'5' : write( 'Five ');
			'6' : write( 'Six ');
			'7' : write( 'Seven ');
			'8' : write( 'Eight ');
			'9' : write( 'Nine ');
		end;
	end;		æunitså

Procedure teens (i : char);
	Begin	
		Case i of
			'0' : write( 'Ten ');
			'1' : write( 'Eleven ');
			'2' : write( 'Twelve ');
			'3' : write( 'Thirteen ');
			'4' : write( 'Fourteen ');
			'5' : write( 'Fifteen ');
			'6' : write( 'Sixteen ');
			'7' : write( 'Seventeen ');
			'8' : write( 'Eighteen ');
			'9' : write( 'Nineteen ');
		end;
	end;		æteenså

Procedure tens (i : char);
	Begin
		Case i of
			'0' : ;
			'2' : write( 'Twenty');
			'3' : write( 'Thirty');
			'4' : write( 'Forty');
			'5' : write( 'Fifty');
			'6' : write( 'Sixty');
			'7' : write( 'Seventy');
			'8' : write( 'Eighty');
			'9' : write( 'Ninety');
		end;
		if (u > '0') and (t > '1') then write( '-')
			else write( ' ');
	end;		ætenså

Procedure convert;
	Begin
	x := 0;
	u := '0';
	t := '0';
	h := '0';
	k := '0';
	If amount <> '       ' then Repeat
		x := x + 1;
	Until (amountÆxÅ = '.') or (x = 7);
	if (x-1) > 0 then u := amountÆx-1Å;
	if (x-2) > 0 then t := amountÆx-2Å;
	if (x-3) > 0 then h := amountÆx-3Å;
	if (x-4) > 0 then k := amountÆx-4Å;
	ct := amountÆx+1Å;
	cu := amountÆx+2Å;
	end; 		æconvertå

Procedure listout;
	Begin
	if k > '0' then Begin
		units(k);
		write( 'Thousand ');
		end;
 	if h > '0' then Begin
		units(h);
		write( 'Hundred ');
		end;
	if t = '1' then teens(u)
		else begin
			tens(t);
			units(u);
			end;
	end;		æconvertå

begin
	Writeln; Writeln;
	Repeat
		Write( 'Enter amount to be written out....$');
		Readln( amount);
		if amount <> '       ' then Begin
			convert;
			listout;
			writeln( 'Dollars and ', ct:1, cu:1, ' cents.');
			end;
		Writeln; Writeln;
	Until amount = '       ';
end.
«eof»