Code:

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

function TextSum(S: double): string;

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

const

c1to9m: array[1..9] ofstring[6] =

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

c1to9f: array[1..9] ofstring[6] =

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

c11to19: array[1..9] ofstring[12] =

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

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

c10to90: array[1..9] ofstring[11] =

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

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

c100to900: array[1..9] ofstring[9] =

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

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

var

s: string;

i: longint;

begin

s := '';

i := M div100;

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

M := M mod100;

i := M div10;

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

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

else

begin

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

M := M mod10;

if M <> 0then

if fm = 0then

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 <> 0then

begin

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

j := j mod100;

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

t := t + 'ов '

else

case j mod10of

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

1: t := t + ' ';

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

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

end;

end;

j := i div1000000;

if j <> 0then

begin

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

j := j mod100;

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

t := t + 'ов '

else

case j mod10of

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

1: t := t + ' ';

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

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

end;

end;

i := i mod1000000;

j := i div1000;

if j <> 0then

begin

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

j := j mod100;

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

t := t + ' '

else

case j mod10of

0: t := t + ' ';

1: t := t + 'а ';

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

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

end;

end;

i := i mod1000;

j := i;

if j <> 0then 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 https:\\anton-bl.chat.ru\delphi\}

{ 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; beginif i then

result := s1

else

result := s2 end;

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

result := s1

else

result := s2 end;

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

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

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

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

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

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

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

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

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

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

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

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);

whilenot ((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'] ofstring[2] = ('ей', 'ь', 'я', 'я', 'я', 'ей', 'ей', 'ей', 'ей', 'ей');

Kopeek: array['0'..'9'] ofstring[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) = 0then//Если число можно представить в строке <>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 = 1then

case i of

1: CifrToStr := 'сто';

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

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

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

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

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

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

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

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

0: CifrToStr := '';

end

elseif Pr = 2then

case i of

1: CifrToStr := '';

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

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

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

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

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

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

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

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

0: CifrToStr := '';

end

elseif Pr = 3then

case i of

1: if Padeg = 1then

CifrToStr := 'один'

else

CifrToStr := 'одна';

2: if Padeg = 1then

CifrToStr := 'два'

else

CifrToStr := 'две';

3: CifrToStr := 'три';

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

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

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

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

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

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

0: CifrToStr := '';

end

elseif Pr = 4then

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) = 3then

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

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

end

else

for i := 1to 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) = 0then

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) > 3do

begin

if i = 1then

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 = 1then

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] ofstring[7];

tns = array[0..9] ofstring[13];

decs = array[0..9] ofstring[12];

huns = array[0..9] ofstring[10];

nums = array[0..4] ofstring[8];

money = array[1..2] ofstring[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 div10) mod10) <> 1then

case (Arg mod10) 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 mod10;

iTri2 := iTri2 div10;

end;

begin

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

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

iTri2 := iTri;

if iTri > 0then

begin

un := GetDigit;

de := GetDigit;

ce := GetDigit;

if i = 1then

g := f

else

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

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

if de = 1then

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]) > 1then

begin

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

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

end;

end; //triad is 0 ?

if i = 0then Exit;

Dec(i);

Triad;

end;

begin

str := '';

Nr := int(Nin);

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

if Nr > 0then

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

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<>0then

repeat

PartNum:=TruncNum div D;

Dec(R);

D:=D div1000;

until

PartNum<>0

else

R:=0;

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

for i:=R downto1do

begin

Flag11:=False;

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

NumTMP:=PartNum div100;

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 mod100) div10;

case NumTMP of

1:

begin

NumTMP:=PartNum mod100;

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 mod10;

ifnot Flag11 then

begin

case NumTMP of

1:

if i=2then

NumStr:=NumStr+'одна '

else

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

2:

if i=2then

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<>0then

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

end;

1:

case NumTMP of

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

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

else

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

end;

end;

end;

if i>1then

begin

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

D:=D div1000;

end;

end;

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

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

if PartNum=0then

begin

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

Exit;

end;

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

NumTMP:=PartNum div10;

if NumTMP=0then

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

else

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

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

NumTMP:=PartNum mod10;

case NumTMP of

1:

if PartNum<>11then

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] ofstring[13] =

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

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

Des : array[2..9] ofstring[13] =

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

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

Edin : array[0..19] ofstring[13] =

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

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

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

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

var

S: string;

begin

S:='';

N:=N mod1000;

if N>99then

begin

S:=Sot[N div100]+' ';

N:=N mod100;

end;

if N>19then

begin

S:=S+Des[N div10]+' ';

N:=N mod10;

end;

Result:=S+Edin[N];

end;

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

function CenaToStr(r: Currency): string;

var

N, k: longint;

S: string;

begin

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

if N<>0then

begin

if N>999999then

begin

k:=N div1000000;

S:=ConvertToWord(k);

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

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

else

if (k mod10)=1then

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

else

if ((k mod10)>=2)and((k mod10)<=4) then

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

else

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

N:=N mod1000000;

end;

if N>999then

begin

k:=N div1000;

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

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

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

else

if (k mod10)=1then

begin

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

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

end

else

if (k mod10)=2then

begin

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

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

end

else

if ((k mod10)>=3)and((k mod10)<=4) then

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

else

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

N:=N mod1000;

end;

k:=N;

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

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

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

else

if (k mod10)=1then

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

else

if (k mod10)=2then

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

else

if ((k mod10)>=3)and((k mod10)<=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 div100)*100)>10)and((k-(k div100)*100)<20) then

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

else

if (k mod10)=1then

begin

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

end

else

if (k mod10)=2then

begin

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

end

else

if ((k mod10)>=3)and((k mod10)<=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 ****

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

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

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

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

Зависимости: 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] ofstring[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 shl1); {* 3}

for i := 1to3do

begin

;

Inc(CodeNo);

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

if SymNo < 0then

break;

Inc(SymNo, SymNo shl2); {* 5}

for j := 1to5do

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 > 0then

WordAdd(D3 + 28);

{сотни}

if D2 = 1then

WordAdd(D1 + 11)

{10-19}

else

begin

;

if D2 > 1then

WordAdd(D2 + 19);

{десятки}

if D1 > 0then

begin

;

{единицы}

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

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

else

WordAdd(D1 + 1);

if D1 < 5then

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

if D1 = 1then

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 := 1to4do

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 ****

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

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

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

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

Copyright: b0b

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

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

unit UIntToStroka;

interface

uses SysUtils;

const

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

'один',

'два',

'три',

'четыре',

'пять',

'шесть',

'семь',

'восемь',

'девять');

const

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

'две',

'три',

'четыре',

'пять',

'шесть',

'семь',

'восемь',

'девять');

const

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

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

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

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

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

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

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

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

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

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

const

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

'двадцать',

'тридцать',

'сорок',

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

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

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

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

'девяносто'

);

const

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

'двести',

'триста',

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

'пятьсот',

'шестьсот',

'семьсот',

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

'девятьсот'

);

const

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

'тысячи ',

'тысяч ');

const

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

'миллиона ',

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

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) downto1do

begin

dec := (length(s) - i + 1); // получим разряд

j := StrToInt(s[i]); // получим цифру

if j = 0then

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]) = 1then

begin

j0 := j;

Continue;

end; // подготовка к 10..19 тысяч/миллионов

except

end;

if Dec in [2, 5, 8, 11] then

if j = 1then

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 = 4then

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 = 7then

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 > 3do

dec := dec - 3;

case Dec of

1: if j <> 0then

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] ofstring = ('ноль', 'оди', 'два', 'три', 'четыр',

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

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 = 4then

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 = 7then

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 = 10then

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 downto1do

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 < 2then

begin

if len = 0then

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: arrayofstring);

var

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

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

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

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

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

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

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

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

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

fString: string;

fDim: array[0..9] ofstring;

i: integer;

implementation

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

procedure LexemsToDim(fstr: string; var dim: arrayofstring);

var

i, j: integer;

flex: string;

begin

if Length(fstr) > 0then

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

elseif (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 = 4then

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) = 1then

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 = 0then

idx := 5;

idxIP := Univer[idx, 1];

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

if idx = 0then

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 := 1to9do

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

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

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

LexemsToDim(fString, fdim);

NameNum[0, 2] := '';

for i := 1to9do

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

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

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

LexemsToDim(fString, fdim);

NameNum[0, 3] := '';

for i := 1to9do

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

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

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

LexemsToDim(fString, fdim);

NameNum[0, 4] := '';

for i := 1to9do

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

{Заполнение расширений чисел}

Ext[0, 1] := '';

Ext[0, 2] := '';

Ext[0, 3] := '';

{Тысячи}

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

LexemsToDim(fString, fdim);

for i := 1to3do

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

{Миллионы}

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

LexemsToDim(fString, fdim);

for i := 1to3do

Ext[2, i] := fdim[i - 1];

{Миллиарды}

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

LexemsToDim(fString, fdim);

for i := 1to3do

Ext[3, i] := fdim[i - 1];

{Триллион}

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

LexemsToDim(fString, fdim);

for i := 1to3do

Ext[4, i] := fdim[i - 1];

Zero := fFile.ReadString('Nums', 'Zero', '0');

if Zero[Length(Zero)] = ','then

Zero := Copy(Zero, 1, Length(Zero) - 1) + ' ';

One := fFile.ReadString('Nums', 'One', '1');

if One[Length(One)] = ','then

One := Copy(One, 1, Length(One) - 1) + ' ';

Two := fFile.ReadString('Nums', 'Two', '0');

if Two[Length(Two)] = ','then

Two := Copy(Two, 1, Length(Two) - 1) + ' ';

{Заполнение таблицы окончаний}

Univer[1, 1] := 1;

Univer[1, 2] := 2;

Univer[1, 3] := 2;

Univer[1, 4] := 2;

Univer[2, 1] := 3;

Univer[2, 2] := 2;

Univer[2, 3] := 2;

Univer[2, 4] := 2;

Univer[3, 1] := 3;

Univer[3, 2] := 2;

Univer[3, 3] := 2;

Univer[3, 4] := 2;

Univer[4, 1] := 3;

Univer[4, 2] := 2;

Univer[4, 3] := 2;

Univer[4, 4] := 2;

Univer[5, 1] := 2;

Univer[5, 2] := 2;

Univer[5, 3] := 2;

Univer[5, 4] := 2;

Univer[6, 1] := 2;

Univer[6, 2] := 2;

Univer[6, 3] := 2;

Univer[6, 4] := 2;

Univer[7, 1] := 2;

Univer[7, 2] := 2;

Univer[7, 3] := 2;

Univer[7, 4] := 2;

Univer[8, 1] := 2;

Univer[8, 2] := 2;

Univer[8, 3] := 2;

Univer[8, 4] := 2;

Univer[9, 1] := 2;

Univer[9, 2] := 2;

Univer[9, 3] := 2;

Univer[9, 4] := 2;

finally

fFile.Free;

end;

end.

Code:Lang.cnf

[Nums]

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

One=одна,

Two=две,

Tens=десять,двадцать,тридцать,сорок,пятьдесят,шестьдесят,семьдесят,восемьдесят,девяносто,

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

AfterTen=одиннадцать,двенадцать,тринадцать,четырнадцать,пятнадцать,шестнадцать,семнадцать,восемнадцать,девятнадцать,

Zero=ноль,

Thou=тысяча,тысяч,тысячи,

Mill=миллион,миллионов,миллиона,

Bill=миллиард,миллиардов,миллиарда,

Thrill=триллион,триллионов,триллиона,

[Money]

Rub=рубль,рублей,рубля,

Cop=копейка,копеек,копейки,

Code:

unit sumstr;

interface

uses

SysUtils, StrUtils;

function SumToString(Value: string): string;

implementation

const

a: array[0..8,0..9] ofstring=(

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

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

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

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

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

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

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

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

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

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

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

b: array[0..9] ofstring=

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

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

function SumToStrin(Value: string): string;

var

s, t: string;

p, pp, i, k: integer;

begin

s:=value;

if s='0'then

t:='Ноль '

else

begin

p:=length(s);

pp:=p;

if p>1then

if (s[p-1]='1') and (s[p]>'0') then

begin

t:=b[strtoint(s[p])];

pp:=pp-2;

end;

i:=pp;

while i>0do

begin

if (i=p-3) and (p>4) then

if s[p-4]='1'then

begin

t:=b[strtoint(s[p-3])]+'тысяч '+t;

i:=i-2;

end;

if (i=p-6) and (p>7) then

if s[p-7]='1'then

begin

t:=b[strtoint(s[p-6])]+'миллионов '+t;

i:=i-2;

end;

if i>0then

begin

k:=strtoint(s[i]);

t:=a[p-i,k]+t;

i:=i-1;

end;

end;

end;

result:=t;

end;

procedure get2str(value: string; var hi, lo: string);

var

p: integer;

begin

p:=pos(',', value);

lo:='';

hi:='';

if p=0then

p:=pos('.', value);