Сумма прописью

Программирование на Атлантисе (VIP, FCOM, ARD), FastReport

Модераторы: m0p3e, edward_K, Модераторы

rager306
Сообщения: 3
Зарегистрирован: 29 мар 2005, 17:49

Сумма прописью

Сообщение rager306 »

Добрый день !

Не подскажите функцию, которая переводила число в сумму прописью с заданной валютой

:)
m0p3e
Местный житель
Сообщения: 1386
Зарегистрирован: 29 мар 2005, 17:49
Откуда: Москва

DoubleToStr(Num : Double, Format : String) : String;

Сообщение m0p3e »

Вот с Format и играй. См. приложение 2 (кажется) "Арифметические выражения и функции".
levtov
Постоянный гость
Сообщения: 60
Зарегистрирован: 29 мар 2005, 17:49
Откуда: Казахстан, Экибастуз, АО "ЕЭК"
Контактная информация:

Сообщение levtov »

Вывести в Ехсел, а там подключить макрос.
Cells(11, 1) = RUB(saldo, "T")
Function RUB(X As Double, Valut As String) As String 'Разделение на рубли копейки
Dim Sum1 As String
Dim Sum2 As String
Dim nam1 As String
Dim nam2 As String
Dim X1 As Double
Dim X2 As Integer
Select Case Valut
Case "T"
nam1 = " тенге "
nam2 = " тиын "
Case "$"
nam1 = " долларов США "
nam2 = " центов "
End Select
X = Round(X, 2)
X1 = Int(X)
X2 = Round((X - X1) * 100)
If X1 <> 0 Then
Sum1 = RUB_KOP(X1) & nam1
Else
Sum1 = "Ноль " & nam1
End If
Sum2 = Format(X2, "00") & nam2
'Sum3 = Sum1 & Sum2
'k = UCase(Left(Sum3, 1))
'Mid(Sum3, 1) = k
RUB = Format(Sum1 & Sum2, ">")
End Function
'****************************************
Function RUB_KOP(X As Double) ' Возвращает сумму прописью (Допустимый диапазон (0-999,999,999,999))
Dim t(12, 10) As String, t1(10) As String, D(12) As String
Dim Res As String
Dim r As String
Dim k As Integer, i As Integer
If X = 0 Then
RUB_KOP = " ноль "
Else
Res = ""
t(1, 1) = ""
t(1, 2) = "один "
t(1, 3) = "два "
t(1, 4) = "три "
t(1, 5) = "четыре "
t(1, 6) = "пять "
t(1, 7) = "шесть "
t(1, 8) = "семь "
t(1, 9) = "восемь "
t(1, 10) = "девять "

t(2, 1) = ""
t(2, 2) = "десять "
t(2, 3) = "двадцать "
t(2, 4) = "тридцать "
t(2, 5) = "сорок "
t(2, 6) = "пятьдесят "
t(2, 7) = "шестьдесят "
t(2, 8) = "семьдесят "
t(2, 9) = "восемьдесят "
t(2, 10) = "девяносто "

t(3, 1) = ""
t(3, 2) = "сто "
t(3, 3) = "двести "
t(3, 4) = "триста "
t(3, 5) = "четыреста "
t(3, 6) = "пятьсот "
t(3, 7) = "шестьсот "
t(3, 8) = "семьсот "
t(3, 9) = "восемьсот "
t(3, 10) = "девятьсот "

t(4, 1) = ""
t(4, 2) = "одна тысяча "
t(4, 3) = "две тысячи "
t(4, 4) = "три тысячи "
t(4, 5) = "четыре тысячи "
t(4, 6) = "пять тысяч "
t(4, 7) = "шесть тысяч "
t(4, 8) = "семь тысяч "
t(4, 9) = "восемь тысяч "
t(4, 10) = "девять тысяч "

t(5, 1) = ""
t(5, 2) = "десять "
t(5, 3) = "двадцать "
t(5, 4) = "тридцать "
t(5, 5) = "сорок "
t(5, 6) = "пятьдесят "
t(5, 7) = "шестьдесят "
t(5, 8) = "семьдесят "
t(5, 9) = "восемьдесят "
t(5, 10) = "девяносто "

t(6, 1) = ""
t(6, 2) = "сто "
t(6, 3) = "двести "
t(6, 4) = "триста "
t(6, 5) = "четыреста "
t(6, 6) = "пятьсот "
t(6, 7) = "шестьсот "
t(6, 8) = "семьсот "
t(6, 9) = "восемьсот "
t(6, 10) = "девятьсот "

t(7, 1) = ""
t(7, 2) = "один миллион "
t(7, 3) = "два миллиона "
t(7, 4) = "три миллиона "
t(7, 5) = "четыре миллиона "
t(7, 6) = "пять миллионов "
t(7, 7) = "шесть миллионов "
t(7, 8) = "семь миллионов "
t(7, 9) = "восемь миллионов "
t(7, 10) = "девять миллионов "

t(8, 1) = ""
t(8, 2) = "десять "
t(8, 3) = "двадцать "
t(8, 4) = "тридцать "
t(8, 5) = "сорок "
t(8, 6) = "пятьдесят "
t(8, 7) = "шестьдесят "
t(8, 8) = "семьдесят "
t(8, 9) = "восемьдесят "
t(8, 10) = "девяносто "

t(9, 1) = ""
t(9, 2) = "сто "
t(9, 3) = "двести "
t(9, 4) = "триста "
t(9, 5) = "четыреста "
t(9, 6) = "пятьсот "
t(9, 7) = "шестьсот "
t(9, 8) = "семьсот "
t(9, 9) = "восемьсот "
t(9, 10) = "девятьсот "

t(10, 1) = ""
t(10, 2) = "один миллиард "
t(10, 3) = "два миллиарда "
t(10, 4) = "три миллиарда "
t(10, 5) = "четыре миллиарда "
t(10, 6) = "пять миллиардов "
t(10, 7) = "шесть миллиардов "
t(10, 8) = "семь миллиардов "
t(10, 9) = "восемь миллиардов "
t(10, 10) = "девять миллиардов "

t(11, 1) = ""
t(11, 2) = "десять "
t(11, 3) = "двадцать "
t(11, 4) = "тридцать "
t(11, 5) = "сорок "
t(11, 6) = "пятьдесят "
t(11, 7) = "шестьдесят "
t(11, 8) = "семьдесят "
t(11, 9) = "восемьдесят "
t(11, 10) = "девяносто "

t(12, 1) = ""
t(12, 2) = "сто "
t(12, 3) = "двести "
t(12, 4) = "триста "
t(12, 5) = "четыреста "
t(12, 6) = "пятьсот "
t(12, 7) = "шестьсот "
t(12, 8) = "семьсот "
t(12, 9) = "восемьсот "
t(12, 10) = "девятьсот "

t1(1) = "десять "
t1(2) = "одиннадцать "
t1(3) = "двенадцать "
t1(4) = "тринадцать "
t1(5) = "четырнадцать "
t1(6) = "пятнадцать "
t1(7) = "шестнадцать "
t1(8) = "семнадцать "
t1(9) = "восемнадцать "
t1(10) = "девятнадцать "

r = Format(X, "000000000000")

For k = 12 To 1 Step -1
i = Val(Mid(r, 13 - k, 1))
D(k) = t(k, i + 1)
If k = 10 And D(11) = "десять " Then
D(10) = t1(i + 1) + "миллиардов "
D(11) = ""
ElseIf k = 7 And D(8) = "десять " Then
D(7) = t1(i + 1) + "миллионов "
D(8) = ""
ElseIf k = 4 And D(5) = "десять " Then
D(4) = t1(i + 1) + "тысяч "
D(5) = ""
ElseIf k = 4 And D(4) = "" And Not (D(5) = "" And D(6) = "") Then
D(4) = "тысяч "
ElseIf k = 7 And D(7) = "" And Not (D(8) = "" And D(9) = "") Then
D(7) = "миллионов "
ElseIf k = 10 And D(10) = "" And Not (D(11) = "" And D(12) = "") Then
D(10) = "миллиардов "
ElseIf k = 1 And D(2) = "десять " Then
D(1) = t1(i + 1)
D(2) = ""
End If

Next k
RUB_KOP = D(12) + D(11) + D(10) + D(9) + D(8) + D(7) + D(6) + D(5) + D(4) + D(3) + D(2) + D(1)
End If
End Function
Лучше перебдеть, чем недобдеть!
Алексей
Местный житель
Сообщения: 2896
Зарегистрирован: 24 июн 2005, 12:12
Откуда: Иркутская область

Сообщение Алексей »

levtov
какие на фиг макросы?

:sad:

doubletostring(0,3.2) = 'Три рубля 20 копеек'
levtov
Постоянный гость
Сообщения: 60
Зарегистрирован: 29 мар 2005, 17:49
Откуда: Казахстан, Экибастуз, АО "ЕЭК"
Контактная информация:

Сообщение levtov »

У меня три тенге 20 тиын. А потом для офисных програм пригодится:
ворд, аксес - кто-нибудь спасибо скажет. :???:
edward_K
Заслуженный деятель интернет-сообщества
Сообщения: 5187
Зарегистрирован: 29 мар 2005, 17:49
Откуда: SPB galaxy spb

Сообщение edward_K »

// возвращает сумму прописью и добавляет имя валюты с кодом CVAL
// в нужном падеже (если CVAL = 0, добавляет нац.валюту)
function DoubleToString(cval:comp; i:double) : string;
// возвращает сумму прописью и добавляет имя валюты с кодом CVAL
// в нужном падеже на иностранном языке если CVAL = 0, добавляет нац.валюту
function DoubleToStringInVal(cval:comp; i:double) : string;
Алексей
Местный житель
Сообщения: 2896
Зарегистрирован: 24 июн 2005, 12:12
Откуда: Иркутская область

Сообщение Алексей »

edward_K
2 раза написал для особо одарённых?
:-)
edward_K
Заслуженный деятель интернет-сообщества
Сообщения: 5187
Зарегистрирован: 29 мар 2005, 17:49
Откуда: SPB galaxy spb

Сообщение edward_K »

если повнимательней прочитать, то вторая выводит на иностранном языке( из настроек в класс.валют).
Алексей
Местный житель
Сообщения: 2896
Зарегистрирован: 24 июн 2005, 12:12
Откуда: Иркутская область

Сообщение Алексей »

edward_K
точно :) Приношу извинения :)
Даже не знал что есть такая - не приходилось использовать.
Rishat
Постоянный обитатель
Сообщения: 191
Зарегистрирован: 12 сен 2005, 17:10
Откуда: Наб. Челны

Сообщение Rishat »

а что примеры из документации уже не катят?

Примеры

Вывод знака числа:

DoubleToStr(55.55,'3666.88') = '+55.55'
DoubleToStr(-55.55,'3666.88') = '-55.55'
DoubleToStr(55.55,'[|-]3666.88') = '55.55'
DoubleToStr(-55.55,'[|-]3666.88') = '-55.55'
Текстовое представление целой части:

DoubleToStr(5.555,'4КГ 5') =
'пять КГ пятьсот пятьдесят пять тысячных'
DoubleToStr(55.55,'4') = 'пятьдесят пять'
// по умолчанию не округляет, берет только целую часть числа
DoubleToStr(55.55,'\0p4') = 'пятьдесят шесть'
// чтобы округлило до целых, необходимо использовать \0p
DoubleToStr(Round(55.55),'4') = 'пятьдесят шесть'
// или подавать на вход уже округленное число
Текстовое представление дробной части:

DoubleToStr( 0.00, '4 целых 5') = 'ноль целых ноль десятых'
DoubleToStr(5.555,'4КГ 5') =
'пять КГ пятьсот пятьдесят пять тысячных'
DoubleToStr(5.555,'\2p4КГ 5') = 'пять КГ пятьдесят шесть сотых'
// для округления до сотых - надо явно прописать \2p
DoubleToStr(5.555,'\1p4КГ 5') = 'пять КГ шесть десятых'
// для округления до десятых - надо явно прописать \1p
Необязательная (незначимая) цифра целой части:

DoubleToStr(5,'666') ='5'
DoubleToStr(55,'666') ='55'
DoubleToStr(555,'666') = '555'
DoubleToStr(5555,'666') = '***'
DoubleToStr(0.55,'666') = '0'
Обязательная (значимая) цифра целой части:

DoubleToStr(5,'777') = '005'
DoubleToStr(55,'777') = '055'
DoubleToStr(555,'777') = '555'
DoubleToStr(5555,'777') = '***'
Обязательная (значимая) цифра дробной части:

DoubleToStr(5.55,'77.88') = '05.55'
DoubleToStr(5.555,'77.88') = '05.55'
DoubleToStr(5.555,'\2p77.88') = '05.56'
// для округления до N знаков следует воспользоваться \Np
DoubleToStr(5.5,'77.88') = '05.50'
DoubleToStr(5.599,'\2p77.88') = '05.60'
Необязательная (незначимая) цифра дробной части:

DoubleToStr(5.55,'77.99') = '05.55'
DoubleToStr(5.555,'77.99') = '05.55'
DoubleToStr(5.555,'\2p77.99') = '05.56'
DoubleToStr(5.5,'77.99') = '05.5'
DoubleToStr(5.599,'\2p77.99') = '05.6'
Если необходимо, чтобы в дробной части всегда выводилось не менее к примеру 2 знаков, поступаем следующим образом:

DoubleToStr(5.599,'7.8899') = '5.599'
DoubleToStr(5.59,'7.8899') = '5.59'
DoubleToStr(5.9,'7.8899') = '5.90'
Окруление:

DoubleToStr(55.555,'\2p66.99') = '55.56'
// \2p - 2 знака после запятой
DoubleToStr(55.555,'\1p66.99') = '55.6'
// \1p - 1 знак после запятой
DoubleToStr(55.555,'\0p66.99') = '55'
// \0p - округления до целого
DoubleToStr(55.555,'\-1p66.99') = '60'
// \-1p - округления до десятков
Мужской /женский род:

DoubleToStr(22.22,'\m4 РУБЛЯ \f5') =
'двадцать два РУБЛЯ двадцать две сотых'
katerpillar
Сообщения: 11
Зарегистрирован: 13 июл 2009, 11:08

Сообщение katerpillar »

А все то же самое но с заглавной буквы нельзя получить? :)
ilshat
Местный житель
Сообщения: 222
Зарегистрирован: 04 июн 2008, 14:35
Откуда: Стерлитамак
Контактная информация:

Сообщение ilshat »

а функции upper к строкам нет что ли ?
дергаем первый символ делаем ему upper + начиная со второго до конца строки
katerpillar
Сообщения: 11
Зарегистрирован: 13 июл 2009, 11:08

Сообщение katerpillar »

Да вот что-то не нашел... Просто на UPPER(s) - ругается.
edward_K
Заслуженный деятель интернет-сообщества
Сообщения: 5187
Зарегистрирован: 29 мар 2005, 17:49
Откуда: SPB galaxy spb

Сообщение edward_K »

upcase
katerpillar
Сообщения: 11
Зарегистрирован: 13 июл 2009, 11:08

Сообщение katerpillar »

Thnx.

Правда
UpCase(s[1])+SubStr(s,2,length(s))
не самый удобный способ... :)

Особенно если вместо s написано DoubleToStr(Sum3Itog,'4')

Но все равно спасибо!
Ответить