fork download
copy 
  1. program ideone;
  2. uses SysUtils;
  3. var
  4.   c,d:integer;
  5.   t:string;
  6.  
  7.     function zl(x:integer):string;
  8.     var
  9.     	a: integer;
  10.     begin
  11.     	a:= x mod 10;
  12.  
  13.     	if (x = 1) then
  14.     		zl:= ' złoty'
  15.     	else if ( (a >= 2) and (a <= 4) ) then
  16.     		zl:= ' złote'
  17.     	else
  18.     		zl:= ' złotych';
  19.     end;
  20.  
  21.     function Q(x:real; y:string):string;
  22.     var
  23.     	j: array[0..9] of string = ('', ' jeden', ' dwa', ' trzy', ' cztery', ' pięć', ' sześć', ' siedem', ' osiem', ' dziewięć');
  24.     	n: array[1..9] of string = (' jedenaście', ' dwanaście', ' trzynaście', ' czternaście', ' piętnaście', ' szesnaście', ' siedemnaście', ' osiemnaście', ' dziewiętnaście');
  25.     	d: array[0..9] of string = ('', ' dziesięć', ' dwadzieścia', ' trzydzieści', ' czterdzieści', ' pięćdziesiąt', ' sześćdziesiąt', ' siedemdziesiąt', ' osiemdziesiąt', ' dziewięćdziesiąt');
  26.     	s: array[0..9] of string = ('', ' sto', ' dwieście', ' trzysta', ' czterysta', ' pięćset', ' sześćset', ' siedemset', ' osiemset', ' dziewięćset');
  27.     	gr: array[0..6,1..3] of string = (('' ,'' ,''),
  28. 										(' tysiąc' ,' tysiące' ,' tysięcy'),
  29. 										(' milion' ,' miliony' ,' milionów'),
  30. 										(' miliard',' miliardy',' miliardów'),
  31. 										(' bilion' ,' biliony' ,' bilionów'),
  32. 										(' biliard',' biliardy',' biliardów'),
  33. 										(' trylion',' tryliony',' trylionów'));
  34.     	a: int64;
  35.     	b: integer;
  36.     	result: string = '';
  37.     	n1,n2,n3: integer;
  38.     	k,g: integer;
  39.     begin
  40.     	a := trunc(x);
  41.     	b := trunc(x*100) mod 100;
  42.     	g := 0;
  43.  
  44.     	result := zl(a) + result;
  45.  
  46.     	while a>0 do
  47.     	begin
  48. 	    	n3 := trunc(a mod 1000 / 100);
  49. 	    	n2 := trunc(a mod 100 / 10);
  50. 	    	n1 := trunc(a mod 10);
  51.  
  52. 	    	if ((n1 = 1) or (n1+n2+n3 = 0)) then
  53. 	    		k:=1
  54. 	    	else if ((n1=2) or (n1=3) or (n1=4)) then
  55. 	    		k:=2
  56. 	    	else
  57. 	    		k:=3;
  58.  
  59. 	    	result:= gr[g,k] + result;
  60.  
  61. 	    	if (n2 = 1) and (n1 > 0) then
  62. 	    		result := n[n1] + result
  63. 			else
  64. 	    	begin
  65. 	    	    result := j[n1] + result;
  66. 	    	    result := d[n2] + result;
  67. 	    	end;
  68.  
  69. 	    	result := s[n3] + result;
  70.  
  71.  
  72.  
  73.  
  74. 	    	a := trunc(a/1000);
  75. 	    	g := g+1;
  76.     	end;
  77.  
  78.         Q:=result;
  79.     end;
  80.  
  81. begin
  82.  
  83. t:=Q(1221212.45,''); 
  84. writeln(t); 
  85. end.
Success #stdin #stdout 0s 5516KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
 jeden milion dwieście dwadzieścia jeden tysiąc dwieście dwanaście złotych
https://ideone.com/IXoDvG
language:
Pascal (fpc 3.0.4)
created:
1 year ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!