Loading halaman Tutorial Visual Basic, Delphi, PHP - Calon Programer : Membuat angka terbilang di visual basic ...

Membuat fasilitas angka terbilang di visual basic 6.0???kenapa enggak…?? Open-mouthed smile
Angka terbilang disini yang dimaksud seperti yang biasa dituliskan jika kita menuliskan kuitansi,ataupun lainnya. Dimana selain ada cetakan dalam bentuk angka, ada pula yg bertuliskan jumlah dengan huruf.
Contohnya jika ditulis angka 1, maka akan otomatis di konfersi menjadi ‘satu’…
Source code dapat anda download di akhir artikel.
Silahkan ikuti langkahnya jika kalian ingin mempelajari tentang pembuatan angka tebilang ini.

Design form :
image
Komponen yg digunakan adalah 2 buah Textbox

Kemudian ketik kan listing berikut:

  1. Public Function TerbilangDesimal(InputCurrency As String, Optional 
  2. MataUang As String = "rupiah") As String 
  3. Dim strInput As String 
  4. Dim strBilangan As String 
  5. Dim strPecahan As String 
  6. On Error GoTo Pesan 
  7. Dim strValid As String, huruf As String * 1 
  8. Dim i As Integer 
  9. 'Periksa setiap karakter yg diketikkan ke kotak 
  10. 'UserID 
  11. strValid = "1234567890," 
  12. For i% = 1 To Len(InputCurrency) 
  13. huruf = Chr(Asc(Mid(InputCurrency, i%, 1))) 
  14. If InStr(strValid, huruf) = 0 Then 
  15. Set AngkaTerbilang = Nothing 
  16. MsgBox "Harus karakter angka!", _ 
  17. vbCritical, "Karakter Tidak Valid" 
  18. Exit Function 
  19. End If 
  20. Next i% 
  21. If InputCurrency = "" Then Exit Function 
  22. If Len(Trim(InputCurrency)) > 15 Then GoTo Pesan 
  23. strInput = CStr(InputCurrency) 'Konversi ke string 
  24. 'Periksa apakah ada tanda "," jika ya berarti pecahan 
  25. If InStr(1, strInput, ",", vbBinaryCompare) Then 
  26. strBilangan = Left(strInput, InStr(1, strInput, _ 
  27. ",", vbBinaryCompare) - 1) 
  28. 'strBilangan = Right(strInput, InStr(1, strInput, _ 
  29. ' ".", vbBinaryCompare) - 2) 
  30. strPecahan = Trim(Right(strInput, Len(strInput) - Len(strBilangan) - 
  31. 1)) 
  32. If MataUang <> "" Then 
  33. If CLng(Trim(strPecahan)) > 99 Then 
  34. strInput = Format(Round(CDbl(strInput), 2), "#0.00"
  35. strPecahan = Format((Right(strInput, Len(strInput) - 
  36. Len(strBilangan) - 1)), "00"
  37. End If 
  38. If Len(Trim(strPecahan)) = 1 Then 
  39. strInput = Format(Round(CDbl(strInput), 2), _ 
  40. "#0.00"
  41. strPecahan = Format((Right(strInput, _ 
  42. Len(strInput) - Len(strBilangan) - 1)), "00"
  43. End If 
  44. If CLng(Trim(strPecahan)) = 0 Then 
  45. TerbilangDesimal = (KonversiBilangan(strBilangan) & MataUang & " " 
  46. & KonversiBilangan(strPecahan)) 
  47. Else 
  48. TerbilangDesimal = (KonversiBilangan(strBilangan) & MataUang & " "
  49. KonversiBilangan(strPecahan) & "sen"
  50. End If 
  51. Else 
  52. TerbilangDesimal = (KonversiBilangan(strBilangan) & "koma "
  53. KonversiPecahan(strPecahan)) 
  54. End If 
  55. Else 
  56. TerbilangDesimal = (KonversiBilangan(strInput)) 
  57. End If 
  58. Exit Function 
  59. Pesan: 
  60. TerbilangDesimal = "(maksimal 15 digit)" 
  61. End Function 
  62. 'Fungsi ini untuk mengkonversi nilai pecahan (setelah 'angka 0) 
  63. Private Function KonversiPecahan(strAngka As String) As String 
  64. Dim i%, strJmlHuruf$, Urai$, Kar$ 
  65. If strAngka = "" Then Exit Function 
  66. strJmlHuruf = Trim(strAngka) 
  67. Urai = "" 
  68. Kar = "" 
  69. For i = 1 To Len(strJmlHuruf) 
  70. 'Tampung setiap satu karakter ke Kar 
  71. Kar = Mid(strAngka, i, 1) 
  72. Urai = Urai & Kata(CInt(Kar)) 
  73. Next
  74. KonversiPecahan = Urai 
  75. End Function 
  76. 'Fungsi ini untuk menterjemahkan setiap satu angka ke 'kata 
  77. Private Function Kata(angka As Byte) As String 
  78. Select Case angka 
  79. Case 1: Kata = "satu " 
  80. Case 2: Kata = "dua " 
  81. Case 3: Kata = "tiga " 
  82. Case 4: Kata = "empat " 
  83. Case 5: Kata = "lima " 
  84. Case 6: Kata = "enam " 
  85. Case 7: Kata = "tujuh " 
  86. Case 8: Kata = "delapan " 
  87. Case 9: Kata = "sembilan " 
  88. Case 0: Kata = "nol " 
  89. End Select 
  90. End Function 
  91. 'Ini untuk mengkonversi nilai bilangan sebelum pecahan 
  92. Private Function KonversiBilangan(strAngka As String) As String 
  93. Dim strJmlHuruf$, intPecahan As Integer, strPecahan$, Urai$, Bil1$, 
  94. strTot$, Bil2$ 
  95. Dim X, Y, z As Integer 
  96. If strAngka = "" Then Exit Function 
  97. strJmlHuruf = Trim(strAngka) 
  98. X = 0 
  99. Y = 0 
  100. Urai = "" 
  101. While (X < Len(strJmlHuruf)) 
  102. X = X + 1 
  103. strTot = Mid(strJmlHuruf, X, 1) 
  104. Y = Y + Val(strTot) 
  105. z = Len(strJmlHuruf) - X + 1 
  106. Select Case Val(strTot) 
  107. 'Case 0 
  108. ' Bil1 = "NOL " 
  109. Case
  110. If (z = 1 Or z = 7 Or z = 10 Or z = 13) Then 
  111. Bil1 = "satu " 
  112. ElseIf (z = 4) Then 
  113. If (X = 1) Then 
  114. Bil1 = "se" 
  115. Else 
  116. Bil1 = "satu " 
  117. End If 
  118. ElseIf (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then 
  119. X = X + 1 
  120. strTot = Mid(strJmlHuruf, X, 1) 
  121. z = Len(strJmlHuruf) - X + 1 
  122. Bil2 = "" 
  123. Select Case Val(strTot) 
  124. Case
  125. Bil1 = "sepuluh " 
  126. Case
  127. Bil1 = "sebelas " 
  128. Case
  129. Bil1 = "dua belas " 
  130. Case
  131. Bil1 = "tiga belas " 
  132. Case
  133. Bil1 = "empat belas " 
  134. Case
  135. Bil1 = "lima belas " 
  136. Case
  137. Bil1 = "enam belas " 
  138. Case
  139. Bil1 = "tujuh belas " 
  140. Case
  141. Bil1 = "delapan belas " 
  142. Case
  143. Bil1 = "sembilan belas " 
  144. End Select 
  145. Else 
  146. Bil1 = "se" 
  147. End If 
  148. Case
  149. Bil1 = "dua " 
  150. Case
  151. Bil1 = "tiga " 
  152. Case
  153. Bil1 = "empat " 
  154. Case
  155. Bil1 = "lima " 
  156. Case
  157. Bil1 = "enam " 
  158. Case
  159. Bil1 = "tujuh " 
  160. Case
  161. Bil1 = "delapan " 
  162. Case
  163. Bil1 = "sembilan " 
  164. Case Else 
  165. Bil1 = "" 
  166. End Select 
  167. If (Val(strTot) > 0) Then 
  168. If (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then 
  169. Bil2 = "puluh " 
  170. ElseIf (z = 3 Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then 
  171. Bil2 = "ratus " 
  172. Else 
  173. Bil2 = "" 
  174. End If 
  175. Else 
  176. Bil2 = "" 
  177. End If 
  178. If (Y > 0) Then 
  179. Select Case
  180. Case
  181. Bil2 = Bil2 + "ribu " 
  182. Y = 0 
  183. Case
  184. Bil2 = Bil2 + "juta " 
  185. Y = 0 
  186. Case 10 
  187. Bil2 = Bil2 + "milyar " 
  188. Y = 0 
  189. Case 13 
  190. Bil2 = Bil2 + "trilyun " 
  191. Y = 0 
  192. End Select 
  193. End If 
  194. Urai = Urai + Bil1 + Bil2 
  195. Wend 
  196. KonversiBilangan = Urai 
  197. End Function 
  198. Private Sub Text1_Change() 'Isi besar uang diulangi 'dengan terbilang 
  199. huruf... 
  200. Text2.Text = TerbilangDesimal(Text1.Text) 
  201. End Sub 




atau


atau


Klik Like/share jika anda menyukai tulisan Share to FB

5 Reply :

  1. Mas bro...ane mau nanya..klw kita ingin buat tanggal (seperti form identitas) dgn pilihan dropdown (combo box) itu gmn yha??
    bisa minta program listing nya ga?? ane masi newbe, bru2 belajar otodidak.

    BalasHapus
    Balasan
    1. maksudnya gimana mas??combo box tgl bulan tahun gitu yah?????

      Hapus
  2. om mohon bantuanya, saya mau nanya lagi saya bingung banget sama tugas saya yang ini.

    jadi kita di suruh menentukan tanggal berapa data kita harus selesai, misalnya yah
    aplikasi terdiri dari 1dtpicker, 1label dan 1 textbox
    jadi jika kita menginputkan tanggal 8/januari pada dt picker dan
    4 pada textbox maka label menjadi 11/januari
    5 pada textbox maka label menjadi 14/januari

    jadi sabtu dan minggu tidak boleh tercantum atau ikut terhitung. dan tanggal selesai itu tidak mungkin dimulai dari hari sabtu/minggu dan tidak mungkin juga selesai pada hari sabtu/minggu. mohon om bantuanya. saya butuh banget :((

    BalasHapus
  3. mas broo,,ada yg versi vb.net nya ggk???

    BalasHapus

Jika ada pertanyaan atau request,Komentar pada tab blogger akan lebih memudahkan saya untuk membalasnya karena lebih mudah melakukan pengecekan komentar.