Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 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.59 MB
Время: 0.023 c
1-48032
Sour
2002-08-03 11:21
2002.08.15
Drag&Drop StringGrid..


3-47916
DAO
2002-07-28 17:34
2002.08.15
Как NULL поменять на 0 в SQL?


3-47930
mazepa
2002-07-25 11:23
2002.08.15
SQL Help


3-47971
Lego
2002-07-25 04:15
2002.08.15
Что-то я уже торжможу :)


7-48331
Mex
2002-05-30 18:08
2002.08.15
На Delphi PID процесса в WIn 2000





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский