Pendahuluan
Program ini berfungsi untuk menerjemahkan nominal uang dalam bentuk numerik
(angka) menjadi nominal uang dalam bentuk kalimat dan kalimat tersebut dapat
dibacakan oleh program dalam bentuk suara.
Contoh :
Numerik : Rp 1.234.567
Kalimat : Satu Juta Dua Ratus Tiga Puluh Empat Ribu Lima Ratus Enam Puluh Tujuh Rupiah.
Code ini juga bisa dikembangkan untuk aplikasi lain misalnya games, aplikasi bantu untuk orang dengan keterbatasan penglihatan, dll
Flow Chart
Mendisain Form
Buka aplikasi Visual Basic, pilih Standar Program
Tambahkan ke dalam Form : Label, 2 Textbox dan 2 Command button
Ubah properti Form :
- Caption : Baca Uang
- Border Style : Fixed Dialog, agar hanya muncul tombol close (tanda silang di sudut kanan atas).
- Startup Position : CenterScreen, agar posisi program waktu mulai dipanggil muncul pada tengah layar.
Ubah properti :
Caption, pada Label1 menjadi : Rp
Text, pada Text1 menjadi : (kosong)
Caption, pada Command1 menjadi : Terjemahkan
Caption, pada Command2 menjadi : Bacakan
Ubah properti Textbox ke 2 (Text2) :
- Text : (dikosongkan)
- Locked : True, agar tidak dapat diedit
Code Program
Pertama kita deklarasikan variabel yang dibutuhkan
- satuan(1 To 9) : Array berisi konstanta kata "Satu" "Dua" ... "Sembilan"
- besar(1 To 10) : Array berisi konstanta kata "Sepuluh" "Puluh" "Sebelas" "Belas" ... "Milyar"
- trans(1 To 12) : Array berisi kumpulan hasil terjemahan angka kedalam kata
- tiga_digit(1 To 4) : Array untuk mengelompokkan hasil setiap 3 digit (xxx.xxx.xxx.xxx)
- Posisi(1 To 12) : Array berisi informasi posisi angka dalam urutan digit angka
- digit : membatasi maximal digit yang mampu diterjemahkan (12 digit = (999.999.999.999)
- pathfile : lokasi direktori file suara (misal : 01-Satu.wav)
- MataUang : jenis mata uang yang digunakan = "Rupiah"
- Space, noSpace : karakter 'spasi' dan tanpa karakter, untuk memberikan jarak antar kata
- hasil_terjemahan : hasil akhir terjemahan dari nominal uang
- str_uang : merubah variabel numerik angka menjadi string.
- uang : variable numerik uang dengan tipe data 'currency', agar mampu hingga angka Milyar
'deklarasi variabel
Dim satuan(1 To 9), besar(1 To 10), trans(1 To 12), tiga_digit(1 To 4)_
As String
Dim posisi(1 To 12), digit As Byte
Dim pathfile, MataUang, Space, noSpace, hasil_terjemahan, str_uang_
As String
Dim uang As Currency
Karena input data harus dalam bentuk numerik (angka), maka perlu dilakukan filter untuk mengatasi salah input. ini dilakukan pada event ketika keyboard mulai ditekan pada Textbox Text1 (Text1_KeyPress) dan pada event ketika keyboard dilepas pada Textbox Text1 (Text1_KeyUp). Apabila terjadi kesalahan input maka akan muncul message box
- "maximum number 12 digit" , digit angka melebihi 12
- "please enter number" , karakter bukan angka ditekan
- "please enter non decimal phrase" , karakter titik "." dan koma "," ditekan
- "wrong start number" , angka nol dimasukkan pada awal angka
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim pesan As Boolean
Dim counter As Byte
'verifikasi jumlah digit dan tombol keyboard yang boleh digunakan
counter = Len(Text1.Text)
If counter >= 12 Then 'hanya berlaku untuk 12 digit
If KeyAscii = 46 Then 'tombol titik "."
pesan = MsgBox("please enter non decimal phrase",_
vbExclamation, "error")
SendKeys "{BACKSPACE}"
End If
Select Case KeyAscii
Case 48 To 57 'tombol angka
Case 37 'tombol left
Case 39 'tombol right
Case 46 'tombol delete
Case 8 'tombol backspace
Case 13: Command1.SetFocus 'tombol enter
Case Else: 'tombol lainnya tidak diperkenankan
pesan = MsgBox("please enter number",_
vbExclamation,"error")
SendKeys "{BACKSPACE}"
End Select
End If
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
Dim pesan As Boolean
Dim counter As Byte
'verifikasi jumlah digit dan angka "0" diawal
counter = Len(Text1.Text)
If counter > 12 Then 'lebih dari 12 digit
pesan = MsgBox("maximum number 12 digit", vbExclamation, "error")
SendKeys "{BACKSPACE}"
End If
If (Val(Left$(Text1.Text, 1)) = 0 And KeyCode = 48) Then 'tombol 0 di awal
pesan = MsgBox("wrong start number", vbExclamation, "error")
SendKeys "{BACKSPACE}"
End If
End Sub
Kemudian bila button 'Terjemahkan' ditekan, maka akan dieksekusi Subrutin khusus, Private Sub Terjemahkan(), yang merupakan Subrutin inti dari program ini.
Private Sub Command1_Click()
'dijalankan hanya jika input tidak kosong
If Text1.Text <> "" Then Call Terjemahkan
End Sub
'subrutin khusus untuk menterjemahkan
Private Sub Terjemahkan()
Dim i, k As Byte
'daftar terjemahan
satuan(1) = "Satu"
satuan(2) = "Dua"
satuan(3) = "Tiga"
satuan(4) = "Empat"
satuan(5) = "Lima"
satuan(6) = "Enam"
satuan(7) = "Tujuh"
satuan(8) = "Delapan"
satuan(9) = "Sembilan"
besar(1) = "Milyar"
besar(2) = "Juta"
besar(3) = "Ribu"
besar(4) = "Seribu"
besar(5) = "Ratus"
besar(6) = "Seratus"
besar(7) = "Puluh"
besar(8) = "Sepuluh"
besar(9) = "Belas"
besar(10) = "Sebelas"
Space = " "
noSpace = vbNullString
MataUang = "Rupiah"
'membaca input
uang = CCur(Text1.Text)
'verifikasi data
str_uang = CStr(uang)
'hanya sampai 12 digit (999.999.999.999)
If Len(str_uang) >= 12 Then digit = 12
Else digit = Len(str_uang)
End If
'set ke posisi 0 / kosong
For i = 1 To 12
trans(i) = noSpace
posisi(i) = 0
Next i
For i = 1 To 4
tiga_digit(i) = noSpace
Next i
hasil_terjemahan = noSpace
'mengisi digit ke posisi 1,2,3,...
k = 1
For i = digit To 1 Step -1
posisi(k) = Mid$(str_uang, i, 1)
k = k + 1
Next i
'satuan
Select Case posisi(1)
Case 0: trans(1) = noSpace
Case 1 To 9: trans(1) = satuan(posisi(1))
End Select
'puluhan
Select Case posisi(2)
Case 0: trans(2) = noSpace
Case 1:
Select Case posisi(1)
Case 0: trans(2) = besar(8) '10
Case 1: '11
trans(2) = besar(10)
trans(1) = noSpace
Case 2 To 9: '12-19
trans(2) = satuan(posisi(1)) + Space_
+ besar(9)
trans(1) = noSpace
End Select
Case 2 To 9: trans(2) = satuan(posisi(2)) + Space + besar(7)
'20-90
End Select
'ratusan
Select Case posisi(3)
Case 0: trans(3) = noSpace
Case 1: trans(3) = besar(6) '100
Case 2 To 9: trans(3) = satuan(posisi(3)) + Space + besar(5)
'200-900
End Select
'baca 3digit ke-1
tiga_digit(1) = Trim$(trans(3) + Space + trans(2) + Space + trans(1))
'ribuan
Select Case posisi(4)
Case 0: trans(4) = noSpace
Case 1 To 9: trans(4) = satuan(posisi(4)) '2.000-9.000
End Select
'puluh ribu
Select Case posisi(5)
Case 0: trans(5) = noSpace
Case 1:
Select Case posisi(4)
Case 0: trans(5) = besar(8) '10.000
Case 1: '11.000
trans(5) = besar(10)
trans(4) = noSpace
Case 2 To 9: '12.000 - 19.000
trans(5) = satuan(posisi(4)) + Space_
+ besar(9)
trans(4) = noSpace
End Select
Case 2 To 9: trans(5) = satuan(posisi(5)) + Space + besar(7)
'20.000-90.000
End Select
'ratus ribu
Select Case posisi(6)
Case 0: trans(6) = noSpace
Case 1: trans(6) = besar(6) '100.000
Case 2 To 9: trans(6) = satuan(posisi(6)) + Space + besar(5)
'200rb-900rb
End Select
'baca 3digit ke-2
tiga_digit(2) = Trim$(trans(6) + Space + trans(5) + Space + trans(4))
'juta
Select Case posisi(7)
Case 0: trans(7) = noSpace
Case 1 To 9: trans(7) = satuan(posisi(7)) '1jt - 9jt
End Select
'puluh juta
Select Case posisi(8)
Case 0: trans(8) = noSpace
Case 1:
Select Case posisi(7)
Case 0: trans(8) = besar(8) '10jt
Case 1: '11jt
trans(8) = besar(10)
trans(7) = noSpace
Case 2 To 9: '12jt-19jt
trans(8) = satuan(posisi(7)) + Space_
+ besar(9)
trans(7) = noSpace
End Select
Case 2 To 9: trans(8) = satuan(posisi(8)) + Space + besar(7)
'20jt-90jt
End Select
'ratus juta
Select Case posisi(9)
Case 0: trans(9) = noSpace
Case 1: trans(9) = besar(6) '100jt
Case 2 To 9: trans(9) = satuan(posisi(9)) + Space + besar(5)
'200jt-900jt
End Select
'baca 3digit ke-3
tiga_digit(3) = Trim$(trans(9) + Space + trans(8) + Space + trans(7))
'milyar
Select Case posisi(10)
Case 0: trans(10) = noSpace
Case 1 To 9: trans(10) = satuan(posisi(10)) 'milyar
End Select
'puluh milyar
Select Case posisi(11)
Case 0: trans(11) = noSpace
Case 1:
Select Case posisi(10)
Case 0: trans(11) = besar(8) '10 milyar
Case 1: '11 milyar
trans(11) = besar(10)
trans(10) = noSpace
Case 2 To 9 '12-19 milyar
trans(11) = satuan(posisi(11)) + Space_
+ besar(9)
trans(10) = noSpace
End Select
Case 2 To 9: trans(11) = satuan(posisi(11)) + Space + besar(7)
'20-90 milyar
End Select
'ratus milyar
Select Case posisi(12)
Case 0: trans(12) = noSpace
Case 1: trans(12) = besar(6) '100 milyar
Case 2 To 9: trans(12) = satuan(posisi(12)) + Space + besar(5)
'200-900 milyar
End Select
'baca 3digit ke-4
tiga_digit(4) = Trim$(trans(12) + Space + trans(11) + Space + trans(10))
'hasil terjemahan
Select Case digit
Case 1 To 3: hasil_terjemahan = tiga_digit(1)
Case 4 To 6:
Select Case posisi(4) 'kasus "seribu" bukan "satu ribu"
Case 1: hasil_terjemahan = besar(4) + Space_
+ tiga_digit(1)
Case Else: hasil_terjemahan = tiga_digit(2)_
+ Space + besar(3) + Space_
+ tiga_digit(1)
End Select
Case 7 To 9: hasil_terjemahan = tiga_digit(3) + Space + besar(2)_
+ Space + tiga_digit(2) + Space_
+ besar(3) + Space + tiga_digit(1)
Case 10 To 12: hasil_terjemahan = tiga_digit(4) + Space_
+ besar(1)+ Space + tiga_digit(3)_
+ Space + besar(2) + Space_
+ tiga_digit(2) + Space_
+ besar(3) + Space + tiga_digit(1)
End Select
'tambahkan mata uang
Text2.Text = hasil_terjemahan + Space + MataUang
'memformat uang
Text1.Text = Format(uang, "###,###,###,###")
End Sub
Karena setelah statement : Format(uang, "###,###,###,###"), input data telah mengandung karakter yang tidak diperbolehkan (titik "." dan koma ","), maka input dalam Textbox Text1 perlu diperbaiki ulang yang dilakukan pada event ketika Textbox kembali mendapat fokus Text1_GotFocus().
Private Sub Text1_GotFocus()
'memperbaiki input agar bisa dibaca benar
str_uang = Replace$(Text1.Text, ".", "")
str_uang = Replace$(str_uang, ",", "")
Text1.Text = str_uang
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Setelah diterjemahkan, apabila ingin dibacakan, maka button 'bacakan' dapat ditekan. Pada event ini akan dipanggil Subrutin khusus Private Sub baca() untuk membaca uang dengan suara.
Private Sub Command2_Click()
Call baca
End Sub
Pada Subrutin 'baca' dibawah ini, perhatikan! Subrutin ini memanggil Subrutin lain Sound() , yaitu Subrutin khusus untuk memanggil file suara untuk masing-masing kata.
'subroutin khusus untuk membaca hasil terjemahan dengan suara
Private Sub baca()
Dim tempStr As String
Dim tempArray As Variant
Dim i As Byte
'memisahkan tiap kata kedalam array
tempArray = Split(Text2.Text, " ")
'mengeluarkan suara
For i = 1 To (UBound(tempArray) - LBound(tempArray) + 1)
tempStr = CStr(tempArray(i - 1))
Call Sound(tempStr)
Next i
End Sub
'subrutin khusus untuk menterjemahkan tiap kata kedalam suara
Private Sub Sound(suara As String)
Dim Retval As Long
Dim key As Byte
'ubah kode string menjadi kode angka
suara = LCase$(suara)
If suara = "satu" Then key = 1
If suara = "dua" Then key = 2
If suara = "tiga" Then key = 3
If suara = "empat" Then key = 4
If suara = "lima" Then key = 5
If suara = "enam" Then key = 6
If suara = "tujuh" Then key = 7
If suara = "delapan" Then key = 8
If suara = "sembilan" Then key = 9
If suara = "sepuluh" Then key = 10
If suara = "sebelas" Then key = 11
If suara = "belas" Then key = 12
If suara = "puluh" Then key = 13
If suara = "seratus" Then key = 14
If suara = "ratus" Then key = 15
If suara = "seribu" Then key = 16
If suara = "ribu" Then key = 17
If suara = "juta" Then key = 18
If suara = "milyar" Then key = 19
If suara = "rupiah" Then key = 20
'pemilihan suara
Select Case key
Case 1: Retval = PlaySound(pathfile & "01-satu.wav", 0, &H0)
Case 2: Retval = PlaySound(pathfile & "02-dua.wav", 0, &H0)
Case 3: Retval = PlaySound(pathfile & "03-tiga.wav", 0, &H0)
Case 4: Retval = PlaySound(pathfile & "04-empat.wav", 0, &H0)
Case 5: Retval = PlaySound(pathfile & "05-lima.wav", 0, &H0)
Case 6: Retval = PlaySound(pathfile & "06-enam.wav", 0, &H0)
Case 7: Retval = PlaySound(pathfile & "07-tujuh.wav", 0, &H0)
Case 8: Retval = PlaySound(pathfile & "08-delapan.wav", 0, &H0)
Case 9: Retval = PlaySound(pathfile & "09-sembilan.wav", 0, &H0)
Case 10: Retval = PlaySound(pathfile & "10-sepuluh.wav", 0, &H0)
Case 11: Retval = PlaySound(pathfile & "11-sebelas.wav", 0, &H0)
Case 12: Retval = PlaySound(pathfile & "12-belas.wav", 0, &H0)
Case 13: Retval = PlaySound(pathfile & "13-puluh.wav", 0, &H0)
Case 14: Retval = PlaySound(pathfile & "14-seratus.wav", 0, &H0)
Case 15: Retval = PlaySound(pathfile & "15-ratus.wav", 0, &H0)
Case 16: Retval = PlaySound(pathfile & "16-seribu.wav", 0, &H0)
Case 17: Retval = PlaySound(pathfile & "17-ribu.wav", 0, &H0)
Case 18: Retval = PlaySound(pathfile & "18-juta.wav", 0, &H0)
Case 19: Retval = PlaySound(pathfile & "19-milyar.wav", 0, &H0)
Case 20: Retval = PlaySound(pathfile & "20-rupiah.wav", 0, &H0)
End Select
End Sub
Dalam Subrutin diatas, Perhatikan! dipanggil function Playsound, PlaySound (pathfile & "01-satu.wav", 0, &H0) function ini memanggil library windows, 'winmm.dll' yang dapat mentriger sistem untuk mengeluarkan suara. Function ini dapat dijalankan dengan syarat kita deklarasikan diawal
program.
'tambahan function untuk mengaktifkan fungsi suara (playsound)
Option Explicit Private Declare Function PlaySound Lib "winmm.dll" Alias_ "PlaySoundA" (ByVal lpszName As String, ByVal hModule_
As Long, ByVal dwFlags As Long) As Long
Hasil Program
Untuk mempelajarinya silakan download source-nya disini atau email ke sini
Ok Selamat mencoba!
(c)2009 by Yoga DC - Nurul Fikri Komputer
Tidak ada komentar:
Posting Komentar