Izpisvane na number / Компютри и Интернет / Visual Basic

Option Base 1

Private cResult As String
Private lAnd As Boolean

Function N2W(nNumber As Double) As String
Dim cNumber As String
Dim nGroups As Integer
Dim n As Integer
Dim nDiv As Integer

cResult = ""
nNumber = nNumber * 100
nDiv = nNumber Mod 100
nNumber = nNumber \ 100
lAnd = False
cNumber = Trim(Str(nNumber))
Do Until Len(cNumber) >= 12
cNumber = "0" & cNumber
Loop
nGroups = Int(Len(cNumber) / 3)
For n = 1 To nGroups
Call ProcGroup(Val(Mid(cNumber, n * 3 - 2, 3)), 5 - n)
Next
If nDiv > 0 Then
N2W = LTrim(cResult) + " лв. и " + Str(nDiv) + " ст."
Else
N2W = LTrim(cResult) + " лв."
End If
End Function

Private Sub ProcGroup(nNumber, nGroup)
cGroupS = Array("", " хиляда", " милион", " трилион")
cGroupM = Array("", " хиляди", " милиона", " трилиона")
c3_9 = Array(" три", " четири", " пет", " шест", " седем", " осем", " девет")
c10_19 = Array(" десет", " единаесет", " дванадесет", " тринадесет", " четиринадесет", _
" петнадесет", " шестнадесет", " седемнадесет", " осемнадсесет", " деветнадесет")
c2X_9X = Array(" двадесет", " тридесет", " четиридесет", " петдесет", " шестдесет", _
" седемдесет", " осемдесет", " деветдесет")
c0XX_9XX = Array("", " сто", " двеста", " триста", " четиристотин", " петстотин", _
" шестотин", " седемстотин", " осемстотин", " деветстотин")
Dim n, nleft, nRight1, nRight2, nMid As Integer
Dim lMidNo1 As Boolean
nleft = Int(nNumber / 100)
nRight1 = nNumber Mod 10
nRight2 = nNumber Mod 100
nMid = Int((nNumber Mod 100) / 10)
lMidNo1 = True
If nGroup = 1 And lAnd And nleft > 0 And nRight2 = 0 Then cResult = cResult + " и"
cResult = cResult + c0XX_9XX(nleft + 1)
If (Between(nRight2, 1, 20) Or _
InSet(nRight2, 30, 40, 50, 60, 70, 80, 90)) And (lAnd Or nleft > 0) Then
cResult = cResult + " и"
End If
If nMid > 1 Then
cResult = cResult + c2X_9X(nMid - 1)
If nRight1 > 0 Then cResult = cResult + " и"
ElseIf nMid = 1 Then
lMidNo1 = False
cResult = cResult + c10_19(nRight2 - 9)
End If
If Between(nRight1, 3, 9) And lMidNo1 Then cResult = cResult + c3_9(nRight1 - 2)
If nRight1 = 1 And lMidNo1 Then
If nGroup <> 2 Or nNumber > 1 Then cResult = cResult + " един"
End If
If nRight1 = 2 And lMidNo1 Then cResult = cResult + Iif(nGroup = 2, " две", " два")
If nGroup > 1 And nNumber > 0 Then
lAnd = True
cResult = cResult + Iif(nNumber > 1, cGroupM(nGroup), cGroupS(nGroup))
End If
End Sub

Private Function Between(xValue, xLo, xUp) As Boolean
If xValue >= xLo And xValue <= xUp Then
Between = True
Else
Between = False
End If
End Function

Private Function InSet(xValue, ParamArray xArray())
Dim n
For n = LBound(xArray) To UBound(xArray)
If xValue = xArray(n) Then
InSet = True
Exit For
End If
Next
End Function

Пращам ти кода,който използвам много отдавна.Сигурно може да се оптимизира,ама много ме мързи.Я кво хубаво време е навън...само за риба

P.S. Направил съм го само до 999.99лв. Предполагам няма да те затрудни да си го направиш и за повече

Public Function Slowom(number) As String
Dim drob As Single, cqlo As Integer, p_dec As Integer, prow As Integer, Pe1 As Integer
cqlo = Fix(number)
drob = number - cqlo
If drob > 0 Then
drob = drob * 100
prow = 1
If drob > 19 Then
str2 = nad_20(drob, "ñòîòèíêè")
Else
str2 = pod_20(drob, "ñòîòèíêè")
End If
End If
p_dec = Right(cqlo, 2)
If p_dec > 19 Then
str3 = nad_20(p_dec, "ëåâà")
Else
str3 = pod_20(p_dec, "ëåâà")
End If
If cqlo > 99 Then
Pe1 = 1
Select Case Left(cqlo, 1)
Case 1
str4 = "ñòî"
Case 2
str4 = "äâåñòà"
Case 3
str4 = "òðèñòà"
Case 4
str4 = "÷åòèðèñòîòèí"
Case 5
str4 = "ïåòñòîòèí"
Case 6
str4 = "øåñòñòîòèí"
Case 7
str4 = "ñåäåìñòîòèí"
Case 8
str4 = "îñåìñòîòèí"
Case 9
str4 = "äåâåòñòîòèí"
End Select
End If
If Pe1 = 0 Then
If prow = 1 Then
Slowom = str3 & " è " & str2
Else
Slowom = str3
End If
Else
If prow = 1 Then
Slowom = str4 & " è " & str3 & " è " & str2
Else
Slowom = str4 & " è " & str3
End If

End If
End Function
Function nad_20(num, mm) As String
First = Left(num, 1)
Select Case First
Case 2
str_2 = "äâàäåñåò"
Case 3
str_2 = "òðèäåñåò"
Case 4
str_2 = "÷åòèðèäåñåò"
Case 5
str_2 = "ïåòäåñåò"
Case 6
str_2 = "øåñòäåñåò"
Case 7
str_2 = "ñåäåìäåñåò"
Case 8
str_2 = "îñåìäåñåò"
Case 9
str_2 = "äåâåòäåñåò"

End Select

Select Case Right(num, 1)
Case 0
prow = 1
Case 1
If mm = "ëåâà" Then
str_3 = " åäèí"
Else
str_3 = " åäíà"
End If
Case 2
If mm = "ëåâà" Then
str_3 = " äâà"
Else
str_3 = " äâå"
End If
Case 3
str_3 = " òðè"
Case 4
str_3 = " ÷åòèðè"
Case 5
str_3 = " ïåò"
Case 6
str_3 = " øåñò"
Case 7
str_3 = " ñåäåì"
Case 8
str_3 = " îñåì"
Case 9
str_3 = " äåâåò"
End Select
If prow = 1 Then
nad_20 = str_2 & " " & mm
Else
nad_20 = str_2 & " è " & str_3 & " " & mm
End If
End Function
Function pod_20(num, mm)
Dim prom As Integer
prom = num
Select Case prom
Case 1
If mm = "ëåâà" Then
str_1 = " åäèí"
Else
str_1 = " åäíà"
End If
Case 2
If mm = "ëåâà" Then
str_1 = " äâà"
Else
str_1 = " äâe"
End If
Case 3
str_1 = " òðè"
Case 4
str_1 = " ÷åòèðè"
Case 5
str_1 = " ïåò"
Case 6
str_1 = " øåñò"
Case 7
str_1 = " ñåäåì"
Case 8
str_1 = " îñåì"
Case 9
str_1 = " äåâåò"
Case 10
str_1 = " äåñåò"
Case 11
str_1 = " åäèíàäåñåò"
Case 12
str_1 = " äâàíàäåñåò"
Case 13
str_1 = " òðèíàäåñåò"
Case 14
str_1 = " ÷åòèðèíàäåñåò"
Case 15
str_1 = " ïåòíàäåñåò"
Case 16
str_1 = " øåñòíàäåñåò"
Case 17
str_1 = " ñåäåìíàäåñåò"
Case 18
str_1 = " îñåìíàäåñåò"
Case 19
str_1 = " äåâåòíàäåñåò"
End Select
pod_20 = str_1 & " " & mm

End Function