Форум: "Основная";
Текущий архив: 2002.04.15;
Скачать: [xml.tar.bz2];
Вниз
Сумма прописью Найти похожие ветки
← →
dorixe (2002-04-03 06:45) [0]hi!
как-то в эхе проходил исходник, не забросите ли еще раз. pls!
← →
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.
← →
Leonon (2002-04-03 09:47) [2]Вот готовая рабочая функция
{GetTextSum}
function GetTextSum(Sum : extended):string;
Type
TNameArr = array [0..4,0..2] of string;
Var
S : string;
I : integer; {счетчик по числу триад }
Sex : byte; {пол 0 - женский, 1 - мужской}
Const
{единицы}
One : array [0..1,0..9] of string = (("","одна ","дв_ ","три ","чотири ","п""ять ",
"ш_сть ","сiмь ","вiсiмь ","дев""ять "),("","один ","два ","три ","чотири ","п""ять ",
"ш_сть ","сiмь ","вiсiмь ","дев""ять "));
{от десяти до двадцати}
AfterTen : array [0..9] of string = ("десять ","одинадцять ","дванадцять ","тринадцять ",
"чотирнадцять ","п""ятнадцять ","ш_стнадцять ","с_мнадцять ","в_с_мнадцять ",
"дев""ятнадцать ");
{десятки}
Ten : array [0..9] of string = ("","десять ","двадцять ","тридцять ","сорок ",
"п""ятьдесят ","шiстьдесят ","сiмьдесят ","вiсiмьдесят ","дев""яносто ");
{сотни}
Handred : array [0..9] of string = ("","сто ","дв_ст_ ","триста ","чотириста ",
"п""ятьсот ","шiстьсот ","сiмьсот ","вiсiмьсот ","дев""ятьсот ");
{триады}
Name : TNameArr =
(("гривня","гривнi","гривень"),
("тисяча ","тисяч_ ","тисяч "),
("м_л_он ","м_л_она ","м_л_он_в "),
("м_л_ард ","м_л_арда ","м_л_ард_в "),
("трил_он ","трил_она ","трил_он_в "));
begin
S := FloatToStr(Sum*100);
{Выделяем дробную часть числа (копейки)}
Result := " "+Copy(S, Length(S)-1, 2)+" коп.";
{Выделяем целую часть числа (рубли)}
S := Copy(S,1,Length(S)-2);
{Добавляем нули спереди, чтобы длина стала кратна 3}
if ((Length(s) mod 3)<>0) or (Length(s)=0) then for I:=1 to 3-(Length(s) mod 3) do S:="0"+S;
{Формируем цикл по числу триад}
if (Length(S) div 3)<>0 then
for I := 0 to (Length(S) div 3)-1 do begin
{пол триады}
Sex :=1;
Case I of
0 : Sex:=0; {пол женский}
1 : Sex:=0; {тысяча}
2,3,4 : Sex:=1; {миллион, миллиард, триллион}
end;
{название триады}
if Not ((S[Length(S)-I*3-2]="0") and (S[Length(S)-I*3-1]="0") and
(S[Length(S)-I*3]="0") and (I<>0)) then
Case S[Length(S)-I*3-1] of
"0" : Case S[Length(S)-I*3] of
"0" : Result:=Name[I,2]+Result;
"1" : Result:=Name[I,0]+Result;
"2".."4" : Result:=Name[I,1]+Result;
"5".."9" : Result:=Name[I,2]+Result;
end;
"1" : Result:=Name[I,2]+Result;
"2".."9" : Case S[Length(S)-I*3] of
"0" : Result:=Name[I,2]+Result;
"1" : Result:=Name[I,0]+Result;
"2".."4" : Result:=Name[I,1]+Result;
"5".."9" : Result:=Name[I,2]+Result;
end;
end;
{текстовое значение триады}
Case S[Length(S)-I*3-1] of
"0" : if S="000" then Result:="Нуль "+Result
else Result:=One[Sex, StrToInt(S[Length(S)-I*3])]+Result;
"1" : Result:=AfterTen[StrToInt(S[Length(S)-I*3])]+Result;
"2".."9" : begin
Case S[Length(S)-I*3] of
"1".."9" : Result:=One[Sex, StrToInt(S[Length(S)-I*3])]+Result;
end;
Result:=Ten[StrToInt(S[Length(S)-I*3-1])]+Result;
end;
end;
Result:=Handred[StrToInt(S[Length(S)-I*3-2])]+Result;
end;
if Result<>"" then Result[1]:= string(AnsiUpperCase(Result[1]))[1];
end;
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2002.04.15;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.005 c
