| Imports System.Math
Public Class fLib
Private Skl As Byte
Public Function NumStr(ByVal N As Double, ByVal rub As Byte) As String
‘ Представление числа прописью.
‘ Числа типа double
‘ При втором аргументе функции равном:
‘ 0, вывод только числа прописью,
‘ 1, дополнительно вывод "рублей" и "копеек"
‘ 2, дополнительно вывод у.е. и сотых у.е.
‘ 3, дополнительно вывод "долларов" и "центов"
‘ 4, дополнительно вывод "ЕВРО" и "центов"
‘ 5, дополнительно вывод "ГРИВНЫ" и "копейки" (на укр. языке)
‘17.10.2006 6, дополнительно вывод "РОССИЙСКИХ рублей" и "копеек"
Dim s As String, R As String, K As String
Dim t, u, v, w As Integer
s = ""
If N < 0 Then
N = Abs(N)
s = "минус"
End If
‘——————————————————————————
v = (N — Fix(N)) * 100 ‘ Число копеек
w = Val(Right(Format(v), 1)) ‘ Получить число единиц копеек
N = Fix(N) ‘ Целое число рублей
t = Val(Right(Format(N), 2)) ‘ Получить две последние цифры рублей
u = Val(Right(t, 1)) ‘ Получить число единиц рублей
R = ""
K = ""
If t > 10 And t < 15 Then ‘ Получить подпись для рублей
Select Case rub
Case 1
R = " рублей"
Case 2
R = " у.е."
Case 3
R = " долларов"
Case 4
R = " евро"
Case 5
R = " гривень"
Case 6
R = " российских рублей"
End Select
ElseIf u = 1 Then
Select Case rub
Case 1
R = " рубль"
Case 2
R = " у.е."
Case 3
R = " доллар"
Case 4
R = " евро"
Case 5
R = " гривня"
Case 6
R = " российский рубль"
End Select
ElseIf u > 1 And u < 5 Then
Select Case rub
Case 1
R = " рубля"
Case 2
R = " у.е."
Case 3
R = " доллара"
Case 4
R = " евро"
Case 5
R = " гривнi"
Case 6
R = " российских рубля"
End Select
Else
Select Case rub
Case 1
R = " рублей"
Case 2
R = " у.е."
Case 3
R = " долларов"
Case 4
R = " евро"
Case 5
R = " гривень"
Case 6
R = " российских рублей"
End Select
End If
If v > 10 And v < 15 Then ‘ Получить подпись для копеек
Select Case rub
Case 1, 6
K = " копеек"
Case 2
K = "/100"
Case 3, 4
K = " центов"
Case 5
K = " копiйок"
End Select
ElseIf w = 1 Then
Select Case rub
Case 1, 6
K = " копейка"
Case 2
K = "/100"
Case 3, 4
K = " цент"
Case 5
K = " копiйка"
End Select
ElseIf w > 1 And w < 5 Then
Select Case rub
Case 1, 6
K = " копейки"
Case 2
K = "/100"
Case 3, 4
K = " центов"
Case 5
K = " копiйки"
End Select
Else
Select Case rub
Case 1, 6
K = " копеек"
Case 2
K = "/100"
Case 3, 4
K = " центов"
Case 5
K = " копiйок"
End Select
End If
‘——————————————————————————
If N >= 1000000000000.0# Then
s = AddStr(s, NumStr2(Int(N / 1000000000000.0#), True, rub))
Select Case Skl
Case 0
s = AddStr(s, "триллион")
Select Case rub
Case 5
s = AddStr(s, "триллион")
End Select
Case 1
s = AddStr(s, "триллиона")
Select Case rub
Case 5
s = AddStr(s, "триллиона")
End Select
Case 2
s = AddStr(s, "триллионов")
Select Case rub
Case 5
s = AddStr(s, "триллионов")
End Select
End Select
N = N — Int(N / 1000000000000.0#) * 1000000000000.0#
End If
If N >= 1000000000 Then
s = AddStr(s, NumStr2(Int(N / 1000000000), True, rub))
Select Case Skl
Case 0
s = AddStr(s, "миллиард")
Select Case rub
Case 5
s = AddStr(s, "мiльярд")
End Select
Case 1
s = AddStr(s, "миллиарда")
Select Case rub
Case 5
s = AddStr(s, "мiльярда")
End Select
Case 2
s = AddStr(s, "миллиардов")
Select Case rub
Case 5
s = AddStr(s, "мiльярдiв")
End Select
End Select
N = N — Int(N / 1000000000) * 1000000000
End If
If N >= 1000000 Then
s = AddStr(s, NumStr2(N \ 1000000, True, rub))
Select Case Skl
Case 0
s = AddStr(s, "миллион")
Select Case rub
Case 5
s = AddStr(s, "мiльйон")
End Select
Case 1
s = AddStr(s, "миллиона")
Select Case rub
Case 5
s = AddStr(s, "мiльйона")
End Select
Case 2
s = AddStr(s, "миллионов")
Select Case rub
Case 5
s = AddStr(s, "мiльйонiв")
End Select
End Select
N = N Mod 1000000
End If
If N >= 1000 Then
s = AddStr(s, NumStr2(N \ 1000, False, rub))
Select Case Skl
Case 0
s = AddStr(s, "тысяча")
Select Case rub
Case 5
s = AddStr(s, "тисяча")
End Select
Case 1
s = AddStr(s, "тысячи")
Select Case rub
Case 5
s = AddStr(s, "тисяча")
End Select
Case 2
s = AddStr(s, "тысяч")
Select Case rub
Case 5
s = AddStr(s, "тисяч")
End Select
End Select
N = N Mod 1000
End If
If N > 0 Then
s = AddStr(s, NumStr2(N, True, rub))
End If
If s = "" Then
s = "ноль"
Select Case rub
Case 5
s = "нуль"
End Select
ElseIf s = "минус" Then
s = s + " ноль"
Select Case rub
Case 5
s = "мiнус нуль"
End Select
End If
NumStr = StrConv(Mid(s, 1, 1), vbUpperCase) + Mid(s, 2, Len(s) — 1)
If (rub) Then NumStr = NumStr & R & Format(v, " 00") & K
End Function
Public Function DateAsString(ByVal dd As Date) As String
‘Дата прописью
Dim y As Integer, m As Integer, d As Integer
Dim sy As String, sm As String, sd As String
y = Year(dd)
sy = CStr(y)
d = Day(dd)
sd = CStr(d)
sd = Right("00" + sd, 2)
m = Month(dd)
Select Case m
Case 1
sm = "января"
Case 2
sm = "февраля"
Case 3
sm = "марта"
Case 4
sm = "апреля"
Case 5
sm = "мая"
Case 6
sm = "июня"
Case 7
sm = "июля"
Case 8
sm = "августа"
Case 9
sm = "сентября"
Case 10
sm = "октября"
Case 11
sm = "ноября"
Case 12
sm = "декабря"
Case Else
sm = ""
End Select
Return sd + " " + sm + " " + sy
End Function
Public Function GetValue(ByVal value As Object) As Object
‘Вернуть значение не NULL
If value Is Nothing Then
Return 0
Else
Return value
End If
End Function
Private Function AddStr(ByVal S1 As String, ByVal S2 As String) As String
If S1 = "" Then
AddStr = S2
ElseIf S2 = "" Then
AddStr = S1
Else
AddStr = S1 + " " + S2
End If
End Function
Private Function NumStr2(ByVal N As Double, ByVal male As Boolean, ByVal rub As Byte) As String
Dim s As String
s = ""
If N >= 100 Then
s = NumStr1(((N \ 100) * 100), male, rub)
N = N Mod 100
End If
If N >= 20 Then
s = AddStr(s, NumStr1(((N \ 10) * 10), male, rub))
N = N Mod 10
End If
NumStr2 = AddStr(s, NumStr1(N, male, rub))
End Function
Private Function NumStr1(ByVal N As Double, ByVal male As Boolean, ByVal rub As Byte) As String
Dim ReturnValue As String
ReturnValue = ""
Skl = 2
Select Case N
Case 100
ReturnValue = "сто"
Select Case rub
Case 5
ReturnValue = "сто"
End Select
Case 200
ReturnValue = "двести"
Select Case rub
Case 5
ReturnValue = "двiстi"
End Select
Case 300
ReturnValue = "триста"
Select Case rub
Case 5
ReturnValue = "триста"
End Select
Case 400
ReturnValue = "четыреста"
Select Case rub
Case 5
ReturnValue = "чотириста"
End Select
Case 500
ReturnValue = "пятьсот"
Select Case rub
Case 5
ReturnValue = "п’ятсот"
End Select
Case 600
ReturnValue = "шестьсот"
Select Case rub
Case 5
ReturnValue = "шiстсот"
End Select
Case 700
ReturnValue = "семьсот"
Select Case rub
Case 5
ReturnValue = "сiмсот"
End Select
Case 800
ReturnValue = "восемьсот"
Select Case rub
Case 5
ReturnValue = "вiсiмсот"
End Select
Case 900
ReturnValue = "девятьсот"
Select Case rub
Case 5
ReturnValue = "дев’ятисот"
End Select
Case 11
ReturnValue = "одиннадцать"
Select Case rub
Case 5
ReturnValue = "одинадцять"
End Select
Case 12
ReturnValue = "двенадцать"
Select Case rub
Case 5
ReturnValue = "дванадцять"
End Select
Case 13
ReturnValue = "тринадцать"
Select Case rub
Case 5
ReturnValue = "тринадцять"
End Select
Case 14
ReturnValue = "четырнадцать"
Select Case rub
Case 5
ReturnValue = "чотирнадцять"
End Select
Case 15
ReturnValue = "пятнадцать"
Select Case rub
Case 5
ReturnValue = "п’ятнадцять"
End Select
Case 16
ReturnValue = "шестнадцать"
Select Case rub
Case 5
ReturnValue = "шiстнадцять"
End Select
Case 17
ReturnValue = "семнадцать"
Select Case rub
Case 5
ReturnValue = "сiмнадцять"
End Select
Case 18
ReturnValue = "восемнадцать"
Select Case rub
Case 5
ReturnValue = "вiсiмнадцять"
End Select
Case 19
ReturnValue = "девятнадцать"
Select Case rub
Case 5
ReturnValue = "дев’ятнадцять"
End Select
Case 20
ReturnValue = "двадцать"
Select Case rub
Case 5
ReturnValue = "двадцять"
End Select
Case 30
ReturnValue = "тридцать"
Select Case rub
Case 5
ReturnValue = "тридцять"
End Select
Case 40
ReturnValue = "сорок"
Select Case rub
Case 5
ReturnValue = "сорок"
End Select
Case 50
ReturnValue = "пятьдесят"
Select Case rub
Case 5
ReturnValue = "п’ятдесят"
End Select
Case 60
ReturnValue = "шестьдесят"
Select Case rub
Case 5
ReturnValue = "ш_стдесят"
End Select
Case 70
ReturnValue = "семьдесят"
Select Case rub
Case 5
ReturnValue = "сiмдесят"
End Select
Case 80
ReturnValue = "восемьдесят"
Select Case rub
Case 5
ReturnValue = "вiсiмдесят"
End Select
Case 90
ReturnValue = "девяносто"
Select Case rub
Case 5
ReturnValue = "дев’яносто"
End Select
Case 1
Skl = 0
If male Then
ReturnValue = "один"
Select Case rub
Case 5
ReturnValue = "одна"
End Select
Else
ReturnValue = "одна"
Select Case rub
Case 5
ReturnValue = "одна"
End Select
End If
Case 2
Skl = 1
If male Then
ReturnValue = "два"
Select Case rub
Case 5
ReturnValue = "двi"
End Select
Else
ReturnValue = "две"
Select Case rub
Case 5
ReturnValue = "двi"
End Select
End If
Case 3
Skl = 1
ReturnValue = "три"
Select Case rub
Case 5
ReturnValue = "три"
End Select
Case 4
Skl = 1
ReturnValue = "четыре"
Select Case rub
Case 5
ReturnValue = "чотири"
End Select
Case 5
ReturnValue = "пять"
Select Case rub
Case 5
ReturnValue = "п’ять"
End Select
Case 6
ReturnValue = "шесть"
Select Case rub
Case 5
ReturnValue = "шiсть"
End Select
Case 7
ReturnValue = "семь"
Select Case rub
Case 5
ReturnValue = "сiм"
End Select
Case 8
ReturnValue = "восемь"
Select Case rub
Case 5
ReturnValue = "вiсiм"
End Select
Case 9
ReturnValue = "девять"
Select Case rub
Case 5
ReturnValue = "дев’ять"
End Select
Case 10
ReturnValue = "десять"
Select Case rub
Case 5
ReturnValue = "десять"
End Select
End Select
Return ReturnValue
End Function
End Class |
