home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 September / Chip_1999-09_cd.bin / ctenari / Trejbal / TRELL.PAK / SOURCE / ERSD.EXE / CISLOVKY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-06-01  |  5.0 KB  |  292 lines
  1. uses dos,crt,slova,matika;
  2.  
  3. var sfs,a,rad,kus1,kus2,kus3: string;
  4.     aa,bb:text;
  5.     i,lo,j,k,l,m,code,n : integer;
  6.     st,dt,jt : array [0..9] of String[20];
  7.     znak : char;
  8.  
  9. begin             { NA ZKOUSKU }
  10.  
  11. lo:=0;
  12.  
  13. st[1]:='sto';
  14. st[2]:='dvêstê';
  15. st[3]:='t⌐ista';
  16. st[4]:='çty⌐ista';
  17. st[5]:='pêtset';
  18. st[6]:='¿estset';
  19. st[7]:='sedmset';
  20. st[8]:='osmset';
  21. st[9]:='devêtset';
  22. st[0]:='';
  23.  
  24. dt[1]:='deset';
  25. dt[2]:='dvacet';
  26. dt[3]:='t⌐icet';
  27. dt[4]:='çty⌐icet';
  28. dt[5]:='padesát';
  29. dt[6]:='¿edesát';
  30. dt[7]:='sedmdesát';
  31. dt[8]:='osmdesát';
  32. dt[9]:='devadesát';
  33. dt[0]:='';
  34.  
  35. jt[1]:='jeden';
  36. jt[2]:='dva';
  37. jt[3]:='t⌐i';
  38. jt[4]:='çty⌐i';
  39. jt[5]:='pêt';
  40. jt[6]:='¿est';
  41. jt[7]:='sedm';
  42. jt[8]:='osm';
  43. jt[9]:='devêt';
  44. jt[0]:='';
  45.  
  46. sfs:=fsearch('c:\trell\convert.dll',GetEnv('path'));
  47. if not(sfs='') then
  48. begin
  49.  
  50.  assign(aa,'c:\trell\convert.dll');
  51.  reset(aa);
  52.  readln(aa,rad);
  53.  close(aa);
  54.  
  55.  {
  56.  readln(rad);
  57.  }
  58.  
  59.  rad:= soucet(rad,'0');
  60.  if not(rad='chyba')  then
  61.  begin
  62.  
  63.   { writeln(rad); }
  64.  
  65.   j:=0;
  66.   for i:=1 to ord(rad[0]) do
  67.   begin
  68.     if rad[i]=',' then j:=1;
  69.   end;
  70.   if j=1 then rad:= des_et(rad,'2');
  71.  
  72.   { writeln(rad); }
  73.  
  74.   j:=0;
  75.   kus1:='';
  76.   kus2:='';
  77.   for i:=1 to ord(rad[0]) do
  78.   begin
  79.     if j=1 then kus2:=kus2+rad[i];
  80.     if rad[i]=',' then j:=1;
  81.     if j=0 then kus1:=kus1+rad[i];
  82.   end;
  83.  
  84.   {
  85.   writeln(kus1);
  86.   writeln(kus2);
  87.               }
  88.  
  89.   kus1:=prelej(kus1);
  90.   kus3:='';
  91.   j:=0;
  92.   for i:=1 to ord(kus1[0]) do
  93.   begin
  94.     kus3:=kus3+kus1[i];
  95.     if i/3 = int(i/3) then
  96.     begin
  97.      if i>2 then
  98.      begin
  99.       kus3:=kus3+'.';
  100.       j:=j+1;
  101.      end;
  102.     end;
  103.   end;
  104.  
  105.   kus3:=prelej(kus3);
  106.   if kus3[1]='.' then
  107.   begin
  108.    rad:='';
  109.    for i:=2 to ord(kus3[0]) do rad:=rad+kus3[i];
  110.    j:=j-1;
  111.    kus3:=rad;
  112.   end;
  113.  
  114.   k:=ord(kus1[0]);
  115.  
  116.   kus1:='';
  117.   for i:=1 to ord(kus3[0]) do
  118.   begin
  119.     if not(kus3[i]='.') then kus1:=kus1+kus3[i]
  120.     else
  121.     begin
  122.       if j=2 then kus1:=kus1+'M';
  123.       if j=1 then kus1:=kus1+'T';
  124.       j:=j-1;
  125.     end;
  126.   end;
  127.  
  128.   { writeln(kus1);  }
  129.  
  130.   m:=1;
  131.   rad:='';
  132.   for i:=1 to ord(kus1[0]) do
  133.   begin
  134.  
  135.   j:=k;
  136.   while j>3 do j:=j-3;
  137.   val(kus1[i],l,code);
  138.   if code=0 then
  139.   begin
  140.    if j=3 then rad:=rad+st[l];
  141.    n:=0;
  142.    if j=2 then
  143.    begin
  144.      lo:=1;
  145.      if l=1 then
  146.      begin
  147.       val(kus1[i+1],l,code);
  148.       if l=0 then rad:=rad+'deset';
  149.       if l=1 then rad:=rad+'jedenáct';
  150.       if l=2 then rad:=rad+'dvanáct';
  151.       if l=3 then rad:=rad+'t⌐ináct';
  152.       if l=4 then rad:=rad+'çtrnáct';
  153.       if l=5 then rad:=rad+'patnáct';
  154.       if l=6 then rad:=rad+'¿estnáct';
  155.       if l=7 then rad:=rad+'sedmnáct';
  156.       if l=8 then rad:=rad+'osmnáct';
  157.       if l=9 then rad:=rad+'devatenáct';
  158.       k:=k-1;
  159.       i:=i+1;
  160.       n:=1;
  161.      end
  162.      else rad:=rad+dt[l];
  163.    end;
  164.  
  165.    if k<3 then jt[1]:='jedna';
  166.    if j=1 then rad:=rad+jt[l];
  167.    k:=k-1;
  168.  
  169.  {
  170.  
  171.   writeln(l);
  172.   writeln(j);
  173.   writeln(k);
  174.   writeln(rad);
  175.  
  176.  }
  177.  
  178.  
  179.   end { pro code=0 }
  180.   else
  181.   begin
  182.  
  183.    if (lo=1) and (kus1[i]='T') then m:=5;
  184.  
  185.    if not((m=2)or(m=3)or(m=4)) then
  186.    begin
  187.     if kus1[i]='M' then rad:=rad+'milión';
  188.     if kus1[i]='T' then rad:=rad+'tisíc';
  189.    end
  190.    else
  191.    begin
  192.     if n=0  then
  193.     begin
  194.      if kus1[i]='M' then rad:=rad+'milióny';
  195.     end
  196.     else
  197.     begin
  198.      if kus1[i]='M' then rad:=rad+'miliónû';
  199.     end;
  200.     if kus1[i]='T' then rad:=rad+'tisíce';
  201.    end;
  202.  
  203.    if kus1[i]='M' then lo:=0;
  204.    if kus1[i]='T' then lo:=0;
  205.  
  206.   {
  207.  
  208.   writeln(l);
  209.   writeln(j);
  210.   writeln(k);
  211.   writeln(rad);
  212.  
  213.   }
  214.  
  215.  
  216.   end; { pro code=1 }
  217.   m:=l;
  218.   end;
  219.  
  220.   rad:=rad+'korun';
  221.  
  222.   if rad='korun' then rad:='';
  223.   if rad='jednakorun' then rad:='jednakoruna';
  224.   if rad='dvakorun' then rad:='dvêkoruny';
  225.   if rad='t⌐ikorun' then rad:='t⌐ikoruny';
  226.   if rad='çty⌐ikorun' then rad:='çty⌐ikoruny';
  227.  
  228.   if not(kus2='') then
  229.   begin
  230.   if not(rad='') then rad:=rad+' ';
  231.  
  232.   m:=1;
  233.   k:=2;
  234.  
  235.   for i:=1 to ord(kus2[0]) do
  236.   begin
  237.  
  238.   j:=k;
  239.   while j>3 do j:=j-3;
  240.   val(kus2[i],l,code);
  241.   if code=0 then
  242.   begin
  243.    if j=3 then rad:=rad+st[l];
  244.    n:=0;
  245.    if j=2 then
  246.    begin
  247.      if l=1 then
  248.      begin
  249.       val(kus2[i+1],l,code);
  250.       if l=0 then rad:=rad+'deset';
  251.       if l=1 then rad:=rad+'jedenáct';
  252.       if l=2 then rad:=rad+'dvanáct';
  253.       if l=3 then rad:=rad+'t⌐ináct';
  254.       if l=4 then rad:=rad+'çtrnáct';
  255.       if l=5 then rad:=rad+'patnáct';
  256.       if l=6 then rad:=rad+'¿estnáct';
  257.       if l=7 then rad:=rad+'sedmnáct';
  258.       if l=8 then rad:=rad+'osmnáct';
  259.       if l=9 then rad:=rad+'devatenáct';
  260.       k:=k-1;
  261.       i:=i+1;
  262.  
  263.      end
  264.      else rad:=rad+dt[l];
  265.    end;
  266.    if j=1 then rad:=rad+jt[l];
  267.    k:=k-1;
  268.   end; { pro code=0 }
  269.  
  270.   m:=l;
  271.   end;
  272.   rad:=rad+'halé⌐û';
  273.  
  274.   end;    { pro kus2 }
  275.  
  276.   znak:=upcase(rad[1]);
  277.   if znak='¿' then znak:='¢';
  278.   if znak='ç' then znak:='Ç';
  279.   rad[1]:=znak;
  280.  
  281.   {
  282.   writeln(rad);
  283.   readln;
  284.   }
  285.  
  286.   rewrite(aa);
  287.   writeln(aa,rad);
  288.   close(aa);
  289.  
  290.  end;  { pro chybu }
  291. end;
  292. end.