Kali ini saya akan posting tentang mebuat aplikasi terbilang dengan VB6, jadi dengan aplikasi ini hanya memasukkan angka kemudian secara otomatis akan terbaca nilai dari bilangan tersebut misal dlam text kita memasukkan Nominal 1000 maka akan terbaca "Seribu Rupiah" dan seterusnya sesua dengan angka yang dimasukkan ke textbox. oke langsung saja ke pembuatan aplikasi,
- Buka program VB dan pilih form standard
- Masukkan satu label , satu textbox dan satu command button, seperti gambar berikut:
Lalu masukkan source code berikut ke module, oiya sebelumnya tambahkan dulu module kedalam project kita dengan cara brikut klik kanan pada project1 pilih ADD dan klik module seperti terlihat pada gambar:
kemudian secara otomatis akan terbuka jendela code dan masukkan source code berikut pada module:
Public Function TerbilangDesimal(InputCurrency As String, Optional MataUang As String = "rupiah") As String Dim strInput As String Dim strBilangan As String Dim strPecahan As String On Error GoTo Pesan Dim strValid As String, huruf As String * 1 Dim I As Integer 'Periksa setiap karakter yg diketikkan ke kotak 'UserID strValid = "1234567890," For I% = 1 To Len(InputCurrency) huruf = Chr(Asc(Mid(InputCurrency, I%, 1))) If InStr(strValid, huruf) = 0 Then Set AngkaTerbilang = Nothing MsgBox "Harus karakter angka!", _ vbCritical, "Karakter Tidak Valid" Exit Function End If Next I% If InputCurrency = "" Then Exit Function If Len(Trim(InputCurrency)) > 15 Then GoTo Pesan strInput = CStr(InputCurrency) 'Konversi ke string 'Periksa apakah ada tanda "," jika ya berarti pecahan If InStr(1, strInput, ",", vbBinaryCompare) Then strBilangan = Left(strInput, InStr(1, strInput, _ ",", vbBinaryCompare) - 1) ' strBilangan = Right(strInput, InStr(1, strInput, _ ".", vbBinaryCompare) - 2) strPecahan = Trim(Right(strInput, Len(strInput) - Len(strBilangan) - 1)) If MataUang <> "" Then If CLng(Trim(strPecahan)) > 99 Then strInput = Format(Round(CDbl(strInput), 2), "#0.00") strPecahan = Format((Right(strInput, Len(strInput) - Len(strBilangan) - 1)), "00") End If If Len(Trim(strPecahan)) = 1 Then strInput = Format(Round(CDbl(strInput), 2), _ "#0.00") strPecahan = Format((Right(strInput, _ Len(strInput) - Len(strBilangan) - 1)), "00") End If If CLng(Trim(strPecahan)) = 0 Then TerbilangDesimal = (KonversiBilangan(strBilangan) & MataUang & " " & KonversiBilangan(strPecahan)) Else TerbilangDesimal = (KonversiBilangan(strBilangan) & MataUang & " " & KonversiBilangan(strPecahan) & "sen") End If Else TerbilangDesimal = (KonversiBilangan(strBilangan) & "koma " & KonversiPecahan(strPecahan)) End If Else TerbilangDesimal = (KonversiBilangan(strInput)) End If Exit Function Pesan: TerbilangDesimal = "(maksimal 15 digit)" End Function 'Fungsi ini untuk mengkonversi nilai pecahan (setelah 'angka 0) Private Function KonversiPecahan(strAngka As String) As String Dim I%, strJmlHuruf$, Urai$, Kar$ If strAngka = "" Then Exit Function strJmlHuruf = Trim(strAngka) Urai = "" Kar = "" For I = 1 To Len(strJmlHuruf) 'Tampung setiap satu karakter ke Kar Kar = Mid(strAngka, I, 1) Urai = Urai & Kata(CInt(Kar)) Next I KonversiPecahan = Urai End Function 'Fungsi ini untuk menterjemahkan setiap satu angka ke 'kata Private Function Kata(angka As Byte) As String Select Case angka Case 1: Kata = "satu " Case 2: Kata = "dua " Case 3: Kata = "tiga " Case 4: Kata = "empat " Case 5: Kata = "lima " Case 6: Kata = "enam " Case 7: Kata = "tujuh " Case 8: Kata = "delapan " Case 9: Kata = "sembilan " Case 0: Kata = "nol " End Select End Function 'Ini untuk mengkonversi nilai bilangan sebelum pecahan Private Function KonversiBilangan(strAngka As String) As String Dim strJmlHuruf$, intPecahan As Integer, strPecahan$, Urai$, Bil1$, strTot$, Bil2$ Dim x, y, z As Integer If strAngka = "" Then Exit Function strJmlHuruf = Trim(strAngka) 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 0 'Bil1 = "NOL " 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 KonversiBilangan = Urai End Function
okey urusan dengan module sudah selesai sekarang kembali ke form double klik pada command1 lalu masukkan source code berikut:
Private Sub Command1_Click() On Error Resume Next Label1.Caption = TerbilangDesimal(Text1.Text) & "rupiah" End Sub
okey apliaksi translate angka ke terbilang sudah selesai... :f:
untuk menguji apliaksi yang sudah dibuat Run program lalu masukkan angka berapapun ke text dan klik proses, kalo program berjalan dengan benar maka tampilannya akan seperti berikut:
Demikian posting darisaya, semoga bermanfaat ..
salam sepuluh ribu jam untuk jadi Expert... ^_^ :c:
No comments :
Post a Comment