VBNet - Форум - Из цифр в пропись

Вопрос: Из цифр в пропись - траблы в коде Добавлено: 19.08.04 19:50

Автор вопроса: Padre | Web-сайт: localhost | ICQ: 346632205

Этот код я нашёл на этом форуме при помощи поиска. После ряда тестов выяснилось что в ряде случаев он не работает. Основная ошибка - при введении нечётного числа у которого 99 идёт после запятой (напр. 3,99) в виде текста это выглядит четыре рубля -1 копейка. Как это исправить?

'Преобразование цены nMod в сумму прописью
'Работает при nMod<=2 147 483 647
'Код для рублей
Function Translate(nMon) As String
Dim aGen
Dim nCurSum, nCurRest, k

    aGen = Array("М", "Ж", "М", "М")
    Translate = ""
    On Error Resume Next
    nCurSum = CLng(nMon - 0.49)
    If Err.Number <> 0 Then
        Translate = Trim(nMon)
        Exit Function
    End If
    For k = 1 To 4
        If k > 1 Then nCurSum = (nCurSum - nCurRest) / 1000
        nCurSum = CLng(nCurSum - 0.49)
        If nCurSum = 0 Then Exit For
        nCurRest = nCurSum Mod 1000
        Translate = Money_Word(aGen(k - 1), k, nCurSum, True) & Translate
    Next
    nCurSum = CLng((nMon - CLng(nMon - 0.49)) * 100)
    Translate = Translate & Right(Left("0" & nCurSum, 3), 2) & " " & Money_Word("Ж", 0, nCurSum, False)
End Function

'Вывод словесной формы числа
'cGen - род (М-мужской,Ж-женский,С-средний)
'k - порядок (группа в aOrd)
'nCurSum - число для преобразования
'bWord - True-выводить весь текст, False-выводить только размерность
Function Money_Word(cGen, k, nCurSum, bWord)
Dim nSum, nRest, nCurRest
Dim aOrd, aDigits, aTens, aHundreds
    aOrd = Array("копейка", "копейки", "копеек" _
    , "рубль", "ру[sensored]", "рублей" _
    , "тысяча", "тысячи", "тысяч" _
    , "миллион", "миллиона", "миллионов" _
    , "миллиард", "миллиарда", "миллиардов")
    aDigits = Array("", "", "три", "четыре", "пять", "шесть", "семь", "восемь" _
    , "девять", "десять", "одиннадцать", "двенадцать", "тринадцать" _
    , "четырнадцать", "пятнадцать", "шестнадцать", "семнадцать" _
    , "восемнадцать", "девятнадцать")
    aTens = Array("десять", "двадцать", "тридцать", "сорок", "пятьдесят" _
    , "шестьдесят", "семьдесят", "восемьдесят", "девяносто")
    aHundreds = Array("сто", "двести", "триста", "четыреста", "пятьсот" _
    , "шестьсот", "семьсот", "восемьсот", "девятьсот")
    Money_Word = ""
    If cGen = "М" Then
        aDigits(0) = "один"
        aDigits(1) = "два"
    ElseIf cGen = "Ж" Then
        aDigits(0) = "одна"
        aDigits(1) = "две"
    ElseIf cGen = "С" Then
        aDigits(0) = "одно"
        aDigits(1) = "два"
    End If
    nRest = nCurSum Mod 10
    nSum = nCurSum Mod 100
    If nSum > 10 And nSum < 20 Then
        Money_Word = aOrd(k * 3 + 2) & " " & Money_Word
    ElseIf nRest = 1 Then
        Money_Word = aOrd(k * 3 + 0) & " " & Money_Word
    ElseIf nRest > 1 And nRest < 5 Then
        Money_Word = aOrd(k * 3 + 1) & " " & Money_Word
    Else
        Money_Word = aOrd(k * 3 + 2) & " " & Money_Word
    End If
    If bWord = False Then Exit Function
    nSum = nCurSum Mod 1000
    nRest = nSum Mod 100
    If nRest > 19 Then
        nRest = nRest Mod 10
        If nRest > 0 Then Money_Word = aDigits(nRest - 1) & " " & Money_Word
        nRest = ((nSum Mod 100) - nRest) / 10
        Money_Word = aTens(nRest - 1) & " " & Money_Word
    ElseIf nRest > 0 Then
        Money_Word = aDigits(nRest - 1) & " " & Money_Word
    End If
    nSum = (nSum - (nSum Mod 100)) / 100
    If nSum > 0 Then Money_Word = aHundreds(nSum - 1) & " " & Money_Word
End Function
Ответить

Ответы Всего ответов: 6

Номер ответа: 1 Автор ответа: Sur ICQ: 1249088 Вопросов: 10 Ответов: 304	Web-сайт: sur.hotbox.ru/ Профиль \| \| #1	Добавлено: 20.08.04 18:37
	отнимай 0.499 ps ру[sensored] - понравилось... Ответить

Номер ответа: 2 Автор ответа: Padre ICQ: 346632205 Вопросов: 25 Ответов: 215	Web-сайт: localhost Профиль \| \| #2	Добавлено: 20.08.04 18:55
	Благодарствую, а то замахался я уже... Ответить

Номер ответа: 3 Автор ответа: Padre ICQ: 346632205 Вопросов: 25 Ответов: 215	Web-сайт: localhost Профиль \| \| #3	Добавлено: 20.08.04 19:01
	...но тут возник ещё один вопрос если вводить числа в диапазоне 1000000:1000999 и аналогично для миллиардов, то в пропись добавляется лишнее слово тысяч(напр. 1000000->один миллион тысяч рублей). Что с этим делать? Ответить

Номер ответа: 4 Автор ответа: Sur ICQ: 1249088 Вопросов: 10 Ответов: 304	Web-сайт: sur.hotbox.ru/ Профиль \| \| #4	Добавлено: 20.08.04 19:43
	If nCurRest > 0 Then Translate = Money_Word(aGen(k - 1), k, nCurSum, True) & Translate не уверен, что это не приведет к новым глюкам... Ответить

Номер ответа: 5 Автор ответа: Sur ICQ: 1249088 Вопросов: 10 Ответов: 304	Web-сайт: sur.hotbox.ru/ Профиль \| \| #5	Добавлено: 20.08.04 23:13
	ну и не работает, теперь рубли теряет (1000) Ответить

Номер ответа: 6 Автор ответа: Padre ICQ: 346632205 Вопросов: 25 Ответов: 215	Web-сайт: localhost Профиль \| \| #6	Добавлено: 21.08.04 00:37
	Единственное что у меня более менее получилось - это тупо в конце цикла поставить if на проверку длины числа(7) и количества подряд идущих нолей(3)->1000999 Ответить

Страница: 1 |