program CastkaSlovy;
var
  r : real;
function Slovy(c: longint) : string;
var
  s : string;
  i : byte;
  w : word;
function Stovky(w : word) : string;
const
  JTab : array[0..9] of string[5] = (
    '','jeden','dva','tri','ctyri','pet',
    'sest','sedm','osm','devet');
  DTab : array[10..19] of string[10] = (
    'deset','jedenact','dvanact','trinact','ctrnact','patnact',
    'sestnact','sedmnact','osmnact','devatenact');
  D1Tab : array[2..9] of string[9] = (
    'dvacet','tricet','ctyricet','padesat',
    'sedesat','sedmdesat','osmdesat','devadesat');
var s: string;
    p: word;
begin
  s:= '';
  if w <> 0 then begin
    p:= w div 100;
    if p = 1 then s:= 'jedno ' else
      if p = 2 then s:= 'dve ' else s:= JTab[p];
    case p of
      1:    s:= s+'sto ';
      2:    s:= s+'ste ';
      3,4:  s:= s+'sta ';
      5..9: s:= s+'set ';
    end;
    w:= w mod 100;
    case w of
      1..9:   s:= s+JTab[w];
      10..19: s:= s+DTab[w];
      20..99: s:= s+D1Tab[w div 10]+' '+JTab[w mod 10];
    end;
  end;
  Stovky:= s;
end;
begin
  if c = 0 then begin
    Slovy:= 'nula';
    Exit
  end;
  w:= c div 1000000;
  if (w mod 100) in [11..19]
  then s:= Stovky(w mod 1000)+ ' milionu '
  else case w mod 10 of
    0:    if w > 0 then s:= Stovky(w mod 1000)+' milionu '
                   else s:= '';
    1:    s:= Stovky(w mod 1000)+' milion ';
    2..4: s:= Stovky(w mod 1000)+' miliony ';
    5..9: s:= Stovky(w mod 1000)+' milionu ';
  end;
  c:= c mod 1000000;
  w:= c div 1000;
  if (w mod 100) in [11..19]
  then s:= s+Stovky(w mod 1000)+ ' tisic '
  else case w mod 10 of
    0:      if w > 0 then s:= s+Stovky(w mod 1000)+' tisic ';
    1,5..9: s:= s+Stovky(w mod 1000)+' tisic ';
    2..4:   s:= s+Stovky(w mod 1000)+' tisice ';
  end;
  s:= s+Stovky(c mod 1000);
  while s[1] = ' ' do Delete(s,1,1);
  i:= 1;
  repeat
    while (i < length(s)) and (s[i] <> ' ') do Inc(i);
    if (i < length(s)) and (s[i+1] = ' ') then Delete(s,i,1);
    Inc(i);
  until i >= length(s);
  Slovy:= s;
end;
begin
  writeln('Tento program prevadi ciselny na slovni udaj.');
  writeln('Prevod konci zadanim zaporne castky');
  repeat
    write('Zadej castku: '); readln(r);
    if r >= 0 then writeln('Castka slovy: ',Slovy(Trunc(r)));
  until r < 0;
end.
Maturita.cz - referát (verze pro snadný tisk)
http://www.maturita.cz/referaty/referat.asp?id=1296