Senin, 13 April 2015

Terbilang Rupiah bahasa Indonesia basic programming

Waktu menggunakan microsoft access, saya kesulitan menemukan program yang bagus dalam membuat terbilang pada kwitansi.
Saat uji coba, program program yang ada di internet foxpro dll, tidak sesuai dengan kaidah bahasa indonesia.

Kemudian saya temukan program terbilang English, yang ternyata ada pada Help file microsoft access.
Wow, hebat, menggunakan metode recursif, yaitu program yang memanggil dirinya sendiri. Sehingga pemograman sederhana dan kecepatan tinggi.

dibawah ini program terbilang bahasa indonesia serta program aslinya bahasa English,
saya lakukan modifikasi sedikit dari program aslinya

taruh textbox untuk terbilang pada form
lalu klik-klik propertynya, lalu isikan data source
=" (# " & ConvertCurrencyToIndonesia(Int([rupiahangkanya])) & " #)"
atau
=" (# " & ConvertCurrencyToEnglish(Int([dollarangkanya])) & " #)"

rupiahangkanya atau dollarangkanya adalah nama textbox yang berisi angka yang hendak dibuat
terbilang, bisa juga dari hasil penjumlahan(misalnya textbox [totalrupiah]

-------------------------------------

Option Compare Database
Option Explicit


Function ConvertCurrencyToIndonesia(ByVal Angkanya)
  Dim temp
         Dim Rupiahnya, Sennya
         Dim DecimalPlace, Count

         ReDim place(9) As String
         ' untuk nilai count=count+1, Angkanya dibagi atas 3 digit
         place(2) = "RIBU "
         place(3) = "JUTA "
         place(4) = "MILYAR "
         place(5) = "TRILYUN "

         ' ubah jadi string , dan hilangkan spasi.
       
       
         Angkanya = Trim(Str(Angkanya))

         ' cari sen.
         DecimalPlace = InStr(Angkanya, ".")

         ' bila ketemu sen...
         If DecimalPlace > 0 Then
            ' ubah ke sen
            temp = left(Mid(Angkanya, DecimalPlace + 1) & "00", 2)
            Sennya = ConvertPuluhan(temp)

            ' buang sen dari Angkanya.
            Angkanya = Trim(left(Angkanya, DecimalPlace - 1))
         End If

         Count = 1
         ' ini yang repot, soalnya seribu bukannya satu ribu
         Do While Angkanya <> ""
            ' jadi pakai if dengan count=2 dan angkanya=1 saja
            ' tapi bila angkanya diatas 999 trilyun harus tambah lagi if
            ' untuk count = 7
            If Right(Angkanya, 3) = 1 And Count = 2 Then
                temp = "SE"
            Else
            ' Ubah setiap 3 digit ke terbilang di Indonesia
                temp = ConvertRatusan(Right(Angkanya, 3))
            End If
           
            ' ini dia hasilnya.....
            If temp <> "" Then Rupiahnya = temp & place(Count) & Rupiahnya
         
            If Len(Angkanya) > 3 Then
               ' buang 3 angka terakhir dari Angkanya dan count boleh tambah.
               Angkanya = left(Angkanya, Len(Angkanya) - 3)
            Else
               Angkanya = ""
            End If
           
            Count = Count + 1
         Loop

         ' kosongkan nilai rupiahnya.
         Select Case Rupiahnya
            Case ""
               Rupiahnya = "NIL RUPIAH "
            Case "One"
               Rupiahnya = "SATU RUPIAH"
            Case Else
               Rupiahnya = Rupiahnya & " RUPIAH"
         End Select

         ' kosongkan nilai sennya.
         Select Case Sennya
            Case ""
               Sennya = " "
            Case "One"
               Sennya = "SATU SEN"
            Case Else
               Sennya = " DAN " & Sennya & " SEN"
         End Select

         ConvertCurrencyToIndonesia = Rupiahnya & Sennya
End Function


Private Function ConvertSatuan(ByVal Satuannya)
        Select Case Val(Satuannya)
            Case 1: ConvertSatuan = "SATU "
            Case 2: ConvertSatuan = "DUA "
            Case 3: ConvertSatuan = "TIGA "
            Case 4: ConvertSatuan = "EMPAT "
            Case 5: ConvertSatuan = "LIMA "
            Case 6: ConvertSatuan = "ENAM "
            Case 7: ConvertSatuan = "TUJUH "
            Case 8: ConvertSatuan = "DELAPAN "
            Case 9: ConvertSatuan = "SEMBILAN "
            Case Else: ConvertSatuan = ""
         End Select
       
End Function

Private Function ConvertRatusan(ByVal Angkanya)
    Dim Result As String

         ' Exit if there is nothing to convert.
         If Val(Angkanya) = 0 Then Exit Function

         ' Append leading zeros to number.
         Angkanya = Right("000" & Angkanya, 3)

         ' Do we have a hundreds place digit to convert?
         If left(Angkanya, 1) <> "0" Then
            Result = ConvertSeratus(left(Angkanya, 1)) & "RATUS" & Chr$(32)
         End If

         ' Do we have a tens place digit to convert?
         If Mid(Angkanya, 2, 1) <> "0" Then
            Result = Result & ConvertPuluhan(Mid(Angkanya, 2))
         Else
            ' If not, then convert the ones place digit.
            Result = Result & ConvertSatuan(Mid(Angkanya, 3))
         End If

         ConvertRatusan = Result
End Function


Private Function ConvertPuluhan(ByVal Puluhannya)
          Dim Result As String

         ' untuk bilangan sebelas,, kalau english itu juga ada dua
         ' eleventh dan twelve
         If Val(left(Puluhannya, 1)) = 1 Then
            Select Case Val(Puluhannya)
               Case 10: Result = "SEPULUH "
               Case 11: Result = "SEBELAS "
               Case 12: Result = "DUA BELAS "
               Case 13: Result = "TIGA BELAS "
               Case 14: Result = "EMPAT BELAS "
               Case 15: Result = "LIMA BELAS "
               Case 16: Result = "ENAM BELAS "
               Case 17: Result = "TUJUH BELAS "
               Case 18: Result = "DELAPAN BELAS "
               Case 19: Result = "SEMBILAN BELAS "
               Case Else
            End Select
         Else
            ' .. juga untuk sisanya.
            Select Case Val(left(Puluhannya, 1))
               Case 2: Result = "DUA PULUH "
               Case 3: Result = "TIGA PULUH "
               Case 4: Result = "EMPAT PULUH "
               Case 5: Result = "LIMA PULUH "
               Case 6: Result = "ENAM PULUH "
               Case 7: Result = "TUJUH PULUH "
               Case 8: Result = "DELAPAN PULUH "
               Case 9: Result = "SEMBILAN PULUH "
               Case Else
            End Select

            ' tambahkan dengan satuannya.
            Result = Result & ConvertSatuan(Right(Puluhannya, 1))
         End If

         ConvertPuluhan = Result
End Function

Private Function ConvertSeratus(ByVal Ratusannya)
        ' ini untuk ratusan dimana satu ratus diganti seratus
        Select Case Val(Ratusannya)
            Case 1: ConvertSeratus = "SE"
            Case 2: ConvertSeratus = "DUA "
            Case 3: ConvertSeratus = "TIGA "
            Case 4: ConvertSeratus = "EMPAT "
            Case 5: ConvertSeratus = "LIMA "
            Case 6: ConvertSeratus = "ENAM "
            Case 7: ConvertSeratus = "TUJUH "
            Case 8: ConvertSeratus = "DELAPAN "
            Case 9: ConvertSeratus = "SEMBILAN "
            Case Else: ConvertSeratus = ""
         End Select
       
End Function




---------------------


Option Compare Database
Option Explicit

Function ConvertCurrencyToEnglish(ByVal MyNumber)
  Dim Temp
         Dim dollars, Cents
         Dim DecimalPlace, Count

         ReDim place(9) As String
         place(2) = " Thousand "
         place(3) = " Million "
         place(4) = " Billion "
         place(5) = " Trillion "

         ' Convert MyNumber to a string, trimming extra spaces.
         MyNumber = Trim(Str(MyNumber))

         ' Find decimal place.
         DecimalPlace = InStr(MyNumber, ".")

         ' If we find decimal place...
         If DecimalPlace > 0 Then
            ' Convert cents
            Temp = left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
            Cents = ConvertTens(Temp)

            ' Strip off cents from remainder to convert.
            MyNumber = Trim(left(MyNumber, DecimalPlace - 1))
         End If

         Count = 1
         Do While MyNumber <> ""
            ' Convert last 3 digits of MyNumber to English dollars.
            Temp = ConvertHundreds(Right(MyNumber, 3))
            If Temp <> "" Then dollars = Temp & place(Count) & dollars
            If Len(MyNumber) > 3 Then
               ' Remove last 3 converted digits from MyNumber.
               MyNumber = left(MyNumber, Len(MyNumber) - 3)
            Else
               MyNumber = ""
            End If
            Count = Count + 1
         Loop

         ' Clean up dollars.
         Select Case dollars
            Case ""
               dollars = "No"
            Case "One"
               dollars = "One"
         End Select

         ' Clean up cents.
         Select Case Cents
            Case ""
               Cents = " And No Cents"
            Case "One"
               Cents = " And One Cent"
            Case Else
               Cents = " And " & Cents & " Cents"
         End Select

         ConvertCurrencyToEnglish = dollars & Cents
End Function


Private Function ConvertDigit(ByVal MyDigit)
        Select Case Val(MyDigit)
            Case 1: ConvertDigit = "One"
            Case 2: ConvertDigit = "Two"
            Case 3: ConvertDigit = "Three"
            Case 4: ConvertDigit = "Four"
            Case 5: ConvertDigit = "Five"
            Case 6: ConvertDigit = "Six"
            Case 7: ConvertDigit = "Seven"
            Case 8: ConvertDigit = "Eight"
            Case 9: ConvertDigit = "Nine"
            Case Else: ConvertDigit = ""
         End Select
       
End Function

Private Function ConvertHundreds(ByVal MyNumber)
    Dim Result As String

         ' Exit if there is nothing to convert.
         If Val(MyNumber) = 0 Then Exit Function

         ' Append leading zeros to number.
         MyNumber = Right("000" & MyNumber, 3)

         ' Do we have a hundreds place digit to convert?
         If left(MyNumber, 1) <> "0" Then
            Result = ConvertDigit(left(MyNumber, 1)) & " Hundred "
         End If

         ' Do we have a tens place digit to convert?
         If Mid(MyNumber, 2, 1) <> "0" Then
            Result = Result & ConvertTens(Mid(MyNumber, 2))
         Else
            ' If not, then convert the ones place digit.
            Result = Result & ConvertDigit(Mid(MyNumber, 3))
         End If

         ConvertHundreds = Trim(Result)
End Function


Private Function ConvertTens(ByVal MyTens)
          Dim Result As String

         ' Is value between 10 and 19?
         If Val(left(MyTens, 1)) = 1 Then
            Select Case Val(MyTens)
               Case 10: Result = "Ten"
               Case 11: Result = "Eleven"
               Case 12: Result = "Twelve"
               Case 13: Result = "Thirteen"
               Case 14: Result = "Fourteen"
               Case 15: Result = "Fifteen"
               Case 16: Result = "Sixteen"
               Case 17: Result = "Seventeen"
               Case 18: Result = "Eighteen"
               Case 19: Result = "Nineteen"
               Case Else
            End Select
         Else
            ' .. otherwise it's between 20 and 99.
            Select Case Val(left(MyTens, 1))
               Case 2: Result = "Twenty "
               Case 3: Result = "Thirty "
               Case 4: Result = "Forty "
               Case 5: Result = "Fifty "
               Case 6: Result = "Sixty "
               Case 7: Result = "Seventy "
               Case 8: Result = "Eighty "
               Case 9: Result = "Ninety "
               Case Else
            End Select

            ' Convert ones place digit.
            Result = Result & ConvertDigit(Right(MyTens, 1))
         End If

         ConvertTens = Result
End Function


---------------------
selesai

Sekedar memindahkan catatan dari yahoo groups ke blog saya

Wassalam,
budi

QCY Q26 Mono In-ear Bluetooth with mic

saya punya QCY QY8 dah saya berikan ke anak, pengen punya yg mono aja, jadi bisa dengar sekitar kita. pilihan jatuh ke QCY Q26 setelah baca...