Здесь можно найти готовые «кирпичики» — части кода, пригодные для построения более крупных проектов, а также решения различных типовых и не очень задач на VB.
Модератор: Brickgroup
-
Andrey Fedorov
-
- Член-корреспондент академии VBStreets
-
-
- Сообщения: 3287
- Зарегистрирован: 21.05.2004 (Пт) 9:28
- Откуда: Москва
Andrey Fedorov » 18.04.2006 (Вт) 9:24
- Код: Выделить всё
Public Sub Main()
Debug.WriteLine(ЧислоПрописью(3456832.71))
Debug.WriteLine(ЧислоПрописью(3.2, "м;метр;метра;метров", "м;дециметр;дециметра;дециметров;1,0"))
Debug.WriteLine(ЧислоПрописью(3.71, "м;метр;метра;метров", "м;милиметр;милиметра;милиметров;2,0"))
Debug.WriteLine(ЧислоПрописью(32.102, "ж|тонна|тонны|тонн", "м|килограмм|киллограмма|киллограмм|3 и ещё 0"))
Debug.WriteLine(ЧислоПрописью(32, "м;человек|человека|человек"))
Debug.WriteLine(ЧислоПрописью(21, "с;окно|окна|окон"))
Debug.WriteLine(ЧислоПрописью(21, "ж;дубинка|дубинки|дубинок"))
Debug.WriteLine(ЧислоПрописью(21, "ж;бутылка молока|бутылки молока|бутылок молока"))
Debug.WriteLine(ЧислоПрописью(1277, "ж;бутылка молока|бутылки молока|бутылок молока"))
'Три миллиона четыреста пятьдесят шесть тысяч восемьсот тридцать два рубля 71 копейка
'Три метра, 2 дециметра
'Три метра, 71 милиметр
'Тридцать две тонны и ещё 102 киллограмма
'Тридцать два человека
'Двадцать одно окно
'Двадцать одна дубинка
'Двадцать одна бутылка молока
'Одна тысяча двести семьдесят семь бутылок молока
End Sub
' "ж|копейка|копейки|копеек|2,00"
' ^ - кол-во значащих знаков после запятой
' ^ - символ-разделитель (пробел если не нужен)
' ^^ - формат вывода числа дробной части
' ^ - род наименования
' ^^^^^^^ - именительный падеж
' ^^^^^^^ - родительный падеж
' ^^^^^^ - родительный падеж множественного числа
Public Function ЧислоПрописью(ByVal xsu As Object, _
Optional ByVal PString1 As String = "м|рубль|рубля|рублей", _
Optional ByVal PString2 As String = vbNullString) As String
Dim ssu As String, nsu As Byte, edi As Byte, des As Byte, sot As Byte, ind As Byte, i As Integer, v() As String, j As Integer, sb As New System.Text.StringBuilder
Dim r1 As String = "м", r10 As String = vbNullString, r11 As String = vbNullString, r12 As String = vbNullString
Dim r2 As String = vbNullString, r20 As String = vbNullString, r21 As String = vbNullString, r22 As String = vbNullString, _
r2_ As String = vbNullString, r2n As Short = 2, r2s As String = "00"
On Error GoTo Err_
If Not IsNumeric(xsu) Then ЧислоПрописью = vbNullString : Exit Function
If xsu >= 10000000000000 Then ЧислоПрописью = "Слишком большое число" : Exit Function
If PString1 Is Nothing Then
PString2 = vbNullString
Else
PString1 = PString1.ToLower.Replace(";", "|")
If Not PString2 Is Nothing Then PString2 = PString2.ToLower.Replace(";", "|")
v = PString1.Split("|")
If v.Length >= 4 Then
If 0 = PString1.CompareTo("м|рубль|рубля|рублей") And PString2 Is Nothing Then
PString2 = "ж|копейка|копейки|копеек|2 00"
End If
r1 = v(0).Substring(0, 1)
r10 = v(1)
r11 = v(2)
r12 = v(3)
End If
End If
If Not PString2 Is Nothing Then
v = PString2.Split("|")
If v.Length = 4 Or v.Length = 5 Then
r2 = v(0).Substring(0, 1)
r20 = v(1)
r21 = v(2)
r22 = v(3)
If v.Length = 5 Then
r2n = CShort(v(4).Substring(0, 1))
r2_ = v(4).Substring(1, 1).Trim
r2s = v(4).Substring(2).Trim
If r2s.Length = 0 Then r2s = "0"
End If
End If
End If
If Fix(xsu) = 0 Then
sb.Append("ноль " & r12 & " ")
Else
If xsu < 0 Then sb.Append("минус ")
ssu = Fix(System.Math.Abs(xsu)).ToString ' строка рублей без знака
nsu = (ssu.Length + 2) \ 3 ' количество троек цифр
ssu = Right$("00", nsu * 3 - ssu.Length) + ssu ' добавляем нулями
For i = nsu To 1 Step -1
j = (nsu - i) * 3
sot = CByte(ssu.Substring(j, 1)) ' сотни
des = CByte(ssu.Substring(j + 1, 1)) ' десятки
edi = CByte(ssu.Substring(j + 2, 1)) ' единицы
If sot + des + edi > 0 Or i = 1 Then
If sot > 0 Then
sb.Append(Choose(sot, "сто", "двести", "триста", "четыреста", "пятьсот", "шестьсот", "семьсот", "восемьсот", "девятьсот") + " ")
End If
If des = 1 Then
sb.Append(Choose(edi + 1, "десять", "одиннадцать", "двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", "семнадцать", "восемнадцать", "девятнадцать") + " ")
ind = 3
Else
If des <> 0 Then
sb.Append(Choose(des - 1, "двадцать", "тридцать", "сорок", "пятьдесят", "шестьдесят", "семьдесят", "восемьдесят", "девяносто") + " ")
End If
If edi <> 0 Then ' вычисляем индекс для тысяч (одна,две)
ind = IIf(i = 2 And (edi = 1 Or edi = 2), 9, 0)
Select Case r1
Case "м" : sb.Append(Choose(edi + ind, "один", "два", "три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "одна", "две") + " ")
Case "ж" : sb.Append(Choose(edi + ind, "одна", "две", "три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "одна", "две") + " ")
Case Else : sb.Append(Choose(edi + ind, "одно", "два", "три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "одна", "две") + " ")
End Select
End If
Select Case edi
Case 1 : ind = 1
Case 2 To 4 : ind = 2
Case Else : ind = 3
End Select
End If
sb.Append(Choose((i - 1) * 3 + ind, r10, r11, r12, "тысяча", "тысячи", "тысяч", "миллион", "миллиона", "миллионов", "миллиард", "миллиарда", "миллиардов", "триллион", "триллиона", "триллионов") & " ")
End If
Next i
End If
If Not r2 Is Nothing Then
ssu = Right(Format(xsu, ".000".Substring(0, r2n + 1)), r2n)
If r2n > 1 Then des = CByte(ssu.Substring(r2n - 2, 1)) Else des = 0
edi = CByte(ssu.Substring(r2n - 1, 1))
xsu = CShort((xsu - Fix(xsu)) * (10 ^ r2n))
If des = 1 Then
ind = 3
Else
Select Case edi
Case 1 : ind = 1
Case 2 To 4 : ind = 2
Case Else : ind = 3
End Select
End If
If r2.Length > 0 And Not r2_ Is Nothing Then
If r2_.Length > 0 And sb.Length Then sb.Insert(sb.Length - 1, r2_)
End If
sb.Append(Format(xsu, r2s) & " " & Choose(ind, r20, r21, r22))
End If
ЧислоПрописью = sb.ToString.TrimEnd : sb = Nothing
Mid(ЧислоПрописью, 1, 1) = Mid(ЧислоПрописью, 1, 1).ToUpper
Exit Function
Err_:
ЧислоПрописью = "Ошибка числа прописью"
End Function
Фиг Вам! - Сказал Чебурашка, обгладывая Крокодила Гену...
-
GSerg
-
- Шаман
-
-
- Сообщения: 14286
- Зарегистрирован: 14.12.2002 (Сб) 5:25
- Откуда: Магадан
GSerg » 18.04.2006 (Вт) 12:04
Ну тогда для полноты картины ещё
http://bbs.vbstreets.ru/viewtopic.php?p=21450#21450, тоже в общем кирпич...
Как только вы переберёте все варианты решения и не найдёте нужного, тут же обнаружится решение, простое и очевидное для всех, кроме вас
Вернуться в Кирпичный завод
Кто сейчас на конференции
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1