Nabídka portálu se při zobrazení článku přesouvá na konec pravého sloupce nabídek.
Převod celého čísla na text ve VB |
Autor: Kočí Marek
| Zdroj:
| Vytvořeno: 24.9.2003
| Publikováno: 26.9.2003
| Čtenářů: 3890
| Unikátních: 3697
|
od 0 do 9999999
Na formulář vložte 1x textbox a 1x command
a následující kód:
Private Sub Command1_Click()
MsgBox Number2Text(Text1.Text)
End Sub
Public Function Number2Text _
(ByVal vNumber As Variant) As String
Dim lngTmp As Long
If Not IsNumeric(vNumber) Then
Number2Text = "Err0001 - Není číslo"
Exit Function
Else
lngTmp = CLng(Int(vNumber))
If lngTmp &> 9999999 Then
Number2Text = "Err0002 - Max 9999999"
Exit Function
End If
End If
Number2Text = fncNum2Text(lngTmp)
End Function
Public Function fncNum2Text _
(ByVal iNumber As Long) As String
Dim PrevodDesitky(2 To 9) As String
Dim Prevod100Tisice(1 To 9) As String
Dim PrevodMiliony(1 To 9) As String
Dim Miliony, StoTisice, DesetiTisice
Dim Tisice, Stovky, Desitky, Zbytek
Dim result
Dim zast, I
zast = Array("jedenmilion", "dvamiliony", _
"třimiliony", "čtyřimiliony", _
"pětmilionů", _
"šestmilionů", "sedmmilionů", _
"osmmilionů", "devětmilionů")
For I = 1 To 9
PrevodMiliony(I) = zast(I - 1)
Next
zast = Array("sto", "dvěstě", "třista", "čtyřista", _
"pětset", "šestset", "sedmset", _
"osmset", "devětset")
For I = 1 To 9
Prevod100Tisice(I) = zast(I - 1)
Next
zast = Array("dvacet", "třicet", "čtyřicet", _
"padesát", "šedesát", "sedmdesát", _
"osmdesát", "devadesát")
For I = 2 To 9
PrevodDesitky(I) = zast(I - 2)
Next
Miliony = iNumber \ 1000000
If Miliony &>= 1 Then
Zbytek = iNumber Mod 1000000
result = result & PrevodMiliony(Miliony)
Else
Zbytek = iNumber
End If
StoTisice = Zbytek \ 100000
If StoTisice &>= 1 Then
Zbytek = iNumber Mod 100000
result = result & Prevod100Tisice(StoTisice)
Else
Zbytek = iNumber
End If
DesetiTisice = Zbytek \ 10000
If DesetiTisice &> 1 Then
Zbytek = iNumber Mod 10000
result = result & PrevodDesitky(DesetiTisice)
Else
Zbytek = iNumber
End If
Tisice = Zbytek \ 1000
If Tisice &> 0 Then
Zbytek = Zbytek Mod 1000
result = result & Prevod(1000, Tisice)
Else
If DesetiTisice &> 0 Then _
result = result & "tisíc"
End If
Stovky = Zbytek \ 100
If Stovky &> 0 Then
Zbytek = Zbytek Mod 100
result = result & Prevod(100, Stovky)
End If
Desitky = Zbytek \ 10
If Desitky &> 1 Then
Zbytek = Zbytek Mod 10
result = result & PrevodDesitky(Desitky)
End If
If Zbytek &> 0 Then
result = result & Prevod(1, Zbytek)
End If
fncNum2Text = result
End Function
Private Function Prevod(Rad, Hodnota) As String
Dim Jednotky(5 To 19) As String
Dim zast, I, result
zast = Array("pět", "šest", "sedm", "osm", "devět", _
"deset", "jedenáct", "dvanáct", _
"třináct", "čtrnáct", _
"patnáct", "šestnáct", "sedmnáct", _
"osmnáct", "devatenáct")
For I = 5 To 19
Jednotky(I) = zast(I - 5)
Next
If (Hodnota &> 4) And (Hodnota &< 20) Then _
result = Jednotky(Hodnota)
If Rad = 1000 Then
result = result & "tisíc"
If Hodnota = 1 Then result = "jedentisíc"
If Hodnota = 2 Then result = "dvatisíce"
If Hodnota = 3 Then result = "třitisíce"
If Hodnota = 4 Then result = "čtyřitisíce"
End If
If Rad = 100 Then
result = result & "set"
If Hodnota = 1 Then result = "jednosto"
If Hodnota = 2 Then result = "dvěstě"
If Hodnota = 3 Then result = "třista"
If Hodnota = 4 Then result = "čtyřista"
End If
If Rad = 1 Then
If Hodnota = 1 Then result = "jedna"
If Hodnota = 2 Then result = "dvě"
If Hodnota = 3 Then result = "tři"
If Hodnota = 4 Then result = "čtyři"
End If
Prevod = result
End Function
|