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

Вниз

Перевод денег в прописную форму   Найти похожие ветки 

← →
Roma111   (2002-07-31 17:21) [0]

Уважаемые мастера, кто подскажет функцию перевода денег из цифровой в прописную форму, например 123,67 р. -> Сто двадцать три рубля шестьдесят семь копеек.

---

← →
MBo   (2002-07-31 17:25) [1]

поищи на delphi.vitpc.com

---

← →
Pingo   (2002-07-31 17:27) [2]

У меня есть модулик, написанный правда очень давно, но есть недостаток - он сделан для гривен, то есть нужно менять имена и склонения.

---

← →
Skier   (2002-07-31 17:28) [3]

>Roma111


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.


---

← →
Johnmen   (2002-07-31 17:39) [4]

>Skier © (31.07.02 17:28)

Существуют более красивые алгоритмы...:)))))

---

← →
Skier   (2002-07-31 17:41) [5]

>Johnmen
Ты это видел : Copyright (c) 1999 by Константин Егоров ?
Это "плюшка" не моя...просто оказалась под рукой... :))

---

← →
Johnmen   (2002-07-31 17:48) [6]

>Skier © (31.07.02 17:41)

Конечно видел ! Просто сделал ремарку....:)

---

← →
Skier   (2002-07-31 17:49) [7]

>Johnmen

> Просто сделал ремарку....:)


А твоя фамилия случаем не Ремарк ? :)))

---

← →
Johnmen   (2002-07-31 17:54) [8]

>Skier © (31.07.02 17:49)
>А твоя фамилия случаем не Ремарк ? :)))

Если это юмор, то не уловил суть....:)

---

← →
Skier   (2002-07-31 17:58) [9]

>Johnmen
Да...пытался юморить...Видимо не удачно :(

---

← →
Roma111   (2002-07-31 20:54) [10]

Спасибо Skier.
Завтра попробую...

---

← →
VID   (2002-07-31 23:58) [11]

http://delphibase.endimus.com/?action=viewfunc&topic=strconvert&id=10264

---

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

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

Наверх

Память: 0.47 MB
Время: 0.007 c