1. Listing Program Menu Utama
Private Sub mnanggota_Click()
On Error Resume Next
ANGGOTA.Show 1
End Sub
Private Sub mnbuku_Click()
On Error Resume Next
Buku.Show 1
End Sub
Private Sub mnjenisbuku_Click()
End Sub
Private Sub mnlaporan_Click()
On Error Resume Next
laporan.Show 1
End Sub
Private Sub mnpeminjaman_Click()
On Error Resume Next
Peminjaman.Show 1
End Sub
Private Sub mnpengembalian_Click()
On Error Resume Next
Pengembalian.Show 1
End Sub
Private Sub mnpetugas_Click()
On Error Resume Next
Petugas.Show 1
End Sub
Private Sub mnyes_Click()
Unload Me
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case Is = "a"
On Error Resume Next
laporan.Show 1
Case Is = "b"
Dim kel As String
kel = MsgBox("Anda mau keluar...?", vbYesNo + vbQuestion, "Quit System")
If kel = vbYes Then
End
End If
End Select
End Sub
2. Listing Program Pupuk
Private Sub cmdadd_Click()
Me.text1.Enabled = True
Me.text1.SetFocus
End Sub
Private Sub cmdcancel_Click()
Form_Load
Form_Activate
End Sub
Private Sub cmdclose_Click()
ClipCursor ByVal o&
Unload Me
End Sub
Sub LoadToDatabase()
Call OpTable("select * from pupuk where kdpu='" + Me.text1.Text + "'")
If Not Rs.EOF Then
QloadField
Rs.Update
Else
Rs.AddNew
QloadField
Rs.Update
End If
Call LoadToListView("select* from pupuk order by kdpu", list, 3)
Call MsgSave
cmdcancel_Click
End Sub
Private Sub cmddelete_Click()
Dim qdel As String
qdel = MsgBox("data ini mau dihapus..?", vbOKCancel + vbQuestion, "Delete Record")
If qdel = vbOK Then
ConnectToAcces
Cn.Execute "delete from pupuk where kdpu='" + Me.text1.Text + "'"
MsgDelete
cmdcancel_Click
Exit Sub
End If
End Sub
Private Sub cmdedit_Click()
Dim qedit As String
qedit = MsgBox("apakah data ini salah..?", vbOKCancel + vbQuestion, "Edit Record")
If qedit = vbOK Then
OnControl Me
Me.text1.Enabled = False
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
Me.cmdedit.Enabled = False
Me.cmddelete.Enabled = False
Call xz
End If
End Sub
Private Sub cmdsave_Click()
If Me.text1.Text = "" Or _
Me.Text2.Text = "" Or _
Me.Text3.Text = "" Or _
Me.Text4.Text = "" Then
MsgBox "pastikan data jangan kosong..!", vbCritical, "Data Kosong"
Exit Sub
End If
Call Qloading(prg)
Call LoadToDatabase
End Sub
Private Sub Form_Activate()
Me.cmdadd.Enabled = True
Me.cmdclose.Enabled = True
Me.Frame2.Enabled = True
Me.txtsearch.Enabled = True
Me.text1.MaxLength = 5
End Sub
Sub xz()
Dim Client As RECT
Dim Up As POINT
'On Error Resume Next
ClientToScreen Me.hwnd, Up
GetClientRect Me.hwnd, Client
OffsetRect Client, Up.X, Up.Y
Up.X = Client.Left
Up.Y = Client.Top
ClipCursor Client
End Sub
Private Sub Form_Load()
BlankText Me
ControlFlat Me
OffControl Me
Call Centerform(Me)
Call LoadToListView("select* from pupuk order by kdpu", list, 3)
Call xz
End Sub
Private Sub list_Click()
On Error Resume Next
Call FindRecord("select* from pupuk where kdpu='" & list.ListItems.Item(list.SelectedItem.Index).Text & "'")
If Not Rs.EOF Then
OffControl Me
ShowField
Me.cmdedit.Enabled = True
Me.CmdCancel.Enabled = True
Me.cmddelete.Enabled = True
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
'Else
' MsgBox "data belum lengkap..!", vbCritical, "Search Record"
' BlankText Me
End If
Call xz
End Sub
Private Sub text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call FindRecord("select* from pupuk where kdpu='" + Me.text1.Text + "'")
If Not Rs.EOF Then
MsgBox "data ini sudah terdaftar didatabase..!", vbCritical, "Data Sama"
BlankText Me
Me.text1.SetFocus
Else
OnControl Me
Me.text1.Enabled = False
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
Me.cmdedit.Enabled = False
Me.cmddelete.Enabled = False
Call xz
Me.Text2.SetFocus
End If
End If
End Sub
Private Sub text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Text3.SetFocus
End If
End Sub
Private Sub text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Text4.SetFocus
End If
End Sub
Private Sub text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.CmdSave.SetFocus
End If
End Sub
Private Sub txtsearch_change()
On Error Resume Next
Call LoadToListView("select* from pupuk where kdpu like'" & Me.txtsearch.Text & "%'", list, 3)
End Sub
Private Sub txtsearch_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call FindRecord("select * from pupuk where kdpu='" + Me.txtsearch.Text + "'")
If Not Rs.EOF Then
OffControl Me
ShowField
Me.cmdedit.Enabled = True
Me.CmdCancel.Enabled = True
Me.cmddelete.Enabled = True
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = False
Else
MsgBox "data belum lengkap..!", vbCritical, "Search Record"
BlankText Me
End If
End If
Call xz
End Sub
Sub ShowField()
With Rs
Me.text1.Text = .Fields(0)
Me.Text2.Text = .Fields(1)
Me.Text3.Text = .Fields(2)
Me.Text4.Text = .Fields(3)
End With
End Sub
Sub QloadField()
With Rs
.Fields(0) = Me.text1.Text
.Fields(1) = Me.Text2.Text
.Fields(2) = Me.Text3.Text
.Fields(3) = Me.Text4.Text
End With
End Sub
3. Listing Program Wilayah
Private Sub cmdadd_Click()
Me.text1.Enabled = True
Me.text1.SetFocus
End Sub
Private Sub cmdcancel_Click()
Form_Load
Form_Activate
End Sub
Private Sub cmdclose_Click()
ClipCursor ByVal o&
Unload Me
End Sub
Sub LoadToDatabase()
Call OpTable("select * from wilayah where kdwil='" + Me.text1.Text + "'")
If Not Rs.EOF Then
QloadField
Rs.Update
Else
Rs.AddNew
QloadField
Rs.Update
End If
Call LoadToListView("select* from wilayah order by kdwil", list, 5)
Call MsgSave
cmdcancel_Click
End Sub
Private Sub cmddelete_Click()
Dim qdel As String
qdel = MsgBox("data ini mau dihapus..?", vbOKCancel + vbQuestion, "Delete Record")
If qdel = vbOK Then
ConnectToAcces
Cn.Execute "delete from wilayah where kdwil='" + Me.text1.Text + "'"
MsgDelete
cmdcancel_Click
Exit Sub
End If
End Sub
Private Sub cmdedit_Click()
Dim qedit As String
qedit = MsgBox("apakah data ini salah..?", vbOKCancel + vbQuestion, "Edit Record")
If qedit = vbOK Then
OnControl Me
Me.text1.Enabled = False
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
Me.cmdedit.Enabled = False
Me.cmddelete.Enabled = False
Call xz
End If
End Sub
Private Sub cmdsave_Click()
If Me.text1.Text = "" Or _
Me.Text2.Text = "" Or _
Me.Text3.Text = "" Or _
Me.Text4.Text = "" Or _
Me.text5.Text = "" Or _
Me.Text6.Text = "" Then
MsgBox "pastikan data jangan kosong..!", vbCritical, "Data Kosong"
Exit Sub
End If
Call Qloading(prg)
Call LoadToDatabase
End Sub
Private Sub Form_Activate()
Me.cmdadd.Enabled = True
Me.cmdclose.Enabled = True
Me.Frame2.Enabled = True
Me.txtsearch.Enabled = True
Me.text1.MaxLength = 5
End Sub
Sub xz()
Dim Client As RECT
Dim Up As POINT
'On Error Resume Next
ClientToScreen Me.hwnd, Up
GetClientRect Me.hwnd, Client
OffsetRect Client, Up.X, Up.Y
Up.X = Client.Left
Up.Y = Client.Top
ClipCursor Client
End Sub
Private Sub Form_Load()
BlankText Me
ControlFlat Me
OffControl Me
Call Centerform(Me)
Call LoadToListView("select* from wilayah order by kdwil", list, 5)
Call xz
End Sub
Private Sub list_Click()
On Error Resume Next
Call FindRecord("select* from wilayah where kdwil='" & list.ListItems.Item(list.SelectedItem.Index).Text & "'")
If Not Rs.EOF Then
OffControl Me
ShowField
Me.cmdedit.Enabled = True
Me.CmdCancel.Enabled = True
Me.cmddelete.Enabled = True
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
'Else
' MsgBox "data belum lengkap..!", vbCritical, "Search Record"
' BlankText Me
End If
Call xz
End Sub
Private Sub text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call FindRecord("select* from wilayah where kdwil='" + Me.text1.Text + "'")
If Not Rs.EOF Then
MsgBox "data ini sudah terdaftar didatabase..!", vbCritical, "Data Sama"
BlankText Me
Me.text1.SetFocus
Else
OnControl Me
Me.text1.Enabled = False
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
Me.cmdedit.Enabled = False
Me.cmddelete.Enabled = False
Call xz
Me.Text2.SetFocus
End If
End If
End Sub
Private Sub text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Text3.SetFocus
End If
End Sub
Private Sub text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Text4.SetFocus
End If
End Sub
Private Sub text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.text5.SetFocus
End If
End Sub
Private Sub text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Text6.SetFocus
End If
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.CmdSave.SetFocus
End If
End Sub
Private Sub txtsearch_change()
On Error Resume Next
Call LoadToListView("select* from wilayah where kdwil like'" & Me.txtsearch.Text & "%'", list, 5)
End Sub
Private Sub txtsearch_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call FindRecord("select * from wilayah where kdwil='" + Me.txtsearch.Text + "'")
If Not Rs.EOF Then
OffControl Me
ShowField
Me.cmdedit.Enabled = True
Me.CmdCancel.Enabled = True
Me.cmddelete.Enabled = True
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = False
Else
MsgBox "data belum lengkap..!", vbCritical, "Search Record"
BlankText Me
End If
End If
Call xz
End Sub
Sub ShowField()
With Rs
Me.text1.Text = .Fields(0)
Me.Text2.Text = .Fields(1)
Me.Text3.Text = .Fields(2)
Me.Text4.Text = .Fields(3)
Me.text5.Text = .Fields(4)
Me.Text6.Text = .Fields(5)
End With
End Sub
Sub QloadField()
With Rs
.Fields(0) = Me.text1.Text
.Fields(1) = Me.Text2.Text
.Fields(2) = Me.Text3.Text
.Fields(3) = Me.Text4.Text
.Fields(4) = Me.text5.Text
.Fields(5) = Me.Text6.Text
End With
End Sub
4. Listing Program Petugas
Private Sub cmdadd_Click()
Me.text1.Enabled = True
Me.text1.SetFocus
End Sub
Private Sub cmdcancel_Click()
Form_Load
Form_Activate
End Sub
Private Sub cmdclose_Click()
ClipCursor ByVal o&
Unload Me
End Sub
Sub LoadToDatabase()
Call OpTable("select * from petugas where kdpet='" + Me.text1.Text + "'")
If Not Rs.EOF Then
QloadField
Rs.Update
Else
Rs.AddNew
QloadField
Rs.Update
End If
Call LoadToListView("select* from petugas order by kdpet", list, 3)
Call MsgSave
cmdcancel_Click
End Sub
Private Sub cmddelete_Click()
Dim qdel As String
qdel = MsgBox("data ini mau dihapus..?", vbOKCancel + vbQuestion, "Delete Record")
If qdel = vbOK Then
ConnectToAcces
Cn.Execute "delete from petugas where kdpet='" + Me.text1.Text + "'"
MsgDelete
cmdcancel_Click
Exit Sub
End If
End Sub
Private Sub cmdedit_Click()
Dim qedit As String
qedit = MsgBox("apakah data ini salah..?", vbOKCancel + vbQuestion, "Edit Record")
If qedit = vbOK Then
OnControl Me
Me.text1.Enabled = False
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
Me.cmdedit.Enabled = False
Me.cmddelete.Enabled = False
Call xz
End If
End Sub
Private Sub cmdsave_Click()
If Me.text1.Text = "" Or _
Me.Text2.Text = "" Or _
Me.Text3.Text = "" Or _
Me.Text4.Text = "" Then
MsgBox "pastikan data jangan kosong..!", vbCritical, "Data Kosong"
Exit Sub
End If
Call Qloading(prg)
Call LoadToDatabase
End Sub
Private Sub Form_Activate()
Me.cmdadd.Enabled = True
Me.cmdclose.Enabled = True
Me.Frame2.Enabled = True
Me.txtsearch.Enabled = True
Me.text1.MaxLength = 7
End Sub
Sub xz()
Dim Client As RECT
Dim Up As POINT
'On Error Resume Next
ClientToScreen Me.hwnd, Up
GetClientRect Me.hwnd, Client
OffsetRect Client, Up.X, Up.Y
Up.X = Client.Left
Up.Y = Client.Top
ClipCursor Client
End Sub
Private Sub Form_Load()
BlankText Me
ControlFlat Me
OffControl Me
Call Centerform(Me)
Call LoadToListView("select* from petugas order by kdpet", list, 3)
Call xz
End Sub
Private Sub list_Click()
On Error Resume Next
Call FindRecord("select* from petugas where kdpet='" & list.ListItems.Item(list.SelectedItem.Index).Text & "'")
If Not Rs.EOF Then
OffControl Me
ShowField
Me.cmdedit.Enabled = True
Me.CmdCancel.Enabled = True
Me.cmddelete.Enabled = True
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
'Else
' MsgBox "data belum lengkap..!", vbCritical, "Search Record"
' BlankText Me
End If
Call xz
End Sub
Private Sub text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call FindRecord("select* from petugas where kdpet='" + Me.text1.Text + "'")
If Not Rs.EOF Then
MsgBox "data ini sudah terdaftar didatabase..!", vbCritical, "Data Sama"
BlankText Me
Me.text1.SetFocus
Else
OnControl Me
Me.text1.Enabled = False
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
Me.cmdedit.Enabled = False
Me.cmddelete.Enabled = False
Call xz
Me.Text2.SetFocus
End If
End If
End Sub
Private Sub text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Text3.SetFocus
End If
End Sub
Private Sub text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Text4.SetFocus
End If
End Sub
Private Sub text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.CmdSave.SetFocus
End If
End Sub
Private Sub txtsearch_change()
On Error Resume Next
Call LoadToListView("select* from petugas where kdpet like'" & Me.txtsearch.Text & "%'", list, 3)
End Sub
Private Sub txtsearch_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call FindRecord("select * from petugas where kdpet='" + Me.txtsearch.Text + "'")
If Not Rs.EOF Then
OffControl Me
ShowField
Me.cmdedit.Enabled = True
Me.CmdCancel.Enabled = True
Me.cmddelete.Enabled = True
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = False
Else
MsgBox "data belum lengkap..!", vbCritical, "Search Record"
BlankText Me
End If
End If
Call xz
End Sub
Sub ShowField()
With Rs
Me.text1.Text = .Fields(0)
Me.Text2.Text = .Fields(1)
Me.Text3.Text = .Fields(2)
Me.Text4.Text = .Fields(3)
End With
End Sub
Sub QloadField()
With Rs
.Fields(0) = Me.text1.Text
.Fields(1) = Me.Text2.Text
.Fields(2) = Me.Text3.Text
.Fields(3) = Me.Text4.Text
End With
End Sub
5. Listing Program Permintaan
Private Sub cmdadd_Click()
Me.text1.Enabled = True
Me.text1.SetFocus
End Sub
Private Sub cmdcancel_Click()
Form_Load
Form_Activate
End Sub
Private Sub cmdclose_Click()
ClipCursor ByVal o&
Unload Me
End Sub
Sub LoadToDatabase()
On Error Resume Next
Call OpTable("select * from permintaan where noper='" + Me.text1.Text + "'")
If Not Rs.EOF Then
QloadField
Rs.Update
Else
Rs.AddNew
QloadField
Rs.Update
Call LoadToListView("select * from permintaan where noper='" & Me.text1.Text & "'", list, 3)
End If
End Sub
Sub LoadToDatabase1()
On Error Resume Next
Call OpTable("select * from Detailpermintaan where noper='" + Me.text1.Text + "' and kdpu='" & Me.text7.Text & "'")
If Not Rs.EOF Then
QloadField1
Rs.Update
Else
Rs.AddNew
QloadField1
Rs.Update
Call LoadToListView("select * from Detailpermintaan where noper='" & Me.text1.Text & "'", ls, 2)
End If
End Sub
Private Sub cmddelete_Click()
Dim qdel As String
qdel = MsgBox("data ini mau dihapus..?", vbOKCancel + vbQuestion, "Delete Record")
If qdel = vbOK Then
ConnectToAcces
Cn.Execute "delete from permintaan where noper='" + Me.text1.Text + "'"
MsgDelete
cmdcancel_Click
Exit Sub
End If
End Sub
Private Sub cmdedit_Click()
Dim qedit As String
qedit = MsgBox("apakah data ini salah..?", vbOKCancel + vbQuestion, "Edit Record")
If qedit = vbOK Then
OnControl Me
Me.text1.Enabled = False
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
Me.cmdedit.Enabled = False
Me.cmddelete.Enabled = False
'Call xz
End If
End Sub
Private Sub cmdsave_Click()
If Me.Text10.Text <> "" Then
MsgBox "klik add item dulu..!", vbCritical, "Simpan Ke Detailpermintaan"
Exit Sub
End If
Call Qloading(prg)
Call LoadToDatabase
Call MsgSave
cmdcancel_Click
End Sub
Private Sub Command1_Click()
If Me.Text10.Text = "" Then
MsgBox "pastikan data jangan kosong...!", vbCritical, "Data Kosong"
Exit Sub
End If
Call LoadToDatabase1
Call LoadToListView("select * from Detailpermintaan where noper='" & Me.text1.Text & "'", ls, 2)
Me.text1.Enabled = False
Me.Text2.Enabled = False
Me.Text3.Enabled = False
Me.Text4.Enabled = False
Me.text5.Enabled = False
Me.Text6.Enabled = False
Me.text7.Text = ""
Me.Text8.Text = ""
Me.Text9.Text = ""
Me.Text10.Text = ""
Me.text7.SetFocus
End Sub
Private Sub Form_Activate()
Me.cmdadd.Enabled = True
Me.cmdclose.Enabled = True
Me.Frame2.Enabled = True
Me.txtsearch.Enabled = True
Me.text1.MaxLength = 7
End Sub
Sub xz()
Dim Client As RECT
Dim Up As POINT
'On Error Resume Next
ClientToScreen Me.hwnd, Up
GetClientRect Me.hwnd, Client
OffsetRect Client, Up.X, Up.Y
Up.X = Client.Left
Up.Y = Client.Top
ClipCursor Client
End Sub
Private Sub Text10_Change()
Call Qnumeric(Text10)
End Sub
Private Sub Text3_Change()
Call FindRecord("select * from wilayah where kdwil='" & Me.Text3.Text & "'")
If Not Rs.EOF Then
With Rs
Me.Text4.Text = .Fields(1)
End With
End If
End Sub
Private Sub Text3_Click()
Call FindRecord("select * from wilayah where kdwil='" & Me.Text3.Text & "'")
If Not Rs.EOF Then
With Rs
Me.Text4.Text = .Fields(1)
End With
End If
Me.text5.SetFocus
End Sub
Private Sub Text5_Change()
Call FindRecord("select * from petugas where kdpet='" & Me.text5.Text & "'")
If Not Rs.EOF Then
With Rs
Me.Text6.Text = .Fields(1)
End With
End If
End Sub
Private Sub Text5_Click()
Call FindRecord("select * from petugas where kdpet='" & Me.text5.Text & "'")
If Not Rs.EOF Then
With Rs
Me.Text6.Text = .Fields(1)
End With
End If
Me.text7.SetFocus
End Sub
Private Sub Text7_Change()
Call FindRecord("select * from pupuk where kdpu='" & Me.text7.Text & "'")
If Not Rs.EOF Then
With Rs
Me.Text8.Text = .Fields(1)
Me.Text9.Text = .Fields(3)
End With
End If
End Sub
Private Sub Text7_Click()
Call FindRecord("select * from detailpermintaan where kdpu='" & Me.text7.Text & "' and noper='" & Me.text1.Text & "'")
If Not Rs.EOF Then
MsgBox "kode pupuk ini sudah ada..!", vbCritical, "pupuk Sama"
Me.text7.Text = ""
Exit Sub
End If
Call FindRecord("select * from pupuk where kdpu='" & Me.text7.Text & "'")
If Not Rs.EOF Then
With Rs
Me.Text8.Text = .Fields(1)
Me.Text9.Text = .Fields(3)
End With
End If
Me.Text10.SetFocus
End Sub
Private Sub Form_Load()
BlankText Me
ControlFlat Me
OffControl Me
Call Centerform(Me)
Call LoadToCombo("select * from pupuk", text7)
Call LoadToCombo("select * from wilayah", Text3)
Call LoadToCombo("select * from petugas", text5)
Call LoadToListView("select* from permintaan order by noper", list, 3)
End Sub
Private Sub list_Click()
On Error Resume Next
Call FindRecord("select* from permintaan where noper='" & list.ListItems.Item(list.SelectedItem.Index).Text & "'")
If Not Rs.EOF Then
OffControl Me
ShowField
Me.cmdedit.Enabled = True
Me.CmdCancel.Enabled = True
Me.cmddelete.Enabled = True
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
End If
Call xz
End Sub
Private Sub text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call FindRecord("select* from permintaan where noper='" + Me.text1.Text + "'")
If Not Rs.EOF Then
MsgBox "data ini sudah terdaftar didatabase..!", vbCritical, "Data Sama"
BlankText Me
Me.text1.SetFocus
Else
OnControl Me
Me.text1.Enabled = False
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
Me.cmdedit.Enabled = False
Me.cmddelete.Enabled = False
'Call xz
Me.Text2.SetFocus
End If
End If
End Sub
Private Sub txtsearch_change()
On Error Resume Next
Call LoadToListView("select* from permintaan where noper like'" & Me.txtsearch.Text & "%'", list, 3)
End Sub
Private Sub txtsearch_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call FindRecord("select * from permintaan where noper='" + Me.txtsearch.Text + "'")
If Not Rs.EOF Then
OffControl Me
ShowField
Me.cmdedit.Enabled = True
Me.CmdCancel.Enabled = True
Me.cmddelete.Enabled = True
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = False
Else
MsgBox "data belum lengkap..!", vbCritical, "Search Record"
BlankText Me
End If
End If
Call xz
End Sub
Sub ShowField()
With Rs
Me.text1.Text = .Fields(0)
Me.Text2.Value = .Fields(1)
Me.Text3.Text = .Fields(2)
Me.text5.Text = .Fields(3)
End With
End Sub
Sub QloadField()
With Rs
.Fields(0) = Me.text1.Text
.Fields(1) = Me.Text2.Value
.Fields(2) = Me.Text3.Text
.Fields(3) = Me.text5.Text
End With
End Sub
Sub QloadField1()
With Rs
.Fields(0) = Me.text7.Text
.Fields(1) = Me.Text10.Text
.Fields(2) = Me.text1.Text
End With
End Sub
6. Listing Program Pengiriman
Private Sub cmdadd_Click()
Me.text1.Enabled = True
Me.text1.SetFocus
End Sub
Private Sub cmdcancel_Click()
Form_Load
Form_Activate
End Sub
Private Sub cmdclose_Click()
ClipCursor ByVal o&
Unload Me
End Sub
Sub LoadToDatabase()
On Error Resume Next
Call OpTable("select * from pengiriman where nopeng='" + Me.text1.Text + "'")
If Not Rs.EOF Then
QloadField
Rs.Update
Else
Rs.AddNew
QloadField
Rs.Update
Call LoadToListView("select * from pengiriman where nopeng='" & Me.text1.Text & "'", list, 5)
End If
End Sub
Private Sub cmddelete_Click()
Dim qdel As String
qdel = MsgBox("data ini mau dihapus..?", vbOKCancel + vbQuestion, "Delete Record")
If qdel = vbOK Then
ConnectToAcces
Cn.Execute "delete from pengiriman where nopeng='" + Me.text1.Text + "'"
MsgDelete
cmdcancel_Click
Exit Sub
End If
End Sub
Private Sub cmdedit_Click()
Dim qedit As String
qedit = MsgBox("apakah data ini salah..?", vbOKCancel + vbQuestion, "Edit Record")
If qedit = vbOK Then
OnControl Me
Me.text1.Enabled = False
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
Me.cmdedit.Enabled = False
Me.cmddelete.Enabled = False
'Call xz
End If
End Sub
Private Sub cmdsave_Click()
Call Qloading(prg)
Call LoadToDatabase
Call MsgSave
cmdcancel_Click
End Sub
Private Sub Form_Activate()
Me.cmdadd.Enabled = True
Me.cmdclose.Enabled = True
Me.Frame2.Enabled = True
Me.txtsearch.Enabled = True
Me.text1.MaxLength = 7
End Sub
Sub xz()
Dim Client As RECT
Dim Up As POINT
'On Error Resume Next
ClientToScreen Me.hwnd, Up
GetClientRect Me.hwnd, Client
OffsetRect Client, Up.X, Up.Y
Up.X = Client.Left
Up.Y = Client.Top
ClipCursor Client
End Sub
Private Sub text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Text4.SetFocus
End If
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.text7.SetFocus
End If
End Sub
Private Sub Text7_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.CmdSave.SetFocus
End If
End Sub
Private Sub Text4_Click()
Call FindRecord("select * from pengiriman where noper='" & Me.Text4.Text & "'")
If Not Rs.EOF Then
MsgBox "no.permintaan ini sudah dikirim...!", vbCritical, "No.Sama"
Me.Text4.Text = ""
Me.text5.Text = ""
Me.Text4.SetFocus
Exit Sub
End If
Call FindRecord("select * from permintaan where noper='" & Me.Text4.Text & "'")
If Not Rs.EOF Then
Dim ang As String
ang = Rs.Fields(2)
End If
Call FindRecord("select * from wilayah where kdwil='" & ang & "'")
If Not Rs.EOF Then
Me.text5.Text = Rs.Fields(1)
End If
Me.Text6.SetFocus
End Sub
Private Sub Text4_Change()
Call FindRecord("select * from permintaan where noper='" & Me.Text4.Text & "'")
If Not Rs.EOF Then
Dim ang As String
ang = Rs.Fields(2)
End If
Call FindRecord("select * from wilayah where kdwil='" & ang & "'")
If Not Rs.EOF Then
Me.text5.Text = Rs.Fields(1)
End If
End Sub
Private Sub Form_Load()
BlankText Me
ControlFlat Me
OffControl Me
Call Centerform(Me)
Call LoadToCombo("select noper from permintaan group by noper", Text4)
Call LoadToListView("select* from pengiriman order by nopeng", list, 5)
End Sub
Private Sub text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call FindRecord("select* from pengiriman where nopeng='" + Me.text1.Text + "'")
If Not Rs.EOF Then
MsgBox "data ini sudah terdaftar didatabase..!", vbCritical, "Data Sama"
BlankText Me
Me.text1.SetFocus
Else
OnControl Me
Me.text1.Enabled = False
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = True
Me.cmdedit.Enabled = False
Me.cmddelete.Enabled = False
'Call xz
Me.Text2.SetFocus
End If
End If
End Sub
Private Sub txtsearch_change()
On Error Resume Next
Call LoadToListView("select* from pengiriman where nopeng like'" & Me.txtsearch.Text & "%'", list, 5)
End Sub
Private Sub txtsearch_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call FindRecord("select * from pengiriman where nopeng='" + Me.txtsearch.Text + "'")
If Not Rs.EOF Then
OffControl Me
ShowField
Me.cmdedit.Enabled = True
Me.CmdCancel.Enabled = True
Me.cmddelete.Enabled = True
Me.cmdadd.Enabled = False
Me.cmdclose.Enabled = False
Else
MsgBox "data belum lengkap..!", vbCritical, "Search Record"
BlankText Me
End If
End If
Call xz
End Sub
Sub ShowField()
With Rs
Me.text1.Text = .Fields(0)
Me.Text2.Value = .Fields(1)
Me.Text3.Text = .Fields(2)
Me.Text4.Text = .Fields(3)
Me.Text6.Text = .Fields(4)
Me.text7.Text = .Fields(5)
End With
End Sub
Sub QloadField()
With Rs
.Fields(0) = Me.text1.Text
.Fields(1) = Me.Text2.Value
.Fields(2) = Me.Text3.Text
.Fields(3) = Me.Text4.Text
.Fields(4) = Me.Text6.Text
.Fields(5) = Me.text7.Text
End With
End Sub