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



Public Function Num3(trojka$, i%)

    Dim sl$(1 To 3, 0 To 3)

    sl$(1, 1) = "миллион "

    sl$(2, 1) = "тысяча "

    sl$(3, 1) = "рубль "

    '--------------------------------------

    sl$(1, 2) = "миллиона "

    sl$(2, 2) = "тысячи "

    sl$(3, 2) = "рубля "

    '--------------------------------------

    sl$(1, 3) = "миллионов "

    sl$(2, 3) = "тысяч "

    sl$(3, 3) = "рублей "

    sl$(3, 0) = "рублей "

    '--------------------------------------

    ed$ = Right$(trojka$, 1)

    des$ = Mid$(trojka$, 2, 1)

    sot$ = Left$(trojka$, 1)

    '--------------------------------------

    If ed$ = "0" Then r3$ = ""

    If ed$ = "1" Then If i% = 2 Then r3$ = "одна " Else r3$ = "один "

    If ed$ = "2" Then If i% = 2 Then r3$ = "две " Else r3$ = "два "

    If ed$ = "3" Then r3$ = "три "

    If ed$ = "4" Then r3$ = "четыре "

    If ed$ = "5" Then r3$ = "пять "

    If ed$ = "6" Then r3$ = "шесть "

    If ed$ = "7" Then r3$ = "семь "

    If ed$ = "8" Then r3$ = "восемь "

    If ed$ = "9" Then r3$ = "девять  "

    '--------------------------------------

    If des$ = "0" Then r2$ = ""

    s$ = des$ & ed$

    If s$ = "10" Then r3$ = "десять "

    If s$ = "11" Then r3$ = "одиннадцать "

    If s$ = "12" Then r3$ = "двенадцать "

    If s$ = "13" Then r3$ = "тринадцать "

    If s$ = "14" Then r3$ = "четырнадцать "

    If s$ = "15" Then r3$ = "пятнадцать "

    If s$ = "16" Then r3$ = "шестнадцать "

    If s$ = "17" Then r3$ = "семнадцать "

    If s$ = "18" Then r3$ = "восемнадцать "

    If s$ = "19" Then r3$ = "девятнадцать "

    '--------------------------------------

    If des$ = "2" Then r2$ = "двадцать "

    If des$ = "3" Then r2$ = "тридцать "

    If des$ = "4" Then r2$ = "сорок "

    If des$ = "5" Then r2$ = "пятьдесят "

    If des$ = "6" Then r2$ = "шестьдесят "

    If des$ = "7" Then r2$ = "семьдесят "

    If des$ = "8" Then r2$ = "восемьдесят "

    If des$ = "9" Then r2$ = "девяносто "

    '--------------------------------------

    If sot$ = "0" Then r1$ = ""

    If sot$ = "1" Then r1$ = "сто "

    If sot$ = "2" Then r1$ = "двести "

    If sot$ = "3" Then r1$ = "триста "

    If sot$ = "4" Then r1$ = "четыреста "

    If sot$ = "5" Then r1$ = "пятьсот "

    If sot$ = "6" Then r1$ = "шестьсот "

    If sot$ = "7" Then r1$ = "семьсот "

    If sot$ = "8" Then r1$ = "восемьсот "

    If sot$ = "9" Then r1$ = "девятьсот "

    '--------------------------------------

    If trojka$ <> "000" Then j% = (-1) * CInt(ed$ = "1" And des$ <> "1") _

    + (-2) * CInt((ed$ = "2" Or ed$ = "3" Or ed$ = "4") And des$ <> "1")

    If j% = 0 And trojka$ <> "000" Then j% = 3

    trojka$ = r1$ & r2$ & r3$ & sl$(i%, j%) 'формирование тройки цифр и

    'слова,например-"123 тысячи"

End Function

'*********************************************************************



Private Sub cmdinput_Click()

    w$ = txtinput.Text 'Входное число - текст типа "123.45",защита

    '"от дурака" не сделана

    'выделение рублей в записи числа и удаление левых пробелов

    rubli$ = LTrim$(Left$(Str(Val(w$) * 100), _

    Len(Str(Val(w$) * 100)) - 2)) 

    cop$ = RTrim$(Right$(Str(Val(w$) * 100), 2)) 'выделение дробной части

    'числа и удаление правых пробелов

    

   Do While Len(rubli$) < 9

      rubli$ = "0" & rubli$

   Loop

      res$ = ""

   For i% = 1 To 3

      trojka$ = Mid$(rubli$, 3 * i% - 2, 3)

      Call Num3(trojka$, i%) ' Вызов функции формирования готовой тройки,

      'типа "123 тысячи"

      res$ = res$ & trojka$  ' Накопление таких троек

   Next i%

      res$ = UCase$(Left$(res$, 1)) & Right$(res$, Len(res$) - 1) 'Запись

      'первой буквы res$ в верхнем регистре

           

      c$ = " копеек" ' Блок добавления копеек

      If (Right$(cop$, 1) = "1" And Left$(cop$, 1) <> "1") Then c$ = _

      " копейка"

      If ((Right$(cop$, 1) = "2" Or Right$(cop$, 1) = "3" Or _

      Right$(cop$, 1) = "4") And Left$(cop$, 1) <> "1") Then _

      c$ = " копейки"

      If Left(res$, 1) <> "Р" Then res$ = res$ & cop$ & c$ Else _

      res$ = cop$ & c$

      

      txtout.Text = res$ ' Выход текста

End Sub

к оглавлению
Используются технологии uCoz