Fungsi Terbilang Pada Visual Basic 6.0

Yang dimaksud terbilang disini yaitu jika kita memasukkan nilai 100000, maka outputnya yaitu Seratus Ribu Rupiah. Membuat fungsi terbilang pada Visual Basic 6.0 ini ternyata cukup gampang.

Design lah form fungsi terbilang seperti berikut ini :

Fungsi Terbilang Pada Visual Basic 6.0










Berikut listing program fungsi terbilang :

Private Sub Text1_KeyPress(KeyAscii As Integer)    If KeyAscii = 13 Then
        Text2.Text = Terbilang(Text1.Text)
    End If
End Sub
Function Terbilang(Angka As String) As String    Dim n1 As String
    Dim nangka, Strjmlhuruf$, intpecahan As Integer, strpecahan$, urai$, Bil1$, strtot$, bil2$
    Dim x, Y, z, i As Integer
   
    For i = 1 To Len(Angka)
        If Not Mid(Angka, i, 1) = "." Then
            nangka = nangka + Mid(Angka, i, 1)
        End If
    Next
   
    If Len(LTrim(nangka)) = 0 Then
        terbit = "Nol Rupiah"
        Exit Function
    End If
    Strjmlhuruf = LTrim(RTrim((nangka)))
    intpecahan = Val(Right(Mid(Angka, 15, 2), 2))
    If (intpecahan = 0) Then
        strpecahan = ""
    End If
    x = 0
    Y = 0
    urai = ""
   
    While (x < Len(Strjmlhuruf))
        x = x + 1
        strtot = Mid(Strjmlhuruf, x, 1)
        Y = Y + Val(strtot)
        z = Len(Strjmlhuruf) - x + 1
   
        Select Case Val(strtot)
        Case 1
            If (z = 1 Or z = 7 Or z = 10 Or z = 13) Then
                Bil1 = "Satu "
            ElseIf (z = 4) Then
                If (x = 1) Then
                    Bil1 = "Se"
                Else
                    Bil1 = "Satu "
                End If
            ElseIf (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then
                x = x + 1
                strtot = Mid(Strjmlhuruf, x, 1)
                z = Len(Strjmlhuruf) - x + 1
                bil2 = ""
   
            Select Case Val(strtot)
            Case 0
                Bil1 = "Sepuluh "
            Case 1
                Bil1 = "Sebelas "
            Case 2
                Bil1 = "Dua Belas "
            Case 3
                Bil1 = "Tiga Belas "
            Case 4
                Bil1 = "Empat Belas "
            Case 5
                Bil1 = "Lima Belas "
            Case 6
                Bil1 = "Enam Belas "
            Case 7
                Bil1 = "Tujuh Belas "
            Case 8
                Bil1 = "Delapan Belas "
            Case 9
                Bil1 = "Sembilan Belas "
            End Select
            Else
                Bil1 = "Se"
            End If
   
        Case 2
            Bil1 = "Dua "
        Case 3
            Bil1 = "Tiga "
        Case 4
            Bil1 = "Empat "
        Case 5
            Bil1 = "Lima "
        Case 6
            Bil1 = "Enam "
        Case 7
            Bil1 = "Tujuh "
        Case 8
            Bil1 = "Delapan "
        Case 9
            Bil1 = "Sembilan "
        Case Else
            Bil1 = ""
        End Select
   
    If (Val(strtot) > 0) Then
        If (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then
            bil2 = "Puluh "
        ElseIf (z = 3 Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then
            bil2 = "Ratus "
        Else
            bil2 = ""
        End If
    Else
        bil2 = ""
    End If
    If (Y > 0) Then
        Select Case z
        Case 4
            bil2 = bil2 + "Ribu "
            Y = 0
        Case 7
            bil2 = bil2 + "Juta "
            Y = 0
        Case 10
            bil2 = bil2 + "Milyar "
            Y = 0
        Case 13
            bil2 = bil2 + "Trilyun "
            Y = 0
        End Select
    End If
    urai = urai + Bil1 + bil2
Wend
   
urai = urai + strpecahan
Terbilang = urai & "Rupiah "
Terbilang = LCase(Terbilang)
n1 = UCase(Left(Terbilang, 1))
Terbilang = n1 & Mid(Terbilang, 2, Len(Terbilang) - 1)
End Function

Berikut hasil program

Fungsi Terbilang Pada Visual Basic 6.0










Demikian artikel mengenai fungsi terbilang pada Visual Basic 6.0. semoga bisa anda mengerti.

5 komentar untuk "Fungsi Terbilang Pada Visual Basic 6.0"

  1. cukup bagus... tetapi terlalu panjang logic-nya... :) bisa lebih singkat lagi koq... coba lagi... :)

    ReplyDelete
    Replies
    1. klo diliat dari nilai yang bisa sampe trilliun, itu logika yang cukup pendek.

      Delete
  2. Mantap gan, menambahkan saja, jika mau tampilan Title Case tambahkan script ini :

    Terbilang = urai & "Rupiah "
    Terbilang = LCase(Terbilang)
    Terbilang = StrConv(Terbilang, VbStrConv.vbProperCase)

    ReplyDelete

Terima kasih sudah memberikan komentar anda dengan baik.Konversi KodeEmoticonFolllow

Back to Top