0% found this document useful (0 votes)
54 views

Data Visual Basic

The document contains code for several different programs: 1. A computer course registration program that calculates fees based on selected courses. 2. An employee payroll program that calculates salary based on position, dependents, etc. 3. A restaurant menu program that calculates totals and discounts based on items ordered. 4. A product inventory program that allows adding, editing, searching and deleting items in a database. The code includes form controls and database interaction functions.

Uploaded by

king of tam
Copyright
© © All Rights Reserved
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
54 views

Data Visual Basic

The document contains code for several different programs: 1. A computer course registration program that calculates fees based on selected courses. 2. An employee payroll program that calculates salary based on position, dependents, etc. 3. A restaurant menu program that calculates totals and discounts based on items ordered. 4. A product inventory program that allows adding, editing, searching and deleting items in a database. The code includes form controls and database interaction functions.

Uploaded by

king of tam
Copyright
© © All Rights Reserved
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
You are on page 1/ 26

1.

Kursus Komputer

Public bvb, bfox, bdel, bcplus, biaya As Double

Private Sub Ccpl_Click()

If Ccpl = 1 Then

bcplus = 125000

Else

bcplus = 0

End If

rumus

Txtbayar.SetFocus

End Sub

Private Sub Cdelp_Click()

If Cdelp = 1 Then

bdel = 150000

Else

bdel = 0

End If

rumus

Txtbayar.SetFocus

End Sub

Private Sub Cfoxp_Click()

If Cfoxp = 1 Then

bfox = 75000

Else

bfox = 0

End If
rumus

Txtbayar.SetFocus

End Sub

Private Sub Cmdkeluar_Click()

Unload Me

End Sub

Private Sub Cmdlagi_Click()

Form_Activate

End Sub

Private Sub Cvisb_Click()

If Cvisb = 1 Then

bvb = 100000

Else

bvb = 0

End If

rumus

Txtbayar.SetFocus

End Sub

Private Sub Form_Activate()

'--- Persiapan awal program

bvb = 0

bfox = 0

bdel = 0

bcplus = 0
'--- mematikan textbox

Txtnm.Enabled = False

Txtwkt.Enabled = False

Txtbkur.Enabled = False

Txtkembali.Enabled = False

'--- rata kanan textbox

Txtbkur.Alignment = 1

Txtbayar.Alignment = 1

Txtkembali.Alignment = 1

'--- nilai awal objek

Txtbayar = ""

Txtbkur = ""

Txtkembali = ""

Txtnm = ""

Txtwkt = ""

Ojad1.Value = False

Ojad2.Value = False

Ojad3.Value = False

Cvisb.Value = 0 '---uncehcked

Cfoxp.Value = 0 '---unchecked

Cdelp.Value = 0 '---unchecked

Ccpl.Value = 0 '---unchecked

'--- List Box No Peserta

listnmrp.Clear

listnmrp.AddItem "11111"

listnmrp.AddItem "22222"

listnmrp.AddItem "33333"
listnmrp.AddItem "44444"

listnmrp.AddItem "55555"

End Sub

Private Sub listnmrp_Click()

Select Case listnmrp.ListIndex

Case 0

Txtnm = "Emyana Br Sembiring"

Case 1

Txtnm = "Aditya Rifki Mediana"

Case 2

Txtnm = "Razuardi Ibrahim H.R"

Case 3

Txtnm = "Leonardo"

Case 4

Txtnm = "Abang Moulvy"

End Select

End Sub

Private Sub Ojad1_Click()

Txtwkt = "Pagi"

End Sub

Private Sub Ojad2_Click()

Txtwkt = "Siang"
End Sub

Private Sub Ojad3_Click()

Txtwkt = "Sore"

End Sub

Public Sub rumus()

biaya = bvb + bfox + bdel + bcplus

Txtbkur = Format(biaya, "Rp ##,###,###.00")

End Sub

Private Sub Txtbayar_Change()

Txtkembali = Val(Txtbayar) - Val(biaya)

Txtkembali = Format(Txtkembali, "Rp ##,###,###.00")

End Sub

2. Penggajian

Private Sub Text1_Change()

End Sub

Private Sub cbjabatan_Click()

If cbjabatan.Value = 1 Then

txtjabatan = 1000000

Else

txtjabatan = 0
End If

End Sub

Private Sub cbkeluarga_Click()

If cbkeluarga.Value = 1 Then

txtkeluarga = 1500000

Else

txtkeluarga = 0

End If

End Sub

Private Sub Cmdhitung_Click()

txtgaber = Val(txtgapok) + Val(txtjabatan) + Val(txtkeluarga)

End Sub

Private Sub Cmdkeluar_Click()

Unload Me

End Sub

Private Sub Cmdlagi_Click()

Form_Activate

End Sub

Private Sub cnip_Click()

Select Case cnip.ListIndex

Case 0

txtnm = "Naufal"

Case 1

txtnm = "Cah Bagus"

Case 2

txtnm = "Mas Ibrahimovik"


Case 3

txtnm = "Bang Do"

Case 4

txtnm = "Pogba"

End Select

End Sub

Private Sub Form_Activate()

'---- persiapan awal program

'--- menonaktifkan textbox

txtnm.Enabled = False

txtgapok.Enabled = False

txtgaber.Enabled = False

txtjabatan.Enabled = False

txtkeluarga.Enabled = False

'--- rata kanan textbox

txtgaber.Alignment = 1

txtgapok.Alignment = 1

txtjabatan.Alignment = 1

txtkeluarga.Alignment = 1

'--- nilai awal objek

txtgaber = ""

txtgapok = ""

txtjabatan = ""

txtkeluarga = ""

txtnm = ""

obdirektur.Value = False

obmanajer.Value = False
obsupervisor.Value = False

cbjabatan.Value = 0 '-- unchecked

cbkeluarga.Value = 0

'--- list combo box nip

cnip.Clear

cnip.AddItem "11111"

cnip.AddItem "22222"

cnip.AddItem "33333"

cnip.AddItem "44444"

cnip.AddItem "55555"

End Sub

Private Sub obdirektur_Click()

txtgapok = 5000000

End Sub

Private Sub obmanajer_Click()

txtgapok = 3000000

End Sub

Private Sub obsupervisor_Click()

txtgapok = 2000000

End Sub
3. Rumah Makan

Private Sub cmdbersih_Click()

obbpkt1.Value = False

obbpkt2.Value = False

obbpkt3.Value = False

txtbyr = ""

txtdisk = ""

txthrg = ""

txtmenu = ""

txtporsi = ""

txttot = ""

End Sub

Private Sub Cmdhitung_Click()

txttot = txtporsi * txthrg

If txtporsi > 5 Then

txtdisk = 0.1 * txttot

Else

txtdisk = 0

End If

txtbyr = txttot - txtdisk

End Sub

Private Sub Cmdkeluar_Click()

Unload Me

End Sub

Private Sub obbpkt1_Click()

txtmenu = "Sate Kerbau"

txthrg = 20000

txtporsi.SetFocus
End Sub

Private Sub obbpkt2_Click()

txtmenu = "Sate Sapi"

txthrg = 25000

txtporsi.SetFocus

End Sub

Private Sub obbpkt3_Click()

txtmenu = "Sate Ayam"

txthrg = 15000

txtporsi.SetFocus

End Sub

4. Barang

Public dbarang As New ADODB.Recordset

Public kembar As New ADODB.Recordset

Public Isi As Integer

Private Sub Cbcari_Click()

Txtcari = ""

Txtcari.SetFocus

End Sub

Private Sub Cmdbatal_Click()

Form_Activate

End Sub

Private Sub Cmdcari_Click()


Isian 0, 0, 1

Tombol 0, 0, 0, 0, 1, 1, 0, 1

bersih

Cbcari.SetFocus

End Sub

Private Sub Cmdhapus_Click()

p = "delete from barang where kdbrg='" & Txtkdbrg & "'"

If MsgBox("Yakin data ini akan dihapus?", vbQuestion + vbYesNo, "Hapus data") = vbYes Then

sambung.Execute (p)

End If

Form_Activate

End Sub

Private Sub Cmdkeluar_Click()

Unload Me

End Sub

Private Sub Cmdkoreksi_Click()

Isi = 2

Isian 0, 1, 0

Tombol 0, 0, 0, 1, 1, 0, 0, 0

Dgbarang.Enabled = False

Txtnmbrg.SetFocus

End Sub
Private Sub Cmdrefresh_Click()

p = "select * from barang order by kdbrg"

Set dbarang = sambung.Execute(p)

Set Dgbarang.DataSource = dbarang

Tampilan

Txtjmldata = dbarang.RecordCount

Tampilan

Txtjmldata = dbarang.RecordCount

Cbcari = ""

Txtcari = ""

End Sub

Private Sub Cmdsimpan_Click()

If Isi = 1 Then

'--- validasi inputan kode barang

If Len(Txtkdbrg) < 5 Then

MsgBox "Inputan kode barang belum valid", vbInformation + vbOKOnly, "Ulangi"

Txtkdbrg = ""

Txtkdbrg.SetFocus

Else

'--- validasi data kembar (kode barang)

p = "select * from barang where kdbrg='" & Txtkdbrg & "'"

Set kembar = sambung.Execute(p)

If kembar.RecordCount <> 0 Then

MsgBox "Kode Barang Tersebut Sudah Ada", vbCritical + vbOKOnly, "Ulangi"

Txtkdbrg = ""
Txtkdbrg.SetFocus

Else

'--- Simpan data baru

p = "insert into barang values('" & Txtkdbrg & "','" & Txtnmbrg & "','" & Val(Txtstok) & "','" & Cbsat
& "','" & Val(Txthrgbl) & "','" & Val(Txthrgjl) & "')"

sambung.Execute (p)

Form_Activate

End If

End If

End If

If Isi = 2 Then

'--- simpan data koreksi

p = "update barang set nmbrg='" & Txtnmbrg & "'," & _

"stok='" & Txtstok & "'," & _

"satuan='" & Cbsat & "'," & _

"hrgbl='" & Txthrgbl & "'," & _

"hrgjl='" & Txthrgjl & "'" & _

" where kdbrg='" & Txtkdbrg & "'"

sambung.Execute (p)

Form_Activate

End If

End Sub
Private Sub Cmdtambah_Click()

Isi = 1

Isian 1, 1, 0

Tombol 0, 0, 0, 1, 1, 0, 0, 0

Dgbarang.Enabled = False

bersih

Txtkdbrg.SetFocus

End Sub

Private Sub Dgbarang_DblClick()

Tombol 0, 1, 1, 0, 1, 0, 0, 0

End Sub

Private Sub Dgbarang_RowColChange(LastRow As Variant, ByVal LastCol As Integer)

Txtkdbrg = Dgbarang.Columns(0).Value

Txtnmbrg = Dgbarang.Columns(1).Value

Txtstok = Dgbarang.Columns(2).Value

Cbsat = Dgbarang.Columns(3).Value

Txthrgbl = Dgbarang.Columns(4).Value

Txthrgjl = Dgbarang.Columns(5).Value

End Sub

Private Sub Form_Activate()

'--- settingan awal program


Txtkdbrg.MaxLength = 5

Txthrgbl.Alignment = 1

Txthrgjl.Alignment = 1

Txtstok.Alignment = 1

Isi = 0

Dgbarang.Enabled = True

bersih

Cbsat.Clear

Cbsat.AddItem "Sachet"

Cbsat.AddItem "Pack"

Cbsat.AddItem "Pcs"

Cbsat.AddItem "Bungkus"

Cbsat.AddItem "Botol"

Cbsat.AddItem "Dus"

Cbcari.Clear

Cbcari.AddItem "Kode Barang"

Cbcari.AddItem "Nama Barang"

Isian 0, 0, 0

Tombol 1, 0, 0, 0, 0, 1, 1, 1

'--- Tampil data barang

p = "select * from barang order by kdbrg"

Set dbarang = sambung.Execute(p)

Set Dgbarang.DataSource = dbarang

Tampilan

Txtjmldata = dbarang.RecordCount
End Sub

Public Sub Isian(t1, t2, t3)

Txtkdbrg.Enabled = t1

Txtnmbrg.Enabled = t2

Cbsat.Enabled = t2

Txthrgbl.Enabled = t2

Txthrgjl.Enabled = t2

Txtstok.Enabled = t2

Cbcari.Enabled = t3

Txtcari.Enabled = t3

End Sub

Public Sub Tombol(p1, p2, p3, p4, p5, p6, p7, p8)

Cmdtambah.Enabled = p1

Cmdkoreksi.Enabled = p2

Cmdhapus.Enabled = p3

Cmdsimpan.Enabled = p4

Cmdbatal.Enabled = p5

Cmdcari.Enabled = p6

Cmdkeluar.Enabled = p7

Cmdrefresh.Enabled = p8

End Sub
Private Sub Form_Load()

Koneksi_mysql

End Sub

Public Sub Tampilan()

Dgbarang.Columns(0).Width = 1500

Dgbarang.Columns(0).Caption = "Kode Barang"

Dgbarang.Columns(1).Width = 3000

Dgbarang.Columns(1).Caption = "Nama Barang"

Dgbarang.Columns(2).Width = 1000

Dgbarang.Columns(2).Alignment = dbgRight

Dgbarang.Columns(2).Caption = "Stok"

Dgbarang.Columns(3).Width = 1500

Dgbarang.Columns(3).Caption = "Satuan"

Dgbarang.Columns(4).Width = 1500

Dgbarang.Columns(4).Alignment = dbgRight

Dgbarang.Columns(4).Caption = "Harga Beli"

Dgbarang.Columns(5).Width = 900

Dgbarang.Columns(5).Alignment = dbgRight

Dgbarang.Columns(5).Caption = "Harga Jual"

End Sub

Private Sub Form_Unload(Cancel As Integer)

sambung.Close

End Sub
Private Sub Txtcari_Change()

If Txtcari <> "" Then

Select Case Cbcari.ListIndex

Case 0

'--- pencarian menurut kode barang

p = "select * from barang where kdbrg like " + "'%" + Trim(Txtcari) + "%' order by nmbrg"

Case 1

'--- pencarian menurut nama barang

p = "select * from barang where nmbrg like " + "'%" + Trim(Txtcari) + "%' order by kdbrg"

End Select

Set dbarang = sambung.Execute(p)

Set Dgbarang.DataSource = dbarang

Tampilan

End If

End Sub

Public Sub bersih()

Txtcari = ""

Txthrgbl = ""

Txthrgjl = ""

Txtkdbrg = ""

Txtnmbrg = ""

Txtstok = ""

Cbsat = ""

End Sub
5. Supplier

Public dbarang As New ADODB.Recordset

Public kembar As New ADODB.Recordset

Public Isi As Integer

Private Sub Cbcari_Click()

Txtcari = ""

Txtcari.SetFocus

End Sub

Private Sub Cmdbatal_Click()

Form_Activate

End Sub

Private Sub Cmdcari_Click()

Isian 0, 0, 1

Tombol 0, 0, 0, 0, 1, 1, 0, 1

bersih

Cbcari.SetFocus

End Sub

Private Sub Cmdhapus_Click()

p = "delete from supplier where kdsup='" & Txtkdbrg & "'"

If MsgBox("Yakin data ini akan dihapus?", vbQuestion + vbYesNo, "Hapus data") = vbYes Then

sambung.Execute (p)

End If

Form_Activate
End Sub

Private Sub Cmdkeluar_Click()

Unload Me

End Sub

Private Sub Cmdkoreksi_Click()

Isi = 2

Isian 0, 1, 0

Tombol 0, 0, 0, 1, 1, 0, 0, 0

Dgbarang.Enabled = False

Txtnmbrg.SetFocus

End Sub

Private Sub Cmdrefresh_Click()

p = "select * from supplier order by kdsup"

Set dbarang = sambung.Execute(p)

Set Dgbarang.DataSource = dbarang

Tampilan

Txtjmldata = dbarang.RecordCount

Tampilan

Txtjmldata = dbarang.RecordCount

Cbcari = ""

Txtcari = ""

End Sub
Private Sub Cmdsimpan_Click()

If Isi = 1 Then

'--- validasi inputan kode barang

If Len(Txtkdbrg) < 7 Then

MsgBox "Inputan kode barang belum valid", vbInformation + vbOKOnly, "Ulangi"

Txtkdbrg = ""

Txtkdbrg.SetFocus

Else

'--- validasi data kembar (kode barang)

p = "select * from supplier where kdsup='" & Txtkdbrg & "'"

Set kembar = sambung.Execute(p)

If kembar.RecordCount <> 0 Then

MsgBox "Kode Barang Tersebut Sudah Ada", vbCritical + vbOKOnly, "Ulangi"

Txtkdbrg = ""

Txtkdbrg.SetFocus

Else

'--- Simpan data baru

p = "insert into supplier values('" & Txtkdbrg & "','" & Txtnmbrg & "','" & Txthrgbl & "','" & Txthrgjl
& "','" & Txtstok & "')"

sambung.Execute (p)

Form_Activate
End If

End If

End If

If Isi = 2 Then

'--- simpan data koreksi

p = "update supplier set nm_perush='" & Txtnmbrg & "'," & _

"almt='" & Txtstok & "'," & _

"kt='" & Txthrgbl & "'," & _

"telp='" & Txthrgjl & "'" & _

" where kdsup='" & Txtkdbrg & "'"

sambung.Execute (p)

Form_Activate

End If

End Sub

Private Sub Cmdtambah_Click()

Isi = 1

Isian 1, 1, 0

Tombol 0, 0, 0, 1, 1, 0, 0, 0

Dgbarang.Enabled = False

bersih

Txtkdbrg.SetFocus

End Sub

Private Sub Dgbarang_DblClick()

Tombol 0, 1, 1, 0, 1, 0, 0, 0
End Sub

Private Sub Dgbarang_RowColChange(LastRow As Variant, ByVal LastCol As Integer)

Txtkdbrg = Dgbarang.Columns(0).Value

Txtnmbrg = Dgbarang.Columns(1).Value

Txthrgbl = Dgbarang.Columns(2).Value

Txthrgjl = Dgbarang.Columns(3).Value

Txtstok = Dgbarang.Columns(4).Value

End Sub

Private Sub Form_Activate()

'--- settingan awal program

Txtkdbrg.MaxLength = 7

Isi = 0

Dgbarang.Enabled = True

bersih

Cbcari.Clear

Cbcari.AddItem "Kode Supplier"

Cbcari.AddItem "Nama Perusahaan"

Isian 0, 0, 0

Tombol 1, 0, 0, 0, 0, 1, 1, 1

'--- Tampil data barang


p = "select * from supplier order by kdsup"

Set dbarang = sambung.Execute(p)

Set Dgbarang.DataSource = dbarang

Tampilan

Txtjmldata = dbarang.RecordCount

End Sub

Public Sub Isian(t1, t2, t3)

Txtkdbrg.Enabled = t1

Txtnmbrg.Enabled = t2

Txthrgbl.Enabled = t2

Txthrgjl.Enabled = t2

Txtstok.Enabled = t2

Cbcari.Enabled = t3

Txtcari.Enabled = t3

End Sub

Public Sub Tombol(p1, p2, p3, p4, p5, p6, p7, p8)

Cmdtambah.Enabled = p1

Cmdkoreksi.Enabled = p2

Cmdhapus.Enabled = p3

Cmdsimpan.Enabled = p4

Cmdbatal.Enabled = p5

Cmdcari.Enabled = p6

Cmdkeluar.Enabled = p7
Cmdrefresh.Enabled = p8

End Sub

Private Sub Form_Load()

Koneksi_mysql

End Sub

Public Sub Tampilan()

Dgbarang.Columns(0).Width = 1700

Dgbarang.Columns(0).Caption = "Kode Supplier"

Dgbarang.Columns(1).Width = 3800

Dgbarang.Columns(1).Caption = "Nama Perusahaan"

Dgbarang.Columns(2).Width = 800

Dgbarang.Columns(2).Caption = "Alamat"

Dgbarang.Columns(3).Width = 1300

Dgbarang.Columns(3).Caption = "Kota"

Dgbarang.Columns(4).Width = 1000

Dgbarang.Columns(4).Caption = "Telepon"

End Sub

Private Sub Form_Unload(Cancel As Integer)

sambung.Close

End Sub

Private Sub Txtcari_Change()


If Txtcari <> "" Then

Select Case Cbcari.ListIndex

Case 0

'--- pencarian menurut kode supplier

p = "select * from supplier where kdsup like " + "'%" + Trim(Txtcari) + "%' order by nm_perush"

Case 1

'--- pencarian menurut nama perusahaan

p = "select * from supplier where nm_perush like " + "'%" + Trim(Txtcari) + "%' order by kdsup"

End Select

Set dbarang = sambung.Execute(p)

Set Dgbarang.DataSource = dbarang

Tampilan

End If

End Sub

Public Sub bersih()

Txtcari = ""

Txthrgbl = ""

Txthrgjl = ""

Txtkdbrg = ""

Txtnmbrg = ""

Txtstok = ""

End Sub

You might also like