'FORM İÇİN ADI LABEL1 OLAN BİR ETİKET
'ADI TEXT1 OLAN BİR METİN KUTUSU
'ADI COMMAND1 OLAN BİR DÜĞME
Function YazıIle(SayıNE As Currency) As String
On Error Resume Next
Dim Uzunluk As Integer, a1 As Double, a2 As Double, KaçHane As Integer, TamSayı As String, i As Integer, Hane(1 To 5) As String, x As Integer, Yazı(1 To 5) As String
Dim Bir_(9) As String, On_(9) As String, Yüz_ As String, BindeSonra(1 To 5) As String
Bir_(0) = ""
Bir_(1) = "bir"
Bir_(2) = "iki"
Bir_(3) = "üç"
Bir_(4) = "dört"
Bir_(5) = "beş"
Bir_(6) = "altı"
Bir_(7) = "yedi"
Bir_(8) = "sekiz"
Bir_(9) = "dokuz"
On_(0) = ""
On_(1) = "on"
On_(2) = "yirmi"
On_(3) = "otuz"
On_(4) = "kırk"
On_(5) = "elli"
On_(6) = "altmış"
On_(7) = "yetmiş"
On_(8) = "seksen"
On_(9) = "doksan"
BindeSonra(1) = ""
BindeSonra(2) = "bin"
BindeSonra(3) = "milyon"
BindeSonra(4) = "milyar"
BindeSonra(5) = "trilyon"
Uzunluk = Len(CStr(SayıNE))
a1 = CInt(Uzunluk / 3)
a2 = Uzunluk / 3
If a2 > a1 Then KaçHane = a1 + 1 Else KaçHane = a1
TamSayı = String$((KaçHane * 3) - Uzunluk, "0") & CStr(SayıNE)
For i = 1 To KaçHane * 3
If i = 1 Then
Hane(i) = Mid$(TamSayı, i, 3)
Else
Hane(i) = Mid$(TamSayı, i * 3 - 2, 3)
End If
Next i
Me.Caption = Hane(1) & " - " & Hane(2) & " - " & Hane(3) & " - " & Hane(4) & " - " & Hane(5)
For i = 1 To KaçHane
For x = 1 To 3
Select Case x
Case 1
If Mid$(Hane(i), x, 1) = "1" Then
Yazı(i) = Yazı(i) + "yüz"
ElseIf Mid$(Hane(i), x, 1) = "0" Then
Yazı(i) = Yazı(i)
Else
Yazı(i) = Yazı(i) + Bir_(Mid$(Hane(i), x, 1)) + "yüz"
End If
Case 2
If Mid$(Hane(i), x, 1) = "0" Then
Yazı(i) = Yazı(i)
Else
Yazı(i) = Yazı(i) + On_(Mid$(Hane(i), x, 1))
End If
Case 3
If Mid$(Hane(i), x, 1) = "" Then
Yazı(i) = Yazı(i)
Else
If CInt(Mid$(Hane(i), x, 1)) = 1 And Left$(Hane(i), 2) = "00" And i = KaçHane - 1 Then
Yazı(i) = Yazı(i) + BindeSonra(KaçHane + 1 - i)
Else
Yazı(i) = Yazı(i) + Bir_(Mid$(Hane(i), x, 1)) + BindeSonra(KaçHane + 1 - i)
End If
End If
End Select
Next x
Next i
YazıIle = Yazı(1) + Yazı(2) + Yazı(3) + Yazı(4) + Yazı(5)
End Function
Private Sub Command1_Click()
On Error Resume Next
Me.Label1.Caption = YazıIle(CCur(Me.Text1.Text))
End Sub