Postingan saya kali ini membahas tentang VB 6 untuk membuata fungsi terbilang. Pada sebuah aplikasi pasti ada cetak bukti transaksi dan terkadang pada bukti transaksi tersebut harus dicantumkan isian terbilang. Misalnya total 1.000.000 maka terbilangnya adalah Satu Juta. Sekarang mari kita bersama-sama membuat fungsi terbilang tersebut. Coding dari terbilang adalah sebagai berikut :
Public Function Terbilang(sNilai As String) As String
Dim iPanjang%: Dim iDigit%
Dim iAngka%: Dim iSisa%
Dim iLoop%: Dim iLoopSatuan%
Dim iBatas%
Dim sAngka(9) As String
Dim sDigit() As String
Dim sDigitKalimat() As String
Dim sSatuan(6) As String
Dim sKalimat$: Dim sTeksAngka$
Dim sTeksDigit$: Dim sNilaiPoint$
Dim sDigitPoint() As String
Dim sDigitKalimatPoint() As String
Dim sTeksAngkaPoint$
Dim sNol$: Dim iNol As Integer
Dim bSe As Boolean
sAngka(0) = ""
sAngka(1) = "satu "
sAngka(2) = "dua "
sAngka(3) = "tiga "
sAngka(4) = "empat "
sAngka(5) = "lima "
sAngka(6) = "enam "
sAngka(7) = "tujuh "
sAngka(8) = "delapan "
sAngka(9) = "sembilan "
sSatuan(1) = ""
sSatuan(2) = "ribu "
sSatuan(3) = "juta "
sSatuan(4) = "milyar "
sSatuan(5) = "trilyun "
sSatuan(6) = "bilyun "
If InStr(sNilai, ",") <> 0 Then
sNilaiPoint = Mid(sNilai, InStr(sNilai, ",") + 1)
sNilai = Left(sNilai, InStr(sNilai, ",") - 1)
ElseIf InStr(sNilai, ".") <> 0 Then
sNilaiPoint = Mid(sNilai, InStr(sNilai, ".") + 1)
sNilai = Left(sNilai, InStr(sNilai, ".") - 1)
End If
iLoop = 0
Do While iLoop < Len(sNilaiPoint) iLoop = iLoop + 1 Select Case Mid(sNilaiPoint, iLoop, 1) Case "0" sNol = "nol " & sNol iNol = iNol + 1 Case Else Exit Do End Select Loop If sNilaiPoint <> "" Then
sNilaiPoint = Mid(sNilaiPoint, iNol + 1)
End If
'Nilai di belakang koma
Select Case Len(sNilaiPoint)
Case Is > 0
iPanjang = Len(Trim(sNilaiPoint))
Select Case iPanjang Mod 3
Case 0
iDigit = iPanjang / 3
iSisa = 3
Case Else
iDigit = (iPanjang \ 3) + 1
iSisa = iPanjang Mod 3
End Select
ReDim sDigitPoint(iDigit)
ReDim sDigitKalimatPoint(iDigit)
iLoop = 0
While iLoop < iDigit iLoop = iLoop + 1 Select Case iLoop Case iDigit sDigitPoint(iLoop) = Right(sNilaiPoint, iSisa) Case Else sDigitPoint(iLoop) = Right(sNilaiPoint, 3) sNilaiPoint = Left(sNilaiPoint, Len(sNilaiPoint) - 3) End Select Wend sTeksAngka = "" For iLoop = 1 To iDigit sNilaiPoint = sDigitPoint(iLoop) Select Case iLoop Case iDigit iBatas = iSisa Case Else iBatas = 3 End Select sTeksAngka = sSatuan(iLoop) For iLoopSatuan = 1 To iBatas iAngka = Val(Right(sNilaiPoint, 1)) sNilaiPoint = Left(sNilaiPoint, iBatas - iLoopSatuan) Select Case iLoopSatuan Case 2 Select Case iAngka Case Is <> 0
Select Case iAngka
Case 1
bSe = True
If Val(Right(sDigitPoint(iLoop), 1)) = 0 Then
sTeksAngka = "sepuluh " & sSatuan(iLoop)
ElseIf Val(Right(sDigitPoint(iLoop), 1)) = 1 Then
sTeksAngka = "sebelas " & sSatuan(iLoop)
Else
sTeksAngka = sAngka(Val(Right(sDigitPoint(iLoop), 1))) & _
"belas " & sSatuan(iLoop)
End If
Case Else
bSe = False
sTeksAngka = "puluh " & sTeksAngka
End Select
End Select
Case 3
Select Case iAngka
Case Is <> 0
Select Case iAngka
Case 1
bSe = True
sTeksAngka = "seratus " & sTeksAngka
Case Else
sTeksAngka = "ratus " & sTeksAngka
End Select
End Select
End Select
Select Case bSe
Case True
bSe = False
Case Else
Select Case iLoop
Case 2
If Right(sDigitPoint(2), 1) = 1 And iLoopSatuan = 1 Then
If Len(sDigitPoint(2)) = 1 Then
sTeksAngka = "se" & sTeksAngka
ElseIf Val(Mid(sDigitPoint(2), Len(sDigitPoint(2)) - 1, 1)) = 0 Then
sTeksAngka = "se" & sTeksAngka
Else
sTeksAngka = sAngka(iAngka) & sTeksAngka
End If
Else
sTeksAngka = sAngka(iAngka) & sTeksAngka
End If
Case Else
sTeksAngka = sAngka(iAngka) & sTeksAngka
End Select
End Select
Next
sDigitKalimatPoint(iLoop) = sTeksAngka
sTeksAngka = ""
Next
For iLoop = 1 To iDigit
Select Case sDigitKalimatPoint(iLoop)
Case Is <> sSatuan(iLoop)
sTeksAngka = sDigitKalimatPoint(iLoop) + sTeksAngka
End Select
Next
Select Case sTeksAngka
Case "": sTeksAngka = "nol "
End Select
sTeksAngkaPoint = "koma " & sNol & sTeksAngka
End Select
iPanjang = Len(Trim(sNilai))
Select Case iPanjang Mod 3
Case 0
iDigit = iPanjang / 3
iSisa = 3
Case Else
iDigit = (iPanjang \ 3) + 1
iSisa = iPanjang Mod 3
End Select
ReDim sDigit(iDigit)
ReDim sDigitKalimat(iDigit)
iLoop = 0
While iLoop < iDigit iLoop = iLoop + 1 Select Case iLoop Case iDigit sDigit(iLoop) = Right(sNilai, iSisa) Case Else sDigit(iLoop) = Right(sNilai, 3) sNilai = Left(sNilai, Len(sNilai) - 3) End Select Wend sTeksAngka = "" For iLoop = 1 To iDigit sNilai = sDigit(iLoop) Select Case iLoop Case iDigit iBatas = iSisa Case Else iBatas = 3 End Select sTeksAngka = sSatuan(iLoop) For iLoopSatuan = 1 To iBatas iAngka = Val(Right(sNilai, 1)) sNilai = Left(sNilai, iBatas - iLoopSatuan) Select Case iLoopSatuan Case 2 Select Case iAngka Case Is <> 0
Select Case iAngka
Case 1
bSe = True
If Val(Right(sDigit(iLoop), 1)) = 0 Then
sTeksAngka = "sepuluh " & sSatuan(iLoop)
ElseIf Val(Right(sDigit(iLoop), 1)) = 1 Then
sTeksAngka = "sebelas " & sSatuan(iLoop)
Else
sTeksAngka = sAngka(Val(Right(sDigit(iLoop), 1))) & _
"belas " & sSatuan(iLoop)
End If
Case Else
bSe = False
sTeksAngka = "puluh " & sTeksAngka
End Select
End Select
Case 3
Select Case iAngka
Case Is <> 0
Select Case iAngka
Case 1
bSe = True
sTeksAngka = "seratus " & sTeksAngka
Case Else
sTeksAngka = "ratus " & sTeksAngka
End Select
End Select
End Select
Select Case bSe
Case True
bSe = False
Case Else
Select Case iLoop
Case 2
If Right(sDigit(2), 1) = 1 And iLoopSatuan = 1 Then
If Len(sDigit(2)) = 1 Then
sTeksAngka = "se" & sTeksAngka
ElseIf Val(Mid(sDigit(2), Len(sDigit(2)) - 1, 1)) = 0 Then
sTeksAngka = "satu " & sTeksAngka
Else
sTeksAngka = sAngka(iAngka) & sTeksAngka
End If
Else
sTeksAngka = sAngka(iAngka) & sTeksAngka
End If
Case Else
sTeksAngka = sAngka(iAngka) & sTeksAngka
End Select
End Select
Next
sDigitKalimat(iLoop) = sTeksAngka
sTeksAngka = ""
Next
For iLoop = 1 To iDigit
Select Case sDigitKalimat(iLoop)
Case Is <> sSatuan(iLoop): sTeksAngka = sDigitKalimat(iLoop) + sTeksAngka
End Select
Next
Select Case sTeksAngka
Case "": sTeksAngka = "nol "
End Select
Terbilang = StrConv(Trim(sTeksAngka + sTeksAngkaPoint), vbProperCase)
End Function
Cara menggunakan fungsi tersebut sangat mudah, kita tinggal menampung dari proses function diatas. Caranya adalah sebagai berikut :
TxtTerbilang.Text = Terbilang(str(txtAngka.text))
1 comments: on "Membuat Fungsi Terbilang pada VB 6"
wakakka,,inget2 jaman dlo pas ngoding uiy...
Posting Komentar