10 Mart 2011 Perşembe

Visual Basic Girilen Sayıyı Yazıya Çevirme

Basit string functionlarıyla sayıyı yazıya çevirmek. Pek anlaşılır olmadı fakat işe yarar duruyor.

Function NToT(Value)
Dim N(100)
Dim T(5)

N(0) = "sıfır"
N(1) = "bir"
N(2) = "iki"
N(3) = "üç"
N(4) = "dört"
N(5) = "beş"
N(6) = "altı"
N(7) = "yedi"
N(8) = "sekiz"
N(9) = "dokuz"
N(10) = "on"
N(20) = "yirmi"
N(30) = "otuz"
N(40) = "kırk"
N(50) = "elli"
N(60) = "altmış"
N(70) = "yetmiş"
N(80) = "seksen"
N(90) = "doksan"

T(0) = ""
T(1) = "bin"
T(2) = "milyon"
T(3) = "milyar"
T(4) = "trilyon"
T(5) = "kattrilyon"

ThreeIn = Int(Len(Value) / 3)
ThreeOut = Len(Value) - ThreeIn * 3
ThreeOuttedText = Mid(Value, ThreeOut + 1)
ThreeInText = Left(Value, ThreeOut)

Dim Threes()
ReDim Threes(ThreeIn)

Select Case Len(ThreeInText)
Case 1
LeftText = N(ThreeInText)
Case 2
If Mid(ThreeInText, 2, 1) <> "0" Then
LeftText = N(Left(ThreeInText, 1) & "0") & N(Right(ThreeInText, 1))
Else
LeftText = N(ThreeInText)
End If
End Select

If ThreeIn <> 0 Then
Dim SplittedNumber()
ReDim SplittedNumber(ThreeIn - 1)

For i = 0 To UBound(SplittedNumber)
SplittedNumber(i) = Mid(ThreeOuttedText, (i * 3) + 1, 3)
Next

For i = UBound(SplittedNumber) To 0 Step -1
If Mid(SplittedNumber(i), 1, 1) <> "0" Then
If Mid(SplittedNumber(i), 1, 1) <> "1" Then
A = N(Mid(SplittedNumber(i), 1, 1)) & "yüz"
Else
A = "yüz"
End If
Else
A = ""
End If
If Mid(SplittedNumber(i), 2, 1) <> "0" Then
B = N(Mid(SplittedNumber(i), 2, 1) & 0)
Else
B = ""
End If
If Mid(SplittedNumber(i), 3, 1) <> "0" Then
C = N(Mid(SplittedNumber(i), 3, 1))
Else
C = ""
End If

Threes(UBound(SplittedNumber) - i) = A & B & C
Next

For i = IIf((ThreeOut = 0), UBound(Threes) - 1, UBound(Threes)) To 0 Step -1
ThreeText = ThreeText & Threes(i) & T(i) & " "
Next
End If

LastText = LeftText & ThreeText
LastText = Replace(LastText, "birbin", "bin")
LastText = Replace(LastText, " bin", "")
LastText = Replace(LastText, " milyon", "")
LastText = Replace(LastText, " milyar", "")
LastText = Replace(LastText, " trilyon", "")
LastText = Replace(LastText, " kattrilyon", "")
NToT = LastText
End Function

Hiç yorum yok:

Yorum Gönder