Programalama > VISUAL BASIC

'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