Selasa, 21 Desember 2010

Membuat fungsi terbilang VB .Net

Public Function Terbilang(ByVal x As Integer) As String
Dim bilangan As String() = {"", "satu", "dua", "tiga", "empat", "lima",
"enam", "tujuh", "delapan", "sembilan", "sepuluh", "sebelas"}
Dim temp As String = ""

If x < 12 Then
temp = " " + bilangan(x)
Else If x < 20 Then
temp = Terbilang(x - 10).ToString + " belas"
Else If x < 100 Then
temp = Terbilang(x / 10) + " puluh" + Terbilang(x Mod 10)
Else If x < 200 Then
temp = " seratus" + Terbilang(x - 100)
Else If x < 1000 Then
temp = Terbilang(x / 100) + " ratus" + Terbilang(x Mod 100)
Else If x < 2000 Then
temp = " seribu" + Terbilang(x - 1000)
Else If x < 1000000 Then
temp = Terbilang(x / 1000) + " ribu" + Terbilang(x Mod 1000)
Else If x < 1000000000 Then
temp = Terbilang(x / 1000000) + " juta" + Terbilang(x Mod 1000000)
End If

Return temp
End Function



atau menggnakan code ini

Fungsi Ambil Koma

    Public Function AmbilSblmKoma(ByVal NilaiNya As Decimal) As Decimal
        Dim hSl As Decimal

        hSl = Left(NilaiNya, InStr(NilaiNya, ",") - 1)
        Return hSl

    End Function
 

Fungsi Konversi

 Option Explicit On
Module module_terbilang

    Public Function TERBILANG(ByVal x As Double) As String
        Dim tampung As Double
        Dim teks As String
        Dim bagian As String
        Dim i As Integer
        Dim tanda As Boolean

        Dim letak(5)
        letak(1) = "RIBU "
        letak(2) = "JUTA "
        letak(3) = "MILYAR "
        letak(4) = "TRILYUN "

        If (x < 0) Then
            TERBILANG = ""
            Exit Function
        End If

        If (x = 0) Then
            TERBILANG = "NOL"
            Exit Function
        End If

        If (x < 2000) Then
            tanda = True
        End If
        teks = ""

        If (x >= 1.0E+15) Then
            TERBILANG = "NILAI TERLALU BESAR"
            Exit Function
        End If

        For i = 4 To 1 Step -1
            tampung = Int(x / (10 ^ (3 * i)))
            If (tampung > 0) Then
                bagian = ratusan(tampung, tanda)
                teks = teks &#038; bagian &#038; letak(i)
            End If
            x = x - tampung * (10 ^ (3 * i))
        Next

        teks = teks &#038; ratusan(x, False)
        TERBILANG = teks &#038; "RUPIAH"
    End Function

    Function ratusan(ByVal y As Double, ByVal flag As Boolean) As String
        Dim tmp As Double
        Dim bilang As String
        Dim bag As String
        Dim j As Integer

        Dim angka(9)
        angka(1) = "SE"
        angka(2) = "DUA "
        angka(3) = "TIGA "
        angka(4) = "EMPAT "
        angka(5) = "LIMA "
        angka(6) = "ENAM "
        angka(7) = "TUJUH "
        angka(8) = "DELAPAN "
        angka(9) = "SEMBILAN "

        Dim posisi(2)
        posisi(1) = "PULUH "
        posisi(2) = "RATUS "

        bilang = ""
        For j = 2 To 1 Step -1
            tmp = Int(y / (10 ^ j))
            If (tmp > 0) Then
                bag = angka(tmp)
                If (j = 1 And tmp = 1) Then
                    y = y - tmp * 10 ^ j
                    If (y >= 1) Then
                        posisi(j) = "BELAS "
                    Else
                        angka(y) = "SE"
                    End If
                    bilang = bilang &#038; angka(y) &#038; posisi(j)
                    ratusan = bilang
                    Exit Function
                Else
                    bilang = bilang &#038; bag &#038; posisi(j)
                End If
            End If
            y = y - tmp * 10 ^ j
        Next

        If (flag = False) Then
            angka(1) = "SATU "
        End If
        bilang = bilang &#038; angka(y)
        ratusan = bilang
    End Function
  
End Module

Tidak ada komentar:

Posting Komentar