N1: array[0..9] of string = ('ноль',
   'один',
   'два',
   'три',
   'четыре',
   'пять',
   'шесть',
   'семь',
   'восемь',
   'девять');

N1000: array[1..9] of string = ('одна',
   'две',
   'три',
   'четыре',
   'пять',
   'шесть',
   'семь',
   'восемь',
   'девять');

N11: array[0..9] of string = ('десять',
   'одиннадцать',
   'двенадцать',
   'тринадцать',
   'четырнадцать',
   'пятнадцать',
   'шестнадцать',
   'семнадцать',
   'восемнадцать',
   'девятнадцать');

N2: array[1..9] of string = ('десять',
   'двадцать',
   'тридцать',
   'сорок',
   'пятьдесят',
   'шестьдесят',
   'семьдесят',
   'восемьдесят',
   'девяносто');

N3: array[1..9] of string = ('сто',
   'двести',
   'триста',
   'четыреста',
   'пятьсот',
   'шестьсот',
   'семьсот',
   'восемьсот',
   'девятьсот');

NThousand: array[1..3] of string = ('тысяча ',
   'тысячи ',
   'тысяч ');

NMillion: array[1..3] of string = ('миллион ',
'миллиона ',
'миллионов ');

function IntToStroka(n: Integer): AnsiString;
var
i, j, dec, j0: Integer;
s: string;
degt, degm: boolean;
buf: string;
begin
degt := false;
degm := false;
s := IntToStr(n);
Result := '';
for i := length(s) downto 1 do
begin
   dec := (length(s) - i + 1); // получим разряд
   j := StrToInt(s[i]); // получим цифру
   if j = 0 then
     j0 := 0;
   if (not (j in [1..9])) and (dec <> 1) then
     Continue;
   if Dec in [1, 4, 7, 10] then
   try
     if StrToInt(s[i - 1]) = 1 then
     begin
       j0 := j;
       Continue;
     end; // подготовка к 10..19 тысяч/миллионов
   except
   end;
   if Dec in [2, 5, 8, 11] then
     if j = 1 then
     begin
       case dec of
         2: Result := N11[j0] + ' '; // если 10..19 тысяч/миллионов
         5:
           begin
             Result := N11[j0] + ' ' + NThousand[3] + Result;
             degt := true;
           end;
         8:
           begin
             Result := N11[j0] + ' ' + NMillion[3] + Result;
             degm := true;
           end;
       end;
       Continue;
     end;
   if DEC in [4..6] then
   begin
     if (j <> 0) and (not degt) then
     begin
       if dec = 4 then
         case j of
           1: buf := NThousand[1];
           2..4: buf := NThousand[2];
             // прибавим слово тысяча если ещё не добавляли
           5..9: buf := NThousand[3];
         end
       else
         buf := NThousand[3];
       degt := true;
     end;
   end;
   if DEC in [7..9] then
   begin
     if (j <> 0) and (not degm) then
     begin
       if dec = 7 then
         case j of
           1: buf := NMillion[1];
           2..4: buf := NMillion[2];
             // прибавим слово миллион если ещё не добавляли
           5..9: buf := NMillion[3];
         end
       else
         buf := NMillion[3];
       degm := true;
     end;
   end;
   Result := buf + Result;
   while dec > 3 do
     dec := dec - 3;
 
   case Dec of
     1: if j <> 0 then
         if degt and (not degm) then
           Result := N1000[j] + ' ' + Result
         else
           Result := N1[j] + ' ' + Result; // 3 три
     2: Result := N2[j] + ' ' + Result; // 23 двадцать три
     3: Result := N3[j] + ' ' + Result; // 123 сто двадцать три
   end;
   Buf := '';
   j0 := j;
end;
end;