Zamiana liczba na ich słowne odpowiedniki.(przysłał GizberN)
Napisał Administrator
wtorek, 24 styczeń 2006
Zamiana liczby na tekst
np. 2367 =dwa tysiące trzysta sześdziesiąt siedem
często jest to przydatne gdy program powinien wypisać wartość słownie.
Starałem się trochę opisać jak to działa, ale gdyby były jakieś
pytania, albo coś by się kopało to
a postaram się
odpowiedzieć.
Pozatym jeśli by ktoś poprawił to wszystko tak aby wyglądało i działało
trochę zgrabniej to proszę o E-mila, ja w trakcie samego pisania
zorientowałem się że można o wiele prościej, ale już za daleko zalazłem
i nie chciało mi się poprawiać, pozatym czas mnie gonił.
UWAGA : w procedurach mogą zanjdować się zmienne lub funkcje które pochodzą z mojego programu a które nie zawsze są potrzebne.
-=GizberN=-
Zmienne które należy umieścić w (General ) (Declarations)
Dim liczba As String ' zmienna dla zamiany liczby na tekst
Dim cyfra, kwota_wpłaty As String 'zmienne dla zamiany liczby na tekst
Dim d1, d2, d3, d4, d5, dodatek As String ' pomocnicze zmienne dla zamiany liczby na tekst
Dim text, text_1, text_2, text_3, text_4 As String ' zmienne dla zamiany liczby na teks
Dim liczba As Integer ' liczba jaka ma być zamieniona na tekst
Private Sub wywołanie()
text_4 = "" ' czyszczenie zmiennych
text_3 = ""
text_2 = ""
text_1 = ""
text = ""
d4 = ""
d5 = ""
dodatek = ""
wartosci_slownie ' wywołanie procedury zamieniającej liczbę na tekst
kwota_wpłaty = text_4 + " " + text_3 + " " + text_2 + " " + text_1 + "
" + text ' tutaj powstaje tekst jaki po zamianie liczby na tekst -
poszczególne zmienne odpowiadają za miejsca w danej liczbie
liczba= wartosc 'tutaj należy podać wartość jaka ma być zamieniona na tekst 0100000
End If
End Sub
Public Sub wartosci_slownie()
'sprawdzanie wartości liczby i rozbijanie jej na poszczególne składowe
Select Case Fix(CCur(liczba)) 'sprawdzanie do którego przedziału
liczbowego wartość należy i wywoływanie odpowiednich procedur
Case Is < 10
cyfra = Right(liczba, 1)
jedynka
Case Is < 20
cyfra = Right(liczba, 2)
naście
Case Is < 100
liczba = Right(liczba, 2)
cyfra = Left(liczba, 1)
dziesiątka
cyfra = Right(liczba, 1)
jedynka
Case Is < 1000
cyfra = Right(liczba, 3)
cyfra = Left(cyfra, 1)
setka
If Right(liczba, 2) < 10 Then 'sprzawdzanie czy cyfra posiada 01
cyfra = Right(liczba, 1)
jedynka
End If
If Right(liczba, 2) < 20 Then 'sprzawdzanie czy liczba posiada naście
cyfra = Right(liczba, 2)
naście
Else 'cyfra musi mieć końcówkę dziesiąt
cyfra = Right(liczba, 2)
cyfra = Left(cyfra, 1)
dziesiątka
cyfra = Right(liczba, 1)
jedynka
End If
Case Is < 10000
cyfra = Right(liczba, 4)
cyfra = Left(cyfra, 1)
tysiąc
cyfra = Right(liczba, 3)
If cyfra > 20 Then
cyfra = Left(cyfra, 1)
setka
If Right(liczba, 2) < 10 Then
cyfra = Right(liczba, 1)
jedynka
End If
Else
cyfra = Right(liczba, 2)
If cyfra < 10 Then
jedynka
Else
naście
End If
End If
If Right(liczba, 2) < 20 Then
cyfra = Right(liczba, 2)
naście
Else
cyfra = Right(liczba, 2)
cyfra = Left(cyfra, 1)
dziesiątka
cyfra = Right(liczba, 1)
jedynka
End If
Case Is < 100000
cyfra = Left(liczba, 2)
If cyfra < 20 Then ' sprawdzanie czy początek cyfry to naście
naście
d5 = text_1 + " tysięcy"
cyfra = Right(liczba, 3)
cyfra = Left(cyfra, 1)
setka
cyfra = Right(liczba, 2)
If cyfra < 10 Then jedynka
If cyfra < 20 Then
naście
Else
cyfra = Right(liczba, 2)
cyfra = Left(cyfra, 1)
dziesiątka
End If
Else
cyfra = Left(cyfra, 1)
dziesiątka
d5 = text_1
text_1 = ""
cyfra = Right$(CStr(liczba), 4)
cyfra = Left(cyfra, 1)
jedynka
If cyfra = 2 Or cyfra = 3 Or cyfra = 4 Then
dodatek = " tysiące "
Else
dodatek = " tysięcy "
End If
d4 = text
text = ""
cyfra = Right(liczba, 3)
cyfra = Left(cyfra, 1)
'sprawdzanie końcowych 3 cyfr
setka
cyfra = Right(liczba, 2)
If cyfra < 10 Then
jedynka
End If
' sprawdzanie końcowych 2 - cyfr
If cyfra < 10 Then jedynka
If cyfra < 20 Then
naście
Else
cyfra = Right(liczba, 2)
cyfra = Left(cyfra, 1)
dziesiątka
'd = text_1
cyfra = Right(liczba, 1)
jedynka
'd1 = text
End If
End If
text_4 = d5 + " " + d4 + dodatek
End Select
End Sub
Public Sub jedynka() 'procedury przypożądkowujące wartości złowne
poszczególnym zmiennym odpowiadającym za zamianę cyfry w liczbie na
wartość słowną.
Select Case CCur(cyfra)
Case 0
text = ""
Case 1
text = "jeden"
Case 2
text = "dwa"
Case 3
text = "trzy"
Case 4
text = "cztery"
Case 5
text = "pięć"
Case 6
text = "sześć"
Case 7
text = "siedem"
Case 8
text = "osiem"
Case 9
text = "dziewięć"
End Select
End Sub
Public Sub dziesiątka()
Select Case cyfra
Case 0
text_1 = ""
Case 1
text_1 = "dziesięć"
Case 2
text_1 = "dwadzieścia"
Case 3
text_1 = "trzydzieści"
Case 4
text_1 = "czterdzieści"
Case 5
text_1 = "piędziesiąt"
Case 6
text_1 = "sześćdziesiąt"
Case 7
text_1 = "siedemdziesiąt"
Case 8
text_1 = "osiemdziesiąt"
Case 9
text_1 = "dziewiędziesiąt"
End Select
End Sub
Public Sub setka()
Select Case cyfra
Case 0
text_2 = ""
Case 1
text_2 = "sto"
Case 2
text_2 = "dwieście"
Case 3
text_2 = "trzysta"
Case 4
text_2 = "czterysta"
Case 5
text_2 = "pięćset"
Case 6
text_2 = "sześćset"
Case 7
text_2 = "siedemset"
Case 8
text_2 = "osiemset"
Case 9
text_2 = "dziewięćset"
End Select
End Sub
Public Sub naście()
text_1 = ""
Select Case cyfra
Case 10
text_1 = "dziesięć"
Case 11
text_1 = "jedynaście"
Case 12
text_1 = "dwanaście"
Case 13
text_1 = "trzynaście"
Case 14
text_1 = "czternaście"
Case 15
text_1 = "pietnaście"
Case 16
text_1 = "szesnaście"
Case 17
text_1 = "siedemnaście"
Case 18
text_1 = "osiemnaście"
Case 19
text_1 = "dziewietnaście"
Case 20
text_1 = "dwadzieścia"
End Select
End Sub
Public Sub tysiąc()
Select Case cyfra
Case 1
text_3 = "tysiąc"
Case 2
text_3 = "dwa tysiące"
Case 3
text_3 = "trzy tysiące"
Case 4
text_3 = "czter tysiące"
Case 5
text_3 = "pięć tysięcy"
Case 6
text_3 = "sześć tysięcy"
Case 7
text_3 = "siedem tysięcy"
Case 8
text_3 = "osiem tysięcy"
Case 9
text_3 = "dziewięć tysięcy"
End Select
End Sub
Komentarze
Dodane przez jakubkameleon w dniu - 2006-11-03 18:37:39dzi?ki tego szuka?em
Aby dodać komentarz zaloguj się. Jeśli nie masz konta, załóż je sobie. Tylko zarejestrowani użytkownicy mogą pisać komentarze.
