Вывод числа прописью

    uses Crt;
      type
        nazw = array[0..9] of String[15];
      const
        ed : nazw = (' ноль ',' один ',' два ',' три ',' четыре ',' пять ',' шесть ',' семь ',' восемь ',' девять ');
        des: nazw = (' ',' десять ',' двадцать ',' тридцать ',' сорок ',' пятьдесят ',' шестьдесят ',' семьдесят ',' восемьдесят ',' девяносто ');
        sot: nazw = (' ',' сто ',' двести ',' тристо ',' четыресто ',' пятьсот ',' шестьсот ',' семьсот ',' восемьсот ',' девятьсот ');
        dd : nazw = (' ',' одинадцать ',' двенадцать ',' тринадцать ',' четырнадцать ',' пятнадцать ',' шестнадцать ',' семнадцать ',' восемьнадцать ',' девятнадцать ');
      var
        s,d,e,x : Integer;
        st      : String;
      Begin
        Write('Введите число [0..1000] :'); Readln(x);
       if x=1000 then st:=' тысяча ' else
      if (x=2000) then st:=' две тысячи ' else begin
        s:= x div 100; x:=x mod 100; st:=sot[s];
        d:= x div 10; e:=x mod 10;
        if (d=1) and (e<>0) then st:=st+dd[e]
                            else st:=st+des[d]+ed[e];
       end;
        writeln(st);
        readln;
      End.

uses Crt;
type nazw = array[0..9] of String[15];
const
ed : nazw = ('',' один',' два',' три',' четыре',' пять',' шесть',' семь',
              ' восемь',' девять');
des: nazw = ('',' десять',' двадцать',' тридцать',' сорок',' пятьдесят',
             ' шестьдесят',' семьдесят',' восемьдесят ',' девяносто');
sot: nazw = ('',' сто',' двести',' триста',' четыреста',' пятьсот',' шестьсот',
             ' семьсот',' восемьсот',' девятьсот');
dd : nazw = ('',' одинадцать',' двенадцать',' тринадцать',' четырнадцать',
             ' пятнадцать',' шестнадцать',' семнадцать',' восемьнадцать',
             ' девятнадцать');
tys: array[1..3] of string[15]=('одна тысяча','две тысячи','три тысячи');
var t,s,d,e,x : Integer;
    st      : String;
Begin
repeat
Write('Введите число [0..3000] :');
Readln(x);
until (x>=0)and(x<=3000);
if x=0 then
 begin
  writeln('ноль');
  exit
 end;
st:='';
t:=x div 1000;
if t>0 then st:=st+tys[t];
s:=x div 100 mod 10;
st:=st+sot[s];
x:=x mod 100;
d:=x div 10;
e:=x mod 10;
if (d=1) and (e<>0) then st:=st+dd[e]
else st:=st+des[d]+ed[e];
writeln(st);
End.