function TextSum(S: double): string;

 

  function Conv999(M: longint; fm: integer): string;

  const

 

    c1to9m: array[1..9] of string[6] =

    ('один', 'два', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять');

    c1to9f: array[1..9] of string[6] =

    ('одна', 'две', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять');

    c11to19: array[1..9] of string[12] =

    ('одиннадцать', 'двенадцать', 'тринадцать', 'четырнадцать', 'пятнадцать',

      'шестнадцать', 'семнадцать', 'восемнадцать', 'девятнадцать');

    c10to90: array[1..9] of string[11] =

    ('десять', 'двадцать', 'тридцать', 'сорок', 'пятьдесят', 'шестьдесят',

      'семьдесят', 'восемьдесят', 'девяносто');

    c100to900: array[1..9] of string[9] =

    ('сто', 'двести', 'триста', 'четыреста', 'пятьсот', 'шестьсот', 'семьсот',

      'восемьсот', 'девятьсот');

  var

 

    s: string;

    i: longint;

  begin

 

    s := '';

    i := M div 100;

    if i <> 0 then s := c100to900[i] + ' ';

    M := M mod 100;

    i := M div 10;

    if (M > 10) and (M < 20) then

      s := s + c11to19[M - 10] + ' '

    else

      begin

        if i <> 0 then s := s + c10to90[i] + ' ';

        M := M mod 10;

        if M <> 0 then

          if fm = 0 then

            s := s + c1to9f[M] + ' '

          else

            s := s + c1to9m[M] + ' ';

      end;

    Conv999 := s;

  end;

 

{--------------------------------------------------------------}

var

 

  i: longint;

  j: longint;

  r: real;

  t: string;

 

begin

 

  t := '';

 

  j := Trunc(S / 1000000000.0);

  r := j;

  r := S - r * 1000000000.0;

  i := Trunc(r);

  if j <> 0 then

    begin

      t := t + Conv999(j, 1) + 'миллиард';

      j := j mod 100;

      if (j > 10) and (j < 20) then

        t := t + 'ов '

      else

        case j mod 10 of

          0: t := t + 'ов ';

          1: t := t + ' ';

          2..4: t := t + 'а ';

          5..9: t := t + 'ов ';

        end;

    end;

 

  j := i div 1000000;

  if j <> 0 then

    begin

      t := t + Conv999(j, 1) + 'миллион';

      j := j mod 100;

      if (j > 10) and (j < 20) then

        t := t + 'ов '

      else

        case j mod 10 of

          0: t := t + 'ов ';

          1: t := t + ' ';

          2..4: t := t + 'а ';

          5..9: t := t + 'ов ';

        end;

    end;

 

  i := i mod 1000000;

  j := i div 1000;

  if j <> 0 then

    begin

      t := t + Conv999(j, 0) + 'тысяч';

      j := j mod 100;

      if (j > 10) and (j < 20) then

        t := t + ' '

      else

        case j mod 10 of

          0: t := t + ' ';

          1: t := t + 'а ';

          2..4: t := t + 'и ';

          5..9: t := t + ' ';

        end;

    end;

 

  i := i mod 1000;

  j := i;

  if j <> 0 then t := t + Conv999(j, 1);

  t := t + 'руб. ';

 

  i := Round(Frac(S) * 100.0);

  t := t + Long2Str(i) + ' коп.';

  TextSum := t;

end;

unit RoubleUnit;

{$D Пропись © Близнец Антон '99 http:\anton-bl.chat.ru\delphi01.htm }

{ 1000011.01->'Один миллион одинадцать рублей 01 копейка'               }

interface

function RealToRouble(c: Extended): string;

implementation

uses SysUtils, math;

const Max000 = 6; {Кол-во триплетов - 000}

  MaxPosition = Max000 * 3; {Кол-во знаков в числе }

//Аналог IIF в Dbase есть в proc.pas для основных типов, частично объявлена тут для независимости

function IIF(i: Boolean; s1, s2: Char): Char; overload; begin if i then

    result := s1

  else

    result := s2 end;

function IIF(i: Boolean; s1, s2: string): string; overload; begin if i then

    result := s1

  else

    result := s2 end;

 

function NumToStr(s: string): string; {Возвращает число прописью}

const c1000: array[0..Max000] of string = ('', 'тысяч', 'миллион', 'миллиард', 'триллион', 'квадраллион', 'квинтиллион');

 

  c1000w: array[0..Max000] of Boolean = (False, True, False, False, False, False, False);

  w: array[False..True, '0'..'9'] of string[3] = (('ов ', ' ', 'а ', 'а ', 'а ', 'ов ', 'ов ', 'ов ', 'ов ', 'ов '),

    (' ', 'а ', 'и ', 'и ', 'и ', ' ', ' ', ' ', ' ', ' '));

  function Num000toStr(S: string; woman: Boolean): string; {Num000toStr возвращает число для триплета}

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

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

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

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

      ('', 'одна ', 'две ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '));

  begin {Num000toStr}

    Result := c100[s[1]] + iif((s[2] = '1') and (s[3] > '0'), c11[s[3]] + 'надцать ', c10[s[2]] + c1[woman, s[3]]);

  end; {Num000toStr}

 

var s000: string[3];

 

  isw, isMinus: Boolean;

  i: integer; //Счётчик триплетов

begin

 

  Result := ''; i := 0;

  isMinus := (s <> '') and (s[1] = '-');

  if isMinus then s := Copy(s, 2, Length(s) - 1);

  while not ((i >= Ceil(Length(s) / 3)) or (i >= Max000)) do

    begin

      s000 := Copy('00' + s, Length(s) - i * 3, 3);

      isw := c1000w[i];

      if (i > 0) and (s000 <> '000') then //тысячи и т.д.

        Result := c1000[i] + w[Isw, iif(s000[2] = '1', '0', s000[3])] + Result;

      Result := Num000toStr(s000, isw) + Result;

      Inc(i)

    end;

  if Result = '' then Result := 'ноль';

  if isMinus then Result := 'минус ' + Result;

end; {NumToStr}

 

function RealToRouble(c: Extended): string;

 

const ruble: array['0'..'9'] of string[2] = ('ей', 'ь', 'я', 'я', 'я', 'ей', 'ей', 'ей', 'ей', 'ей');

  Kopeek: array['0'..'9'] of string[3] = ('ек', 'йка', 'йки', 'йки', 'йки', 'ек', 'ек', 'ек', 'ек', 'ек');

 

  function ending(const s: string): Char;

  var l: Integer; //С l на 8 байт коротче ->->F

  begin //Возвращает индекс окончания

    l := Length(s);

    Result := iif((l > 1) and (s[l - 1] = '1'), '0', s[l]);

  end;

 

var rub: string[MaxPosition + 3]; kop: string[2];

begin {Возвращает число прописью с рублями и копейками}

 

  Str(c: MaxPosition + 3: 2, Result);

  if Pos('E', Result) = 0 then //Если число можно представить в строке <>1E+99

    begin

      rub := TrimLeft(Copy(Result, 1, Length(Result) - 3));

      kop := Copy(Result, Length(Result) - 1, 2);

      Result := NumToStr(rub) + ' рубл' + ruble[ending(rub)]

        + ' ' + kop + ' копе' + Kopeek[ending(kop)];

      Result := AnsiUpperCase(Result[1]) + Copy(Result, 2, Length(Result) - 1);

    end;

end;

end.

function CifrToStr(Cifr: string; Pr: Integer; Padeg: Integer): string;

{Функция возвращает прописью 1 цифры признак 3-единицы 2-десятки 1-сотни 4-11-19

 

Padeg - 1-нормально 2- одна, две }

var i: Integer;

begin

 

  i := StrToInt(Cifr);

  if Pr = 1 then

    case i of

      1: CifrToStr := 'сто';

      2: CifrToStr := 'двести';

      3: CifrToStr := 'триста';

      4: CifrToStr := 'четыреста';

      5: CifrToStr := 'пятьсот';

      6: CifrToStr := 'шестьсот';

      7: CifrToStr := 'семьсот';

      8: CifrToStr := 'восемьсот';

      9: CifrToStr := 'девятьсот';

      0: CifrToStr := '';

    end

  else if Pr = 2 then

    case i of

      1: CifrToStr := '';

      2: CifrToStr := 'двадцать';

      3: CifrToStr := 'тридцать';

      4: CifrToStr := 'сорок';

      5: CifrToStr := 'пятьдесят';

      6: CifrToStr := 'шестьдесят';

      7: CifrToStr := 'семьдесят';

      8: CifrToStr := 'восемьдесят';

      9: CifrToStr := 'девяносто';

      0: CifrToStr := '';

    end

  else if Pr = 3 then

    case i of

      1: if Padeg = 1 then

          CifrToStr := 'один'

        else

          CifrToStr := 'одна';

      2: if Padeg = 1 then

          CifrToStr := 'два'

        else

          CifrToStr := 'две';

      3: CifrToStr := 'три';

      4: CifrToStr := 'четыре';

      5: CifrToStr := 'пять';

      6: CifrToStr := 'шесть';

      7: CifrToStr := 'семь';

      8: CifrToStr := 'восемь';

      9: CifrToStr := 'девять';

      0: CifrToStr := '';

    end

  else if Pr = 4 then

    case i of

      1: CifrToStr := 'одиннадцать';

      2: CifrToStr := 'двенадцать';

      3: CifrToStr := 'тринадцать';

      4: CifrToStr := 'четырнадцать';

      5: CifrToStr := 'пятнадцать';

      6: CifrToStr := 'шестнадцать';

      7: CifrToStr := 'семнадцать';

      8: CifrToStr := 'восемнадцать';

      9: CifrToStr := 'девятнадцать';

      0: CifrToStr := 'десять';

 

    end;

end;

 

function Rasryad(K: Integer; V: string): string;

{Функция возвращает наименование разряда в зависимости от последних 2 цифр его}

var j: Integer;

begin

 

  j := StrToInt(Copy(v, Length(v), 1));

  if (StrToInt(Copy(v, Length(v) - 1, 2)) > 9) and (StrToInt(Copy(v, Length(v) - 1, 2)) < 20) then

    case K of

      0: Rasryad := '';

      1: Rasryad := 'тысяч';

      2: Rasryad := 'миллионов';

      3: Rasryad := 'миллиардов';

      4: Rasryad := 'триллионов';

    end

  else

    case K of

      0: Rasryad := '';

      1: case j of

          1: Rasryad := 'тысяча';

          2..4: Rasryad := 'тысячи';

        else

          Rasryad := 'тысяч';

        end;

      2: case j of

          1: Rasryad := 'миллион';

          2..4: Rasryad := 'миллионa';

        else

          Rasryad := 'миллионов';

        end;

      3: case j of

          1: Rasryad := 'миллиард';

          2..4: Rasryad := 'миллиарда';

        else

          Rasryad := 'миллиардов';

        end;

      4: case j of

          1: Rasryad := 'триллион';

          2..4: Rasryad := 'триллиона';

        else

          Rasryad := 'триллионов';

        end;

    end;

end;

 

function GroupToStr(Group: string; Padeg: Integer): string;

{Функция возвращает прописью 3 цифры}

var i: Integer;

 

  S: string;

begin

 

  S := '';

  if (StrToInt(Copy(Group, Length(Group) - 1, 2)) > 9) and (StrToInt(Copy(Group, Length(Group) - 1, 2)) < 20) then

    begin

      if Length(Group) = 3 then

        S := S + ' ' + CifrToStr(Copy(Group, 1, 1), 1, Padeg);

      S := S + ' ' + CifrToStr(Copy(Group, Length(Group), 1), 4, Padeg);

    end

  else

    for i := 1 to Length(Group) do

      S := S + ' ' + CifrToStr(Copy(Group, i, 1), i - Length(Group) + 3, Padeg);

  GroupToStr := S;

end;

 

{Функция возвращает сумму прописью}

function RubToStr(Rubs: Currency; Rub, Kop: string): string;

var i, j: Integer;

 

  R, K, S: string;

begin

 

  S := CurrToStr(Rubs);

  S := Trim(S);

  if Pos(',', S) = 0 then

    begin

      R := S;

      K := '00';

    end

  else

    begin

      R := Copy(S, 0, (Pos(',', S) - 1));

      K := Copy(S, (Pos(',', S) + 1), Length(S));

    end;

 

  S := '';

  i := 0;

  j := 1;

  while Length(R) > 3 do

    begin

      if i = 1 then

        j := 2

      else

        j := 1;

      S := GroupToStr(Copy(R, Length(R) - 2, 3), j) + ' ' + Rasryad(i, Copy(R, Length(R) - 2, 3)) + ' ' + S;

      R := Copy(R, 1, Length(R) - 3);

      i := i + 1;

    end;

  if i = 1 then

    j := 2

  else

    j := 1;

  S := Trim(GroupToStr(R, j) + ' ' + Rasryad(i, R) + ' ' + S + ' ' + Rub + ' ' + K + ' ' + Kop);

  S := ANSIUpperCase(Copy(S, 1, 1)) + Copy(S, 2, Length(S) - 1);

  RubToStr := S;

end;

unit Numinwrd;

 

interface

function sMoneyInWords(Nin: currency): string; export;

function szMoneyInWords(Nin: currency): PChar; export;

{ Денежная сумма Nin в рублях и копейках прописью

 

1997, в.2.1, by О.В.Болдырев}

 

implementation

uses SysUtils, Dialogs, Math;

 

type

 

  tri = string[4];

  mood = 1..2;

  gender = (m, f);

  uns = array[0..9] of string[7];

  tns = array[0..9] of string[13];

  decs = array[0..9] of string[12];

  huns = array[0..9] of string[10];

  nums = array[0..4] of string[8];

  money = array[1..2] of string[5];

  endings = array[gender, mood, 1..3] of tri; {окончания числительных и денег}

 

const

 

  units: uns = ('', 'один ', 'два ', 'три ', 'четыре ', 'пять ',

    'шесть ', 'семь ', 'восемь ', 'девять ');

  unitsf: uns = ('', 'одна ', 'две ', 'три ', 'четыре ', 'пять ',

    'шесть ', 'семь ', 'восемь ', 'девять ');

  teens: tns = ('десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ',

    'четырнадцать ', 'пятнадцать ', 'шестнадцать ',

    'семнадцать ', 'восемнадцать ', 'девятнадцать ');

  decades: decs = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ',

    'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ',

    'девяносто ');

  hundreds: huns = ('', 'сто ', 'двести ', 'триста ', 'четыреста ',

    'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ',

    'девятьсот ');

  numericals: nums = ('', 'тысяч', 'миллион', 'миллиард', 'триллион');

  RusMon: money = ('рубл', 'копе');

  ends: endings = ((('', 'а', 'ов'), ('ь', 'я', 'ей')),

    (('а', 'и', ''), ('йка', 'йки', 'ек')));

threadvar

 

  str: string;

 

function EndingIndex(Arg: integer): integer;

begin

 

  if ((Arg div 10) mod 10) <> 1 then

    case (Arg mod 10) of

      1: Result := 1;

      2..4: Result := 2;

    else

      Result := 3;

    end

  else

    Result := 3;

end;

 

function sMoneyInWords(Nin: currency): string; { Число Nin прописью, как функция }

var

//  str: string;

 

  g: gender; //род

  Nr: comp; {целая часть числа}

  Fr: integer; {дробная часть числа}

  i, iTri, Order: longint; {триада}

 

  procedure Triad;

  var

    iTri2: integer;

    un, de, ce: byte; //единицы, десятки, сотни

 

    function GetDigit: byte;

    begin

      Result := iTri2 mod 10;

      iTri2 := iTri2 div 10;

    end;

 

  begin

    iTri := trunc(Nr / IntPower(1000, i));

    Nr := Nr - int(iTri * IntPower(1000, i));

    iTri2 := iTri;

    if iTri > 0 then

      begin

        un := GetDigit;

        de := GetDigit;

        ce := GetDigit;

        if i = 1 then

          g := f

        else

          g := m; {женского рода только тысяча}

 

        str := TrimRight(str) + ' ' + Hundreds[ce];

        if de = 1 then

          str := TrimRight(str) + ' ' + Teens[un]

        else

          begin

            str := TrimRight(str) + ' ' + Decades[de];

            case g of

              m: str := TrimRight(str) + ' ' + Units[un];

              f: str := TrimRight(str) + ' ' + UnitsF[un];

            end;

          end;

 

        if length(numericals[i]) > 1 then

          begin

            str := TrimRight(str) + ' ' + numericals[i];

            str := TrimRight(str) + ends[g, 1, EndingIndex(iTri)];

          end;

      end; //triad is 0 ?

 

    if i = 0 then Exit;

    Dec(i);

    Triad;

  end;

 

begin

 

  str := '';

  Nr := int(Nin);

  Fr := round(Nin * 100 + 0.00000001) mod 100;

  if Nr > 0 then

    Order := trunc(Log10(Nr) / 3)

  else

    begin

      str := 'ноль';

      Order := 0

    end;

  if Order > High(numericals) then

    raise Exception.Create('Слишком большое число для суммы прописью');

  i := Order;

  Triad;

  str :=

    Format('%s %s%s %.2d %s%s', [Trim(str), RusMon[1], ends[m, 2, EndingIndex(iTri)],

    Fr, RusMon[2], ends[f, 2, EndingIndex(Fr)]]);

  str[1] := (ANSIUpperCase(copy(str, 1, 1)))[1];

  str[Length(str) + 1] := #0;

  Result := str;

end;

 

function szMoneyInWords(Nin: currency): PChar;

begin

 

  sMoneyInWords(Nin);

  Result := @(str[1]);

end;

 

end.