Code:

{------------------------ Деньги прописью ---------------------}

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;

Code:

unit RoubleUnit;

{$D Пропись © Близнец Антон '99 http:\\anton-bl.chat.ru\delphi\1001.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 байт коротче $50->$48->$3F

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.

Code:

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;

Code:

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.

Code:

unit FullSum;

interface

uses SysUtils;

{

Функция перевода суммы, записанной цифрами в сумму прописью :

например, 23.12 -> двадцать три рубля 12 копеек.

переводит до 999999999 руб. 99 коп.

Функция не отслеживает, правильное ли значение получено в параметре Number

(т.е. положительное и округленное с точностью до сотых) - эту проверку

необходимо провести до вызова функции.

}

//----------------- Copyright (c) 1999 by Константин Егоров

//----------------- mailto: egor@vladi.elektra.ru

function SumNumToFull(Number: real): string;

implementation

function SumNumToFull(Number:real):string;

var

PartNum, TruncNum, NumTMP, D: integer;

NumStr : string;

i, R : byte;

Flag11 : boolean;

begin

D:=1000000;

R:=4;

//выделяем рубли

TruncNum:=Trunc(Number);

if TruncNum<>0 then

   repeat

     PartNum:=TruncNum div D;

     Dec(R);

     D:=D div 1000;

   until

     PartNum<>0

else

   R:=0;

// перевод рублей

for i:=R downto 1 do

begin

   Flag11:=False;

   // выделение цифры сотен

   NumTMP:=PartNum div 100;

   case NumTMP of

     1: NumStr:=NumStr+'сто ';

     2: NumStr:=NumStr+'двести ';

     3: NumStr:=NumStr+'триста ';

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

     5: NumStr:=NumStr+'пятьсот ';

     6: NumStr:=NumStr+'шестьсот ';

     7: NumStr:=NumStr+'семьсот ';

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

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

   end;

   // выделение цифры десятков

   NumTMP:=(PartNum mod 100) div 10;

   case NumTMP of

     1:

     begin

       NumTMP:=PartNum mod 100;

       case NumTMP of

         10: NumStr:=NumStr+'десять ';

         11: NumStr:=NumStr+'одиннадцать ';

         12: NumStr:=NumStr+'двенадцать ';

         13: NumStr:=NumStr+'тринадцать ';

         14: NumStr:=NumStr+'четырнадцать ';

         15: NumStr:=NumStr+'пятнадцать ';

         16: NumStr:=NumStr+'шестнадцать ';

         17: NumStr:=NumStr+'семнадцать ';

         18: NumStr:=NumStr+'восемнадцать ';

         19: NumStr:=NumStr+'девятнадцать ';

       end;

       case i of

         3: NumStr:=NumStr+'миллионов ';

         2: NumStr:=NumStr+'тысяч ';

         1: NumStr:=NumStr+'рублей ';

       end;

       Flag11:=True;

     end;

     2: NumStr:=NumStr+'двадцать ';

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

     4: NumStr:=NumStr+'сорок ';

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

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

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

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

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

   end;

   // выделение цифры единиц

   NumTMP:=PartNum mod 10;

   if not Flag11 then

   begin

     case NumTMP of

       1:

         if i=2 then

           NumStr:=NumStr+'одна '

         else

           NumStr:=NumStr+'один ';

       2:

         if i=2 then

           NumStr:=NumStr+'две '

         else

           NumStr:=NumStr+'два ';

       3: NumStr:=NumStr+'три ';

       4: NumStr:=NumStr+'четыре ';

       5: NumStr:=NumStr+'пять ';

       6: NumStr:=NumStr+'шесть ';

       7: NumStr:=NumStr+'семь ';

       8: NumStr:=NumStr+'восемь ';

       9: NumStr:=NumStr+'девять ';

     end;

     case i of

       3:

         case NumTMP of

           1: NumStr:=NumStr+'миллион ';

           2,3,4: NumStr:=NumStr+'миллиона ';

           else

             NumStr:=NumStr+'миллионов ';

         end;

       2:

         case NumTMP of

           1 : NumStr:=NumStr+'тысяча ';

           2,3,4: NumStr:=NumStr+'тысячи ';

           else

             if PartNum<>0 then

               NumStr:=NumStr+'тысяч ';

         end;

       1:

         case NumTMP of

           1 : NumStr:=NumStr+'рубль ';

           2,3,4: NumStr:=NumStr+'рубля ';

           else

             NumStr:=NumStr+'рублей ';

         end;

     end;

   end;

   if i>1 then

   begin

     PartNum:=(TruncNum mod (D*1000)) div D;

     D:=D div 1000;

   end;

end;

//перевод копеек

PartNum:=Round(Frac(Number)*100);

if PartNum=0 then

begin

   SumNumToFull:=NumStr+'00 копеек';

   Exit;

end;

// выделение цифры десятков

NumTMP:=PartNum div 10;

if NumTMP=0 then

   NumStr:=NumStr+'0'+IntToStr(PartNum)+' '

else

   NumStr:=NumStr+IntToStr(PartNum)+' ';

// выделение цифры единиц

NumTMP:=PartNum mod 10;

case NumTMP of

   1:

     if PartNum<>11 then

       NumStr:=NumStr+'копейка'

     else

       NumStr:=NumStr+'копеек';

   2,3,4:

     if (PartNum<5) or (PartNum>14) then

       NumStr:=NumStr+'копейки'

     else

       NumStr:=NumStr+'копеек';

   else

     NumStr:=NumStr+'копеек';

end;

SumNumToFull:=NumStr;

end;

end.

Code:

{ Преобразует трехзначное число в строку }

function ConvertToWord(N: word): string;

const

Sot : array[1..9] of string[13] =

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

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

Des : array[2..9] of string[13] =

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

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

Edin : array[0..19] of string[13] =

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

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

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

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

var

S: string;

begin

S:='';

N:=N mod 1000;

if N>99 then

begin

   S:=Sot[N div 100]+' ';

   N:=N mod 100;

end;

if N>19 then

begin

   S:=S+Des[N div 10]+' ';

   N:=N mod 10;

end;

Result:=S+Edin[N];

end;

{ Возвращает сумму прописью }

function CenaToStr(r: Currency): string;

var

N, k: longint;

S: string;

begin

N:=trunc(R); S:='';

if N<>0 then

begin

   if N>999999 then

   begin

     k:=N div 1000000;

     S:=ConvertToWord(k);

     if ((k-(k div 100)*100)>10) and ((k-(k div 100)*100)<20) then

       S:=S+' миллионов'

     else

     if (k mod 10)=1 then

       S:=S+' миллион'

     else

     if ((k mod 10)>=2)and((k mod 10)<=4) then

       S:=S+' миллиона'

     else

       S:=S+' миллионов';

     N:=N mod 1000000;

   end;

   if N>999 then

   begin

     k:=N div 1000;

     S:=S+' '+ConvertToWord(k);

     if ((k-(k div 100)*100)>10)and((k-(k div 100)*100)<20) then

       S:=S+' тысяч'

     else

     if (k mod 10)=1 then

     begin

       SetLength(S, Length(S)-2);

       S:=S+'на тысяча';

     end

     else

     if (k mod 10)=2 then

     begin

       SetLength(S, length(S)-1);

       S:=S+'е тысячи';

     end

     else

     if ((k mod 10)>=3)and((k mod 10)<=4) then

       S:=S+' тысячи'

     else

       S:=S+' тысяч';

     N:=N mod 1000;

   end;

   k:=N;

   S:=S+' '+ConvertToWord(k);

   if ((k-(k div 100)*100)>10)and((k-(k div 100)*100)<20) then

     S:=S+' рублей'

   else

   if (k mod 10)=1 then

     S:=S+' рубль'

   else

   if (k mod 10)=2 then

     S:=S+' рубля'

   else

   if ((k mod 10)>=3)and((k mod 10)<=4) then

     S:=S+' рубля'

   else

     S:=S+' рублей';

end;

if trunc(R)<>R then

begin

   k:=round(frac(R)*100);

   S:=S+' '+IntToStr(K);

   if ((k-(k div 100)*100)>10)and((k-(k div 100)*100)<20) then

     S:=S+' копеек'

   else

   if (k mod 10)=1 then

   begin

     S:=S+' копейка';

   end

   else

   if (k mod 10)=2 then

   begin

     S:=S+' копейки';

   end

   else

   if ((k mod 10)>=3)and((k mod 10)<=4) then

     S:=S+' копейки'

   else

     S:=S+' копеек';

end

else

   S:=S+' 00 копеек';

S:=Trim(S);

if S<>'' then

   S[1]:=AnsiUpperCase(S[1])[1];

result:=S;

end;

Code:

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Сумма прописью

Данный набор функций позволяет из суммы в числовом виде получить

её представление прописью. Реализована возможность работы с рублями и долларами.

Возможно добавление какой угодно валюты.

Зависимости: SysUtils

Автор:       fnatali, fnatali@yandex.ru, Березники

Copyright:   Евгений Меньшенин <johnmen@mail.ru>

Дата:        27 апреля 2002 г.

***************************************************** }

unit SpellingD;

interface

uses SysUtils;

function SpellPic(StDbl: double; StSet: integer): string;

implementation

const

Money: array[0..1] of string[25] =

('ь я рубл ей коп. ',

   'р ра долларов цент.');

{А Б В Г Д Е Ж З И Й К Л М Н О

       П Р С Т У Ф Х Ц Ч Ш Щ Ъ Ы Ь

       Э Ю Я а б в г д }

Sym: string[180] =

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

   + 'на дцатьсорокдевяно сто сти ста ьсот тысяча и миллион '

   + 'ов ард ноль ь я рубл ей коп. ';

Code: string[156] =

'БААВААГААДААЕААЖЗАИЙАКЙАЛЙАМЙАНЙАОЙАГПРВПРЕПРЖПРИПРКПРЛПРМПРНПРДРАЕРА'

   +

   'СААИЙОКЙОЛЙОМЙОТУФФААВХАЕЦАЖЗЦИЧАКЧАЛЧАМЧАНЧАваАвбАвгАШЩАШЪАШААЫЬАЫЬЩ'

   + 'ЫЬЭЫЮАЫЮЩЫЮЭЯААдАА';

{1 2 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 30

  40 50 60 70 80 90 1 2 3 4 5 6 7 8 9 РУБ -Я-ЕЙТЫС -И -ЧМ-Н-А

   -ВМ-Д -А -В0 коп}

{0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

  23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45

  46 47 48 49 50 51 }

function SpellPic(StDbl: double; StSet: integer): string;

{format of StNum: string[15]= 000000000000.00}

const

StMask = '000000000000.00';

var

StNum: string; {StDbl -> StNum}

PlaceNo: integer; {текущая позиция в StNum}

TripletNo: integer; {позиция имени обрабатываемого разряда (им.п.ед.ч.)}

StWord: string; {результат}

procedure WordAdd(CodeNo: integer);

var

   SymNo: integer; {текущая позиция в массиве Sym}

   i, j: integer;

begin

   ;

   Inc(CodeNo, CodeNo shl 1); {* 3}

   for i := 1 to 3 do

   begin

     ;

     Inc(CodeNo);

     SymNo := ord(Code[CodeNo]) - ord('Б');

     if SymNo < 0 then

       break;

     Inc(SymNo, SymNo shl 2); {* 5}

     for j := 1 to 5 do

     begin

       ;

       Inc(SymNo);

       if Sym[SymNo] = ' ' then

         break;

       StWord := StWord + Sym[SymNo];

     end;

   end;

   StWord := StWord + ' ';

end;

procedure Triplet;

var

   D3: integer; {сотни текущего разряда}

   D2: integer; {десятки текущего разряда}

   D1: integer; {единицы текущего разряда}

   TripletPos: integer; {смещение имени разряда для разных падежей}

begin

   ;

   Inc(PlaceNo);

   D3 := ord(StNum[PlaceNo]) - ord('0');

   Inc(PlaceNo);

   D2 := ord(StNum[PlaceNo]) - ord('0');

   Inc(PlaceNo);

   D1 := ord(StNum[PlaceNo]) - ord('0');

   Dec(TripletNo, 3);

   TripletPos := 2; {рублей (род.п.мн.ч.)}

   if D3 > 0 then

     WordAdd(D3 + 28);

   {сотни}

   if D2 = 1 then

     WordAdd(D1 + 11)

       {10-19}

   else

   begin

     ;

     if D2 > 1 then

       WordAdd(D2 + 19);

     {десятки}

     if D1 > 0 then

     begin

       ;

       {единицы}

       if (TripletNo = 41) and (D1 < 3) then

         WordAdd(D1 - 1) {одна или две тысячи}

       else

         WordAdd(D1 + 1);

       if D1 < 5 then

         TripletPos := 1; {рубля (род.п.ед.ч.)}

       if D1 = 1 then

         TripletPos := 0; {рубль (им.п.ед.ч.)}

     end;

   end;

   if (TripletNo = 38) and (Length(StWord) = 0) then

     WordAdd(50); {ноль целых}

   if (TripletNo = 38) or (D1 + D2 + D3 > 0) then {имя разряда}

     WordAdd(TripletNo + TripletPos);

end;

var

i: integer;

begin

;

Move(Money[StSet, 1], Sym[156], 25);

StNum := FormatFloat(StMask, StDbl);

PlaceNo := 0;

TripletNo := 50;

{47+3}

StWord := ''; {будущий результат}

for i := 1 to 4 do

   Triplet; {4 разряда: миллиарды, миллионы, тысячи,единицы}

StWord := StWord + StNum[14] + StNum[15] + ' ';

WordAdd(51);

{Upcase первая буква}

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

end;

end.

Пример использования:

var

sumpr: string;

begin

// первый параметр - сумма, которую необходимо перевести в пропись,

// второй параметр - валюта (0-рубли, 1- доллары).

sumpr := spellpic(100, 0);

...

Code:

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Преобразование целого числа 0-999999999 в строку (прописью)

Я думаю, всё итак понятно, что не понятно пишите письма

Зависимости: SysUtils

Автор:       Алексей, ARojkov@okil.ru, СПб

Copyright:   b0b

Дата:        12 марта 2004 г.

***************************************************** }

unit UIntToStroka;

interface

uses SysUtils;

const

N1: array[0..9] of string = ('ноль',

   'один',

   'два',

   'три',

   'четыре',

   'пять',

   'шесть',

   'семь',

   'восемь',

   'девять');

const

N1000: array[1..9] of string = ('одна',

   'две',

   'три',

   'четыре',

   'пять',

   'шесть',

   'семь',

   'восемь',

   'девять');

const

N11: array[0..9] of string = ('десять',

   'одиннадцать',

   'двенадцать',

   'тринадцать',

   'четырнадцать',

   'пятнадцать',

   'шестнадцать',

   'семнадцать',

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

   'девятнадцать');

const

N2: array[1..9] of string = ('десять',

   'двадцать',

   'тридцать',

   'сорок',

   'пятьдесят',

   'шестьдесят',

   'семьдесят',

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

   'девяносто'

   );

const

N3: array[1..9] of string = ('сто',

   'двести',

   'триста',

   'четыреста',

   'пятьсот',

   'шестьсот',

   'семьсот',

   'восемьсот',

   'девятьсот'

   );

const

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

   'тысячи ',

   'тысяч ');

const

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

   'миллиона ',

   'миллионов ');

function IntToStroka(n: Integer): AnsiString;

implementation

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;

end.

Code:

function NumToStr(n: double; c: byte = 0): string;

(*

c=0 - 21.05 -> 'Двадцать один рубль 05 копеек.'

с=1 - 21.05 -> 'двадцать один'

c=2 - 21.05 -> '21-05', 21.00 -> '21='

*)

const

digit: array[0..9] of string = ('ноль', 'оди', 'два', 'три', 'четыр',

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

var

ts, mln, mlrd, SecDes: Boolean;

len: byte;

summa: string;

function NumberString(number: string): string;

var

   d, pos: byte;

   function DigitToStr: string;

   begin

     result := '';

     if (d <> 0) and ((pos = 11) or (pos = 12)) then

       mlrd := true;

     if (d <> 0) and ((pos = 8) or (pos = 9)) then

       mln := true;

     if (d <> 0) and ((pos = 5) or (pos = 6)) then

       ts := true;

     if SecDes then

     begin

       case d of

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

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

       else

         result := digit[d] + 'надцать '

       end;

       case pos of

         4: result := result + 'тысяч ';

         7: result := result + 'миллионов ';

         10: result := result + 'миллиардов '

       end;

       SecDes := false;

       mln := false;

       mlrd := false;

       ts := false

     end

     else

     begin

       if (pos = 2) or (pos = 5) or (pos = 8) or (pos = 11) then

         case d of

           1: SecDes := true;

           2, 3: result := digit[d] + 'дцать ';

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

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

           5..8: result := digit[d] + 'ьдесят '

         end;

       if (pos = 3) or (pos = 6) or (pos = 9) or (pos = 12) then

         case d of

           1: result := 'сто ';

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

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

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

           5..9: result := digit[d] + 'ьсот '

         end;

       if (pos = 1) or (pos = 4) or (pos = 7) or (pos = 10) then

         case d of

           1: result := 'один ';

           2, 3: result := digit[d] + ' ';

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

           5..9: result := digit[d] + 'ь '

         end;

       if pos = 4 then

       begin

         case d of

           0: if ts then

               result := 'тысяч ';

           1: result := 'одна тысяча ';

           2: result := 'две тысячи ';

           3, 4: result := result + 'тысячи ';

           5..9: result := result + 'тысяч '

         end;

         ts := false

       end;

       if pos = 7 then

       begin

         case d of

           0: if mln then

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

           1: result := result + 'миллион ';

           2, 3, 4: result := result + 'миллиона ';

           5..9: result := result + 'миллионов '

         end;

         mln := false

       end;

       if pos = 10 then

       begin

         case d of

           0: if mlrd then

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

           1: result := result + 'миллиард ';

           2, 3, 4: result := result + 'миллиарда ';

           5..9: result := result + 'миллиардов '

         end;

         mlrd := false

       end

     end

   end;

begin

   result := '';

   ts := false;

   mln := false;

   mlrd := false;

   SecDes := false;

   len := length(number);

   if (len = 0) or (number = '0') then

     result := digit[0]

   else

     for pos := len downto 1 do

     begin

       d := StrToInt(copy(number, len - pos + 1, 1));

       result := result + DigitToStr

     end

end;

function MoneyString(number: string): string;

var

   s: string[1];

   n: string;

begin

   len := length(number);

   n := copy(number, 1, len - 3);

   result := NumberString(n);

   s := AnsiUpperCase(result[1]);

   delete(result, 1, 1);

   result := s + result;

   if len < 2 then

   begin

     if len = 0 then

       n := '0';

     len := 2;

     n := '0' + n

   end;

   if copy(n, len - 1, 1) = '1' then

     result := result + 'рублей'

   else

   begin

     case StrToInt(copy(n, len, 1)) of

       1: result := result + 'рубль';

       2, 3, 4: result := result + 'рубля'

     else

       result := result + 'рублей'

     end

   end;

   len := length(number);

   n := copy(number, len - 1, len);

   if copy(n, 1, 1) = '1' then

     n := n + ' копеек.'

   else

   begin

     case StrToInt(copy(n, 2, 1)) of

       1: n := n + ' копейка.';

       2, 3, 4: n := n + ' копейки.'

     else

       n := n + ' копеек.'

     end

   end;

   result := result + ' ' + n

end;

// Основная часть

begin

case c of

   0: result := MoneyString(FormatFloat('0.00', n));

   1: result := NumberString(FormatFloat('0', n));

   2:

     begin

       summa := FormatFloat('0.00', n);

       len := length(summa);

       if copy(summa, len - 1, 2) = '00' then

       begin

         delete(summa, len - 2, 3);

         result := summa + '='

       end

       else

       begin

         delete(summa, len - 2, 1);

         insert('-', summa, len - 2);

         result := summa;

       end;

     end

end;

end;

Code:

unit BuchUtil;

interface

uses IniFiles, SysUtils;

function DoubleChar(ch: string): string;

function NumToSampl(N: string): string;

function MoneyToSampl(M: Currency): string;

procedure LexemsToDim(fstr: string; var dim: array of string);

var

NameNum: array[0..9, 1..4] of string; //массив им?н чисел

Ext: array[0..4, 1..3] of string; //массив расшиений (тысячи, миллионы ...)

Univer: array[1..9, 1..4] of integer; //массив окончаний

Rubl: array[1..3] of string; //массив имен рублей

Cop: array[1..3] of string; //массив имен копеек

Zero: string; //название нуля

One: string; //единица "одна"

Two: string; //двойка "две"

fFile: TIniFile; //файл, откуда загружается пропись

fString: string;

fDim: array[0..9] of string;

i: integer;

implementation

{заполняет массив Dim лексемами}

procedure LexemsToDim(fstr: string; var dim: array of string);

var

i, j: integer;

flex: string;

begin

if Length(fstr) > 0 then

begin

   i := 1;

   j := 0;

   while i - 1 < Length(fstr) do

   begin

     if fstr[i] = ',' then

     begin

       dim[j] := flex + ' ';

       inc(j);

       flex := '';

     end

     else

       flex := flex + fstr[i];

     inc(i);

   end;

end;

end;

{преобразует число в пропись

процедура использует файл lang.cnf}

function NumToSampl(N: string): string;

var

k, i, i_indx: integer;

number, string_num: string;

index: integer;

pos: integer;

fl_ext: boolean;

begin

fl_ext := true;

i := 1;

String_num := '';

number := Trim(N);

k := length(number);

if (k = 1) and (number = '0') then

   String_num := Zero

else

begin

   pos := 0;

   while (k > 0) do

   begin

     if (k <> 1) and (i = 1) and (length(number) <> 1) and (copy(number, k - 1,

       1) = '1')

       and (copy(number, k, 1) <> '0') then

     begin

       index := StrToInt(copy(number, k, 1));

       dec(k);

       inc(i);

       i_indx := 4;

     end

     else

     begin

       index := StrToInt(copy(number, k, 1));

       i_indx := i;

     end;

     if (NameNum[index, i_indx] <> '') and (fl_ext = true) then

     begin

       String_num := Ext[pos, Univer[index, i_indx]] + String_num;

       fl_ext := false;

     end;

     if (index = 1) and (pos = 1) and (i = 1) then

       String_num := One + String_num

     else if (index = 2) and (pos = 1) and (i = 1) then

       String_num := Two + String_num

     else

       String_num := NameNum[index, i_indx] + String_num;

     inc(i);

     if i = 4 then

     begin

       i := 1;

       inc(pos);

       fl_ext := true

     end;

     dec(k);

   end;

end;

if Trim(String_Num) <> '' then

begin

   String_num[1] := CHR(ORD(String_num[1]) - 32);

   Result := String_num;

end;

end;

{Преобразует х в 0х}

function DoubleChar(ch: string): string;

begin

if Length(ch) = 1 then

   Result := '0' + ch

else

   Result := ch;

end;

{преобразует денежную сумму в пропись}

function MoneyToSampl(M: Currency): string;

var

Int_Part, idx, idxIP, idxRP: integer;

Int_Str, Real_Part, Sampl: string;

begin

Int_Part := Trunc(Int(M));

Int_Str := IntToStr(Int_Part);

Real_Part := DoubleChar(IntToStr(Trunc(Int((M - Int_Part + 0.001) * 100))));

Sampl := NumToSampl(Int_Str);

idx := StrToInt(Int_Str[Length(Int_Str)]);

if idx = 0 then

   idx := 5;

idxIP := Univer[idx, 1];

idx := StrToInt(Real_Part[Length(Real_Part)]);

if idx = 0 then

   idx := 5;

idxRP := Univer[idx, 1];

Result := Sampl + Rubl[idxIP] + Real_Part + ' ' + Cop[idxRP];

end;

initialization

{Предположим файл находится на C:\ диске}

fFile := TIniFile.Create('c:\lang.cnf');

try

   {Заполнение массива рублей}

   fString := fFile.ReadString('Money', 'Rub', ',');

   LexemsToDim(fString, Rubl);

   {Заполнение массива копеек}

   fString := fFile.ReadString('Money', 'Cop', ',');

   LexemsToDim(fString, Cop);

   {Заполнение массива чисел}

   fString := fFile.ReadString('Nums', 'Numbers', ',');

   LexemsToDim(fString, fdim);

   NameNum[0, 1] := '';

   for i := 1 to 9 do

     NameNum[i, 1] := fdim[i - 1];