Sabtu, 11 September 2010

Function terbilang pada VB

Fungsi Terbilang Pake Vb

Mengubah angka menjadi huruf ..fungsi terbilang sangat bermanfaat buat kamu yang bikin program yang banyak berhubungan dengan uang.


Buat Module baru dengan nama Mod_terbilang :
isi script didalamnya :
Function NumToText(dblValue As Double) As String
    Static ones(0 To 9) As String
    Static teens(0 To 9) As String
    Static tens(0 To 9) As String
    Static thousands(0 To 4) As String
    Dim i As Integer, nPosition As Integer
    Dim nDigit As Integer, bAllZeros As Integer
    Dim strResult As String, strTemp As String
    Dim tmpBuff As String
    
    ones(0) = ""
    ones(1) = "one"
    ones(2) = "two"
    ones(3) = "three"
    ones(4) = "four"
    ones(5) = "five"
    ones(6) = "six"
    ones(7) = "seven"
    ones(8) = "eight"
    ones(9) = "nine"

    teens(0) = ""
    teens(1) = "eleven"
    teens(2) = "twenteen"
    teens(3) = "thirteen"
    teens(4) = "fourteen"
    teens(5) = "fiveteen"
    teens(6) = "sixteen"
    teens(7) = "seventeen"
    teens(8) = "eighteen"
    teens(9) = "nineteen"

    tens(0) = ""
    tens(1) = "ten"
    tens(2) = "twenty"
    tens(3) = "thirty"
    tens(4) = "fourty"
    tens(5) = "fivety"
    tens(6) = "sixty"
    tens(7) = "seventy"
    tens(8) = "eighty"
    tens(9) = "ninety"

    thousands(0) = ""
    thousands(1) = "thousand"
    thousands(2) = "million"
    thousands(3) = "billion"
    thousands(4) = "triliun"

    'Errors Handler
    On Error GoTo NumToTextError
    'Bagian akhir
    strResult = "rupiah "
    'Konversi ke string
    Dim des, j, t1, t2
    Dim ada As Boolean
    For j = 1 To Len(totalbiaya)
       des = Mid(totalbiaya, j, 1)
       If des = "." Or des = "," Then
          ada = True
          t1 = Mid(totalbiaya, 1, j - 1)
          t2 = Mid(totalbiaya, j   1)
          j = Len(totalbiaya)
       End If
    Next j
    If ada = True Then
      strTemp = CStr(Int(t1))
      ada = False
    Else
      strTemp = CStr(Int(dblValue))
    End If
'    strTemp = CStr(Int(dblValue))
    'Diulang sebanyak panjang teks
    For i = Len(strTemp) To 1 Step -1
        'Ambil nilai angka posisi ke-i
        nDigit = Val(Mid$(strTemp, i, 1))
        'Ambil posisi angka
        nPosition = (Len(strTemp) - i)   1
        'Pilihan proses tergantung posisi satuan, puluhan, atau ratusan
        Select Case (nPosition Mod 3)
            Case 1  'Posisi satuan
                bAllZeros = False
                If i = 1 Then
                    tmpBuff = ones(nDigit)

Tidak ada komentar:

Posting Komentar