Число русской строкой
Число русской строкой
Автор Александр
{------------------------Деньги прописью ---------------------}
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\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.
Редянов Денис
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.
