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

StasK

Люди !!!

Помогите!!!
Есть ли у кого-нибудь функция "СУММА ПРОПИСЬЮ", ну о-о-очень надо, плз...

С уважением, StasK

tinkov

Лови

function digit2str(Value: integer; m: boolean): string;
const

MAX3 = 5; {Максимальное количество триад}

A11: array[1..2] of string[20] = ('одна ', 'две ');

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

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

{четвертым параметром является обозначение мужского или женского рода,

где '0' - женский род;
'1' - мужской род.

Это дает возможность, например, изменяя "рубли" на "штуки" просто поменять '1' на '0' не меняя кода.}
A0: array[0..MAX3 - 1, 0..3] of string[20] = (('гривна', 'гривні', 'гривен', '0'),
('тысяча ', 'тысячи ', 'тысяч ', '0'), ('миллион ', 'миллиона ', 'миллионов ', '1'),
('миллиард ', 'миллиарда ', 'миллиардов ', '1'),
('триллион ', 'триллиона ', 'триллионов', '1'));
var
i100, i10, i1: integer;
V, p, n: integer;
a, s: string;
begin
try
s := '';
n := 0;
{ѕСаРСЮвЪР ЮваШжРвХЫмЭЮУЮ ЧЭРзХЭШп Ш ЭгЫп}
if Value < 0 then
begin
s := s + 'ЬШЭгб';
Value := -Value;
end
else if Value = 0 then s := s + 'ЭЮЫм'
else
s := s + '';
repeat
{АРЧСШТЪР ЭР ваШРФл б ЪЮЭжР}
V := Value mod 1000;
Value := Value div 1000;
{ѕСаРСЮвЪР}
if (V > 0) or (n = 0) then
begin
i100 := V div 100;
V := V - (i100 * 100);
if V >= 20 then
begin
i1 := V mod 10;
V := V div 10;
i10 := V mod 10;
end
else
begin
i1 := V;
i10 := 0;
end;
case i1 of
1: p := 0;
2..4: p := 1;
else
p := 2;
end;
{ёЧЬХЭХЭШХ Т ЧРТШбШЬЮбвШ Юв ЦХЭбЪЮУЮ ШЫШ ЬгЦбЪЮУЮ аЮФР}
if m then
begin
if (A0[n, 3] = '0') and ((i1 = 1) or (i1 = 2)) then
insert(A100[i100] + A10[i10] + A11[i1] + A0[n, p], s, 0)
else
insert(A100[i100] + A10[i10] + A1[i1] + A0[n, p], s, 0);
end
else
begin
if (A0[n, 3] = '0') and ((i1 = 1) or (i1 = 2)) then
insert(A100[i100] + A10[i10] + A11[i1]{+A0[n,p]}, s, 0)
else
insert(A100[i100] + A10[i10] + A1[i1]{+A0[n,p]}, s, 0);
end;
end;
Inc(n);
{їаЮТХаЪР ТлеЮФР ЧР ЬРЪбШЬРЫмЭЮХ ЪЮЫШзХбвТЮ ваШРФ}
if n > MAX3 then Exit;
until Value <= 0;
except
s := 'Ошибка при переводе числа';
end;
a := s[1];
a := AnsiUpperCase(a);
S[1] := a[1];
Result := s;
end;

StasK

Спасибо !!!