Форум: "Основная";
Текущий архив: 2002.04.15;
Скачать: [xml.tar.bz2];

Вниз

Сумма прописью   Найти похожие ветки 

← →
Solod   (2002-04-03 07:43) [1]

Не мое, нашел где-то, уже не помнью где.
Поэтому высылаю текст модуля. Надеюсь автор не будет против.
(Работает.)

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; //---SumNumToFull

end.


---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.04.15;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.004 c