Числа прописью

← →
Beton © (2003-10-08 19:46) [0]

Уважаемые мастера! Подкиньте кто-нибудь алгоритм перевода чисел (до 999 милионов) в строку прописью.
Заранее благодарен.

← →
kaif © (2003-10-08 20:58) [1]

Посмотри мой компонент на
http://www.lclassic.ru
Там исходный текст имеется.

← →
Малиновский Владимир (2003-10-09 10:25) [2]

//-----------------------------
// Перевод цифры в рубли прописью
// Автор - Малиновский Владимир Владимирович
// Vlad-mal@yandex.ru
function Value_Spelled_Out(Summa : currency;
Penny_For_Penny : boolean = false) : String;
//-----------------------------

type
TOneToNineteen = array [1..19] of string;

const
OneToNineteen : array[1..19] of string =
("один", "два", "три", "четыре", "пять", "шесть", "семь", "восемь",
"девять", "десять", "одиннадцать", "двенадцать", "тринадцать",
"четырнадцать", "пятнадцать", "шестнадцать", "семнадцать",
"восемнадцать", "девятнадцать");
TenToNinety : array[1..9] of string =
("десять", "двадцать", "тридцать", "сорок", "пятьдесят", "шестьдесят",
"семьдесят", "восемьдесят", "девяносто");
OneHunderdToNineHundreds : array [1..9] of string =
("сто", "двести", "триста", "четыреста", "пятьсот", "шестьсот",
"семьсот", "восемьсот", "девятьсот");
MaleCase : array[1..19] of string =
(" ", "а ", "а ", "а ", "ов ", "ов ", "ов ", "ов ", "ов ", "ов ",
"ов ", "ов ", "ов ", "ов ", "ов ", "ов ", "ов ", "ов ", "ов ");
FemaleCase : array[1..19] of string =
("а ", "и ", "и ", "и ", " ", " ", " ", " ", " ", " ",
" ", " ", " ", " ", " ", " ", " ", " ", " ");
var
Digits: array[1..15] of integer;
S1 : int64;
S2, NumberOfDigits, ix, k, m : integer;
Rub_Word, Kop_Word : string;
begin
// Summa - Исходная сумма
// не более 999 999 999 999 999.99 руб.
// (...ну, если позволяет компутер...)
// (а так для Currency max = 922 337 203 685 477.5807)
if (Abs(Summa) > 922337203685477.5807) then begin
Result := "********** pубля ";
exit
end;

if Summa < 0 then Result := "Минус " else
Result := "";

Summa := Abs(Summa);

S1 := trunc(Summa);
S2 := trunc((Summa-S1)*100);
// s1 - рубли, s2 - копейки

NumberOfDigits := 0;
while s1 > 0 do begin // Разбиваем на десятичные числа
inc(NumberOfDigits);
Digits[NumberOfDigits] := s1 mod 10;
s1 := s1 div 10;
end;

if NumberOfDigits = 0 then
Result := "Hуль "
else begin
ix := NumberOfDigits;
while ix > 0 do begin
k := ix mod 3; // Разбиваем на десятичные триады
if k = 0 then k := 3;
if (k = 2) and (Digits[ix] = 1) then begin // 10 - 19
dec(ix);
k := 1;
Result := Result + OneToNineteen[10+Digits[ix]] + " ";
m := 10 + Digits[ix]
end else
if Digits[ix] > 0 then begin
if (ix = 4) and (Digits[ix]=1) then
Result := Result + "одна "
else if (ix = 4) and (Digits[ix]=2) then
Result := Result + "две "
else if k = 1 then
Result := Result + OneToNineteen[Digits[ix]] + " "
else if k = 2 then
Result := Result + TenToNinety[Digits[ix]] + " "
else if k = 3 then
Result := Result + OneHunderdToNineHundreds[Digits[ix]] + " ";
m := Digits[ix]
end else
m := 10;

if k = 1 then
if ix = 13 then // триллионов
Result := Result + "триллион" + MaleCase[m]
else if ix = 10 then // миллиардов
Result := Result + "миллиард" + MaleCase[m]
else if ix = 7 then // миллионов
Result := Result + "миллион" + MaleCase[m]
else if (ix = 4) and (Digits[4]+Digits[5]+Digits[6] > 0) // тысяч
then Result := Result + "тысяч" + FeMaleCase[m];
dec(ix);
end; // while
end; // else

// Пусть будет с 1-й большой буквы
Result[1] := AnsiUpperCase(Result[1])[1];

S1 := trunc(Summa) mod 100;
if S1>20 then
S1 := S1 mod 10;
if S1=1 then Rub_Word:="рубль"
else if (S1=2) or (S1=3) or (S1=4) then Rub_Word := "рубля"
else Rub_Word := "рублей";

Result := Result + Rub_Word;

if Penny_For_Penny then begin // До копеек
S1 := S2;
if S1>20 then
S1 := S1 mod 10;
if S1=1 then Kop_Word:="копейка"
else if (S1=2) or (S1=3) or (S1=4) then Kop_Word := "копейки"
else Kop_Word := "копеек";
Result := Result + format(" %.2d ",[s2]) + Kop_Word;
end;

end;

Числа прописью Найти похожие ветки