Programalama > VISUAL BASIC

Etiketler: rakamlari, yaziya, çevirme

Ort. 0
Puan ver:
'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


Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2024 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.