Fungsi Convert Angka Menjadi Terbilang

Berikut saya akan membagikan Source Code Membuat Fungsi/Convert Angka Menjadi Terbilang dengan menggunakan Visual Basic 6. Penerapannya adalah apabila di suatu perusahaan baik di bank, pertokoan atau instansi pemerintah pembuatan nota kwitansi setoran,penarikan atau pembayaran pasti disertai dengan terbilang agar lebih akurat pengesahan nilai atau nominal angka. Memang secara manual bisa kita ketik di Microsoft Excel atau aplikasi lainnya tapi membutuhkan waktu sedikit lama,
Berikut saya memberikan contoh mengubah angka menjadi terbilang dengan menggunakan Visual Basic.

1. Source code di form

Option Explicit
Private Sub cmdClose_Click()
    End
End Sub
Private Sub cmdTerbilang_Click()
    Dim obj As New clsTerbilang
    txtTerbilang.Text = obj.NumToText(txtNumber.Text)
End Sub
Private Sub txtNumber_KeyPress(KeyAscii As Integer)
    If ((KeyAscii < 48 And KeyAscii <> 8) Or KeyAscii > 57) Then
        KeyAscii = 0
    End If
End Sub

2. Sorce code class modul terbilang

Option Explicit
Dim Once(0 To 20) As String
Dim Tenths(9) As String
Dim Num As String
Dim n(9) As Integer
Dim i As Integer
Dim meValue As String
Private Sub Class_Initialize()
    Once(0) = ""
    Once(1) = " Satu"
    Once(2) = " Dua"
    Once(3) = " Tiga"
    Once(4) = " Empat"
    Once(5) = " Lima"
    Once(6) = " Enam"
    Once(7) = " Tujuh"
    Once(8) = " Delapan"
    Once(9) = " Sembilan"
    Once(10) = " Sepuluh"
    Once(11) = " Sebelas"
    Once(12) = " Dua Belas"
    Once(13) = " Tiga Belas"
    Once(14) = " Empat Belas"
    Once(15) = " Lima Belas"
    Once(16) = " Enam Belas"
    Once(17) = " Tujuh Belas"
    Once(18) = " Delapan Belas"
    Once(19) = " Sembilan Belas"
    Tenths(2) = " Dua Puluh"
    Tenths(3) = " Tiga Puluh"
    Tenths(4) = " Empat Puluh"
    Tenths(5) = " Lima Puluh"
    Tenths(6) = " Enam Puluh"
    Tenths(7) = " Tujuh Puluh"
    Tenths(8) = " Delapan Puluh"
    Tenths(9) = " Sembilan Puluh"
End Sub
Public Function NumToText(Num As String) As String
    meValue = ""
    Num = Format(Num, "000,000,000.00")
    n(1) = Mid(Num, 1, 1)
    n(2) = Mid(Num, 2, 1)
    n(3) = Mid(Num, 3, 1)
    n(4) = Mid(Num, 5, 1)
    n(5) = Mid(Num, 6, 1)
    n(6) = Mid(Num, 7, 1)
    n(7) = Mid(Num, 9, 1)
    n(8) = Mid(Num, 10, 1)
    n(9) = Mid(Num, 11, 1)
    '*** MILLIONS
    i = n(1) & n(2) & n(3)
    If i > 0 Then
        If n(1) > 0 Then
            meValue = Once(n(1)) & " Ratus"
        End If
        i = n(2) & n(3)
        If i >= 20 Then
            meValue = meValue & Tenths(n(2)) & Once(n(3)) & " Juta"
        Else
            meValue = meValue & Once(i) & " Juta"
        End If
    End If
    '*** THOUSANDS
    i = n(4) & n(5) & n(6)
    If i > 0 Then
        If n(4) > 0 Then
            meValue = meValue & Once(n(4)) & " Ratus"
        End If
        i = n(5) & n(6)
        If i >= 20 Then
            meValue = meValue & Tenths(n(5)) & Once(n(6)) & " Ribu"
        Else
            meValue = meValue & Once(i) & " Ribu"
        End If
    End If
    '*** HUNDREDS
    i = n(7) & n(8) & n(9)
    If i > 0 Then
        If n(7) > 0 Then
            meValue = meValue & Once(n(7)) & " Ratus"
        End If
        i = n(8) & n(9)
        If i >= 20 Then
            meValue = meValue & Tenths(n(8)) & Once(n(9))
        Else
            meValue = meValue & Once(i)
        End If
    End If
    meValue = Replace(meValue, "Satu Ribu", "Seribu")
    meValue = Replace(meValue, "Satu Ratus", "Seratus")
    meValue = Trim(meValue)
    NumToText = meValue
End Function

Demikian souce code semoga bisa bermanfaat dan membantu rekan-rekan dalam pekerjaan.
Download disini

Read more »

Membuat Gradient VB

Pengertian gradient dalam kamus terjemahan adalah tinggi/curam tanjakan, lereng. Kalau kita implementasikan arti kata tersebut dalam pemograman adalah membuat suati garis dari kordinat x sampai y.
Contoh penerapan yaitu seperti gambar di samping ini membuat warna tampilan Form dan PictureBox. Sebagai latihan buat satu project dan tempatkan 2 buah komponen PictureBox, 1 buah kompunen timer dan 3 buah komponen label. dan masukan source kode di bawah ini.

Berikut contoh source code Membuat Gradien:

Option Explicit
Dim Red, Green, Blue, sred, ered, sgreen, sblue, egreen, eblue, difr, difg, difb, fora
Public Enum enumOrientation
    Orientation_Horizontal = 0
    Orientation_Vertical = 1
End Enum

Public Function Gradient(Frm As Object, Orientation As enumOrientation, SClr As ColorConstants, EClr As ColorConstants)
    Dim Yi
    Frm.AutoRedraw = True: Frm.ScaleMode = 3 '2 is interesting,too
    Analyze (SClr): sred = Red: sgreen = Green: sblue = Blue
    Analyze (EClr): ered = Red: egreen = Green: eblue = Blue
    difr = ered - sred: difg = egreen - sgreen: difb = eblue - sblue
    Select Case Orientation
      Case Is = 0: fora = Frm.ScaleHeight
      Case Is = 1: fora = Frm.ScaleWidth
    End Select
    For Yi = 0 To fora
    sred = sred + (difr / fora): If sred < 0 Then sred = 0
    sgreen = sgreen + (difg / fora): If sgreen < 0 Then sgreen = 0
    sblue = sblue + (difb / fora): If sblue < 0 Then sblue = 0
    Select Case Orientation
      Case Is = 0: Frm.Line (0, Yi)-(Frm.ScaleWidth, Yi), RGB(sred, sgreen, sblue), B
      Case Is = 1: Frm.Line (Yi, 0)-(Yi, Frm.ScaleHeight), RGB(sred, sgreen, sblue), B
    End Select
    Next
End Function

Public Function Analyze(CConst As ColorConstants)
    Dim rr, gr, br As Long
    rr = 1: gr = 256: br = 65536
    Dim rest As Long
    rest = CConst \ br
    Blue = rest
    CConst = CConst Mod br
    If Blue < 0 Then Blue = 0
    rest = CConst \ gr
    Green = rest
    CConst = CConst Mod gr
    If Green < 0 Then Green = 0
    rest = CConst \ rr
    Red = rest
    CConst = CConst Mod rr
    If Red < 0 Then Red = 0
End Function

Private Sub Form_Resize()
    Gradient Picture1, 0, vbCyan, vbYellow
    Gradient Picture2, 0, vbRed, vbCyan
    Gradient Me, 1, vbGreen, vbRed
    Label1.Caption = "Gradiant Picture"
End Sub

Private Sub Timer1_Timer()
    Label4.Caption = Time
    Label5.Caption = Format(Date, "Long date")
End Sub

Silakan Download disini

Read more »