Sabtu, 28 April 2012

Visual Basic ( Form Kue )

Posted by Unknown On Sabtu, April 28, 2012 | No comments

Komponen Yang Digunakan :
  1. Microsoft Ado Data Control 6.0  (OLEDB)
  2. Microsoft DataGrid Control 6.0 (OLEDB)
Listing Modul :
Public conn As New ADODB.Connection
Public rskue As New ADODB.Recordset

Public Sub koneksi()
Set conn = New ADODB.Connection
Set rskue = New ADODB.Recordset
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Bakery.mdb"
End Sub

Listing/Coding :


Sub aktif()
txtkode.Enabled = True
cmbproduct.Enabled = True
txtjenis.Enabled = True
lrasa.Enabled = True
txtharga.Enabled = True
End Sub

Sub nonaktif()
txtkode.Enabled = False
cmbproduct.Enabled = False
txtjenis.Enabled = False
lrasa.Enabled = False
txtharga.Enabled = False
End Sub

Sub bersih()
txtkode.Text = ""
cmbproduct.Text = "--Silakan Pilih--"
txtjenis.Text = ""
txtharga.Text = ""
End Sub

Sub tampil()
With rskue
If Not .EOF Then
txtkode.Text = !kdkue
cmbproduct.Text = !product
txtjenis.Text = !jenis_kue
lrasa.Text = !rasa_kue
txtharga.Text = !harga
End If
End With
End Sub

Private Sub Form_Load()
Call koneksi
conn.CursorLocation = adUseClient
rskue.Open "select * from Kue", conn
Set gridkue.DataSource = rskue.DataSource
End Sub

Private Sub Form_Activate()
nonaktif
bersih
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmdcancel.Enabled = False
cmdexit.Enabled = True
cmddelete.Enabled = False
cmdinput.SetFocus
lrasa.Clear
cmbproduct.AddItem "Bread"
cmbproduct.AddItem "Cake"
cmbproduct.AddItem "Pastry"
End Sub

Private Sub cmdinput_Click()
aktif
bersih
lrasa.Clear
cmdinput.Enabled = False
cmdsave.Enabled = True
cmdedit.Enabled = True
cmdcancel.Enabled = True
cmddelete.Enabled = True
cmdexit.Enabled = True
txtkode.SetFocus
End Sub

Private Sub cmdsave_Click()
If cmdsave.Caption = "&Save" Then
Dim sqlsave As String
sqlsave = "insert into Kue values('" & txtkode.Text & "','" & cmbproduct.Text & "','" & txtjenis.Text & "','" & lrasa.Text & "','" & txtharga.Text & "')"
conn.Execute sqlsave
MsgBox "Data Telah Tersimpan"
Form_Load
Else
Dim sqledit As String
sqledit = "update Kue set product = '" & cmbproduct & "',jenis_kue = '" & txtjenis.Text & "',rasa_kue = '" & lrasa.Text & "',harga = '" & txtharga.Text & "' where kdkue = '" & txtkode.Text & "'"
conn.Execute sqledit
MsgBox "Data Telah Diperbaharui"
Form_Load
End If
nonaktif
cmdsave.Enabled = True
cmdsave.Caption = "&Save"
cmdsave.Enabled = False
cmdinput.Enabled = True
cmdcancel.Enabled = True
cmdedit.Enabled = True
cmddelete.Enabled = True
cmdexit.Enabled = True
End Sub

Private Sub cmdedit_Click()
aktif
tampil
txtkode.Enabled = False
cmbproduct.SetFocus
cmdsave.Caption = "&Update"
cmdinput.Enabled = True
cmdedit.Enabled = False
cmdsave.Enabled = True
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End Sub

Private Sub cmdcancel_Click()
p = MsgBox("Yakin Ingin Membatalkan Penginputan..?!", vbQuestion + vbYesNo, "Question")
If p = vbYes Then
nonaktif
bersih
End If
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = False
cmdcancel.Enabled = False
cmdexit.Enabled = True
End Sub

Private Sub cmddelete_Click()
Call koneksi
rskue.Open "delete from Kue where kdkue = '" & txtkode.Text & "'", conn
MsgBox "Data Telah Terhapus"
Form_Load
bersih
nonaktif
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdcancel.Enabled = True
cmdedit.Enabled = True
cmddelete.Enabled = True
cmdexit.Enabled = True
End Sub

Private Sub cmdexit_Click()
p = MsgBox("Yakin Ingin Keluar Dari Program Ini..?!", vbQuestion + vbYesNo, "Question")
If p = vbYes Then
End
End If
End Sub

Private Sub cmdtop_Click()
With rskue
rskue.MoveFirst
MsgBox "Sudah Diawal Record!", vbCritical, "Pesan"
tampil
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End With
End Sub

Private Sub cmdback_Click()
With rskue
rskue.MovePrevious
If rskue.BOF Then
MsgBox "Sudah Diawal Record!", vbCritical, "Pesan"
rskue.MoveFirst
End If
tampil
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End With
End Sub

Private Sub cmdnext_Click()
With rskue
rskue.MoveNext
If rskue.EOF Then
MsgBox "Sudah Diakhir Record!", vbCritical, "Pesan"
rskue.MoveLast
End If
tampil
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End With
End Sub

Private Sub cmdbott_Click()
With rskue
rskue.MoveLast
MsgBox "Sudah Diakhir Record!", vbCritical, "Pesan"
tampil
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End With
End Sub

Private Sub cmbproduct_Click()
If cmbproduct.Text = "Bread" Then
txtjenis.Text = "Classic"
lrasa.Clear
lrasa.AddItem "Chocolate"
lrasa.AddItem "Keju"
lrasa.AddItem "Baso Keju"
ElseIf cmbproduct.Text = "Cake" Then
txtjenis.Text = "Taart"
lrasa.Clear
lrasa.AddItem "Black Forest"
lrasa.AddItem "Mocca Taart"
lrasa.AddItem "Lemon Taart"
Else
txtjenis.Text = "Pastry"
lrasa.Clear
lrasa.AddItem "Chiken Pie"
lrasa.AddItem "Danish Raisin"
lrasa.AddItem "Coissant Coklat"
End If
End Sub

Private Sub lrasa_Click()
If txtjenis.Text = "Classic" Then
If lrasa.ListIndex = 0 Then
txtharga.Text = "6500"
ElseIf lrasa.ListIndex = 1 Then
txtharga.Text = "7000"
Else
txtharga.Text = "8000"
End If
ElseIf txtjenis.Text = "Taart" Then
If lrasa.ListIndex = 0 Then
txtharga.Text = "277000"
ElseIf lrasa.ListIndex = 1 Then
txtharga.Text = "215000"
Else
txtharga.Text = "215000"
End If
Else
If lrasa.ListIndex = 0 Then
txtharga.Text = "6500"
ElseIf lrasa.ListIndex = 1 Then
txtharga.Text = "6500"
Else
txtharga.Text = "6500"
End If
End If
End Sub

0 komentar:

Posting Komentar

Blog Archive

Blogroll