CONTOH HASIL BAHASAN PEMROGRAMAN

a. Munu Utama
Munu Utama
Private Sub cmdExit_Click()
Dim Kel As Long
Kel = MsgBox("Yakin Mau Keluar...!", vbYesNo + vbInformation, "Confirm Exit")
If Kel = vbYes Then
End
End If
End Sub
Private Sub MDIForm_Load()
Connect_to_Server
End Sub

Private Sub mnBahan_Click()
FrmBahan.Show
End Sub
Private Sub mnDesa_Click()
FrmDesa.Show
End Sub

Private Sub mnIzin_Click()
FrmIzin.Show
End Sub

Private Sub mnKabupaten_Click()
FrmKabupaten.Show
End Sub

Private Sub mnKEcamatan_Click()
FrmKecamatan.Show
End Sub

Private Sub mnPropinsi_Click()
FrmPropinsi.Show
End Sub

Private Sub mnReport_Click()
frmReport.Show
End Sub

Private Sub mnTambang_Click()
FrmTambang.Show
End Sub
Private Sub repKecamatan_Click()
End Sub
Private Sub Timer1_Timer()
StatusBar1.Panels(1) = Format(Date, "dd mmmm yyyy")
StatusBar1.Panels(2) = Format(Time, "hh:mm:ss")
StatusBar1.Panels(3) = "-"
StatusBar1.Panels(4).Text = "-"
End Sub
Private Sub xStatus_Change()
End Sub



b. Data Propinsi

Dim Rs As ADODB.Recordset
Private Sub cmdBaru_Click()
On Error Resume Next
Clear_Textbox Me

Me.cmdBaru.Enabled = False
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
status = False

End Sub

Private Sub cmdBatal_Click()
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
RefreshList
End Sub
Private Sub cmdEdit_Click()
on_object Me
status = True
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
End Sub
Private Sub cmdHapus_Click()
'On Error Resume Next
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
Del = MsgBox("Benar Data Ini Mau Di Hapus ? .......", vbYesNo + vbCritical, "Delete")
If Del = vbYes Then
Set Rs = New ADODB.Recordset
xSQL = "delete from TPropinsi where Propinsi= '" & Me.xKode.Text & "'"
Rs.Open xSQL, Mydb, adOpenDynamic, adLockOptimistic
End If
RefreshList
End Sub
Private Sub cmdKeluar_Click()
FrmMenuUtama.xStatus.Text = ""
FrmMenuUtama.xStatus.Text = "MENU UTAMA"
Unload Me
End Sub
Private Sub cmdSimpan_Click()
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
If status = False Then
KosongkanSimpanData
setFieldRecord 1, "Propinsi", Me.xPropinsi.Text, "C"

SimpanRecord Mydb, "TPropinsi", False
End If
If status = True Then
setValidasi 1, "Propinsi", Me.xKode.Text
setFieldRecord 1, "Propinsi", Me.xPropinsi.Text, "C"
SimpanRecord Mydb, "TPropinsi", True
End If
RefreshList
End Sub

Private Sub Form_Activate()
FrmMenuUtama.xStatus.Text = "FORM INPUT, EDIT DAN HAPUS DATA Propinsi"
End Sub

Private Sub Form_Load()
Tengah Me
On Error Resume Next
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
isi_FieldKriteria Me.xMelalui, "TPropinsi"
RefreshList
End Sub
Private Sub Ms_dblClick()
Clear_Textbox Me
Me.cmdBatal.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdEdit.Enabled = True
Me.cmdHapus.Enabled = True
xKode.Text = getItemList(Me.ms, 1)
TampilList
ms.SetFocus
End Sub
Private Sub ms_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Ms_dblClick
End If
End Sub
Private Sub TampilList()
On Error Resume Next
Dim rs1 As ADODB.Recordset
Dim query As String
query = "Select * from TPropinsi where Propinsi= '" & Me.xKode.Text & "'"
Set rs1 = New ADODB.Recordset
rs1.Open query, Mydb, adOpenDynamic, adLockOptimistic
If Not rs1.EOF Then
rs1.MoveFirst
With rs1
Me.xPropinsi.Text = !Propinsi
End With
End If
End Sub
Public Sub RefreshList()
On Error Resume Next
xSQL = "Select * From TPropinsi Order By Propinsi"
TampilData xSQL, ms, Mydb, 1
Me.ms.ColumnHeaders.Item(2).Width = 2000
End Sub
Public Sub FindList(str As String)
On Error Resume Next
xSQL = "Select * From TPropinsi where " & Me.xMelalui.Text & " Like '%" & str & "%' Order By Propinsi"
TampilData xSQL, ms, Mydb, 1
Me.ms.ColumnHeaders.Item(2).Width = 2000
End Sub
Private Sub xMelalui_Click()
xKata.Locked = False
End Sub
Private Sub xKata_Change()
FindList Me.xKata.Text
End Sub
Private Sub xPropinsi_Change()

End Sub



c. Data Kabupaten
Dim Rs As ADODB.Recordset
Private Sub cmdBaru_Click()
On Error Resume Next
Clear_Textbox Me

Me.cmdBaru.Enabled = False
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
status = False

End Sub

Private Sub cmdBatal_Click()
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
RefreshList
End Sub
Private Sub cmdEdit_Click()
on_object Me
status = True
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
End Sub
Private Sub cmdHapus_Click()
'On Error Resume Next
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
Del = MsgBox("Benar Data Ini Mau Di Hapus ? .......", vbYesNo + vbCritical, "Delete")
If Del = vbYes Then
Set Rs = New ADODB.Recordset
xSQL = "delete from TKabupaten where KodeKabupaten = '" & Me.xKode.Text & "'"
Rs.Open xSQL, Mydb, adOpenDynamic, adLockOptimistic
End If
RefreshList
End Sub
Private Sub cmdKeluar_Click()
FrmMenuUtama.xStatus.Text = ""
FrmMenuUtama.xStatus.Text = "MENU UTAMA"
Unload Me
End Sub
Private Sub cmdSimpan_Click()
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
If status = False Then
KosongkanSimpanData
setFieldRecord 1, "KodeKabupaten", Me.xKodeKabupaten.Text, "C"
setFieldRecord 2, "NamaKabupaten", Me.xNamaKabupaten.Text, "C"
setFieldRecord 3, "Propinsi", Me.xPropinsi.Text, "C"

SimpanRecord Mydb, "TKabupaten", False
End If
If status = True Then
setValidasi 1, "KodeKabupaten", Me.xKode.Text
setFieldRecord 1, "KodeKabupaten", Me.xKodeKabupaten.Text, "C"
setFieldRecord 2, "NamaKabupaten", Me.xNamaKabupaten.Text, "C"
setFieldRecord 3, "Propinsi", Me.xPropinsi.Text, "C"

SimpanRecord Mydb, "TKabupaten", True
End If
RefreshList
End Sub

Private Sub Form_Activate()
FrmMenuUtama.xStatus.Text = "FORM INPUT, EDIT DAN HAPUS DATA Kabupaten"
End Sub

Private Sub Form_Load()
Tengah Me
On Error Resume Next
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
IsiKombo "Select Propinsi From TPropinsi", Me.xPropinsi
isi_FieldKriteria Me.xMelalui, "TKabupaten"

RefreshList

End Sub
Private Sub Ms_dblClick()
Clear_Textbox Me
Me.cmdBatal.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdEdit.Enabled = True
Me.cmdHapus.Enabled = True
xKode.Text = getItemList(Me.ms, 1)
TampilList
ms.SetFocus
End Sub

Private Sub ms_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Ms_dblClick
End If
End Sub


Private Sub TampilList()
On Error Resume Next
Dim rs1 As ADODB.Recordset
Dim query As String
query = "Select * from TKabupaten where KodeKabupaten = '" & Me.xKode.Text & "'"
Set rs1 = New ADODB.Recordset
rs1.Open query, Mydb, adOpenDynamic, adLockOptimistic
If Not rs1.EOF Then
rs1.MoveFirst
With rs1
Me.xPropinsi.Text = !Propinsi
Me.xKodeKabupaten.Text = !KodeKabupaten
Me.xNamaKabupaten.Text = !NamaKabupaten
End With
End If
End Sub
Public Sub RefreshList()
On Error Resume Next
xSQL = "Select * From TKabupaten Order By KodeKabupaten"
TampilData xSQL, ms, Mydb, 1
Me.ms.ColumnHeaders.Item(2).Width = 2000
End Sub
Public Sub FindList(str As String)
On Error Resume Next
xSQL = "Select * From TKabupaten where " & Me.xMelalui.Text & " Like '%" & str & "%' Order By KodeKabupaten"
TampilData xSQL, ms, Mydb, 1
Me.ms.ColumnHeaders.Item(2).Width = 2000
End Sub
Private Sub xMelalui_Click()
xKata.Locked = False
End Sub
Private Sub xKata_Change()
FindList Me.xKata.Text
End Sub

Private Sub xNamaKabupaten_Change()

End Sub

d. Data Kecamatan
Dim Rs As ADODB.Recordset
Private Sub cmdBaru_Click()
On Error Resume Next
Clear_Textbox Me
Me.cmdBaru.Enabled = False
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
status = False
End Sub
Private Sub cmdBatal_Click()
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
RefreshList
End Sub
Private Sub cmdEdit_Click()
on_object Me
status = True
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
End Sub
Private Sub cmdHapus_Click()
'On Error Resume Next
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
Del = MsgBox("Benar Data Ini Mau Di Hapus ? .......", vbYesNo + vbCritical, "Delete")
If Del = vbYes Then
Set Rs = New ADODB.Recordset
xSQL = "delete from TKecamatan where KodeKecamatan = '" & Me.xKode.Text & "'"
Rs.Open xSQL, Mydb, adOpenDynamic, adLockOptimistic
End If
RefreshList
End Sub
Private Sub cmdKeluar_Click()
FrmMenuUtama.xStatus.Text = ""
FrmMenuUtama.xStatus.Text = "MENU UTAMA"
Unload Me
End Sub
Private Sub cmdSimpan_Click()
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
If status = False Then
KosongkanSimpanData
setFieldRecord 1, "KodeKecamatan", Me.xKodeKecamatan.Text, "C"
setFieldRecord 2, "NamaKecamatan", Me.xNamaKecamatan.Text, "C"
setFieldRecord 3, "KodeKabupaten", Me.xKodeKabupaten.Text, "C"
SimpanRecord Mydb, "TKecamatan", False
End If
If status = True Then
setValidasi 1, "KodeKecamatan", Me.xKode.Text
setFieldRecord 1, "KodeKecamatan", Me.xKodeKecamatan.Text, "C"
setFieldRecord 2, "NamaKecamatan", Me.xNamaKecamatan.Text, "C"
setFieldRecord 3, "KodeKabupaten", Me.xKodeKabupaten.Text, "C"
SimpanRecord Mydb, "TKecamatan", True
End If
RefreshList
End Sub

Private Sub Form_Activate()
FrmMenuUtama.xStatus.Text = "FORM INPUT, EDIT DAN HAPUS DATA KECAMATAN"
End Sub

Private Sub Form_Load()
Tengah Me
On Error Resume Next
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
IsiKombo "Select KodeKabupaten From TKabupaten", Me.xKodeKabupaten
isi_FieldKriteria Me.xMelalui, "TKecamatan"

RefreshList

End Sub

Private Sub Ms_dblClick()
Clear_Textbox Me
Me.cmdBatal.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdEdit.Enabled = True
Me.cmdHapus.Enabled = True
xKode.Text = getItemList(Me.ms, 1)
TampilList
ms.SetFocus
End Sub

Private Sub ms_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Ms_dblClick
End If
End Sub

Private Sub TampilList()
On Error Resume Next
Dim rs1 As ADODB.Recordset
Dim query As String
query = "Select * from TKecamatan where KodeKecamatan = '" & Me.xKode.Text & "'"
Set rs1 = New ADODB.Recordset
rs1.Open query, Mydb, adOpenDynamic, adLockOptimistic
If Not rs1.EOF Then
rs1.MoveFirst
With rs1
Me.xKodeKabupaten.Text = !KodeKabupaten
Me.xKodeKecamatan.Text = !KodeKecamatan
Me.xNamaKecamatan.Text = !NamaKecamatan
End With
End If
End Sub
Public Sub RefreshList()
On Error Resume Next
xSQL = "Select * From TKecamatan Order By KodeKecamatan"
TampilData xSQL, ms, Mydb, 1
Me.ms.ColumnHeaders.Item(2).Width = 2000
End Sub
Public Sub FindList(str As String)
On Error Resume Next
xSQL = "Select * From TKecamatan where " & Me.xMelalui.Text & " Like '%" & str & "%' Order By KodeKecamatan"
TampilData xSQL, ms, Mydb, 1
Me.ms.ColumnHeaders.Item(2).Width = 2000
End Sub
Private Sub xMelalui_Click()
xKata.Locked = False
End Sub
Private Sub xKata_Change()
FindList Me.xKata.Text
End Sub

Private Sub xNamaKecamatan_Change()

End Sub


e. Data Desa
Dim Rs As ADODB.Recordset
Private Sub cmdBaru_Click()
On Error Resume Next
Clear_Textbox Me

Me.cmdBaru.Enabled = False
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
status = False

End Sub

Private Sub cmdBatal_Click()
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
RefreshList
End Sub
Private Sub cmdEdit_Click()
on_object Me
status = True
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
End Sub
Private Sub cmdHapus_Click()
'On Error Resume Next
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
Del = MsgBox("Benar Data Ini Mau Di Hapus ? .......", vbYesNo + vbCritical, "Delete")
If Del = vbYes Then
Set Rs = New ADODB.Recordset
xSQL = "delete from TDesa where KodeDesa = '" & Me.xKode.Text & "'"
Rs.Open xSQL, Mydb, adOpenDynamic, adLockOptimistic
End If
RefreshList
End Sub
Private Sub cmdKeluar_Click()
FrmMenuUtama.xStatus.Text = ""
FrmMenuUtama.xStatus.Text = "MENU UTAMA"
Unload Me
End Sub
Private Sub cmdSimpan_Click()
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
If status = False Then
KosongkanSimpanData
setFieldRecord 1, "KodeDesa", Me.xKodeDesa.Text, "C"
setFieldRecord 2, "NamaDesa", Me.xNamaDesa.Text, "C"
setFieldRecord 3, "KodeKecamatan", Me.xKodeKecamatan.Text, "C"
SimpanRecord Mydb, "TDesa", False
End If
If status = True Then
setValidasi 1, "KodeDesa", Me.xKode.Text
setFieldRecord 1, "KodeDesa", Me.xKodeDesa.Text, "C"
setFieldRecord 2, "NamaDesa", Me.xNamaDesa.Text, "C"
setFieldRecord 3, "KodeKecamatan", Me.xKodeKecamatan.Text, "C"
SimpanRecord Mydb, "TDesa", True
End If
RefreshList
End Sub
Private Sub Form_Activate()
FrmMenuUtama.xStatus.Text = "FORM INPUT, EDIT DAN HAPUS DATA Desa"
End Sub
Private Sub Form_Load()
Tengah Me
On Error Resume Next
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
isi_FieldKriteria Me.xMelalui, "TDesa"
IsiKombo "Select KodeKecamatan From TKecamatan", Me.xKodeKecamatan
RefreshList
End Sub
Private Sub Ms_dblClick()
Clear_Textbox Me
Me.cmdBatal.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdEdit.Enabled = True
Me.cmdHapus.Enabled = True
xKode.Text = getItemList(Me.ms, 1)
TampilList
ms.SetFocus
End Sub

Private Sub ms_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Ms_dblClick
End If
End Sub

Private Sub TampilList()
On Error Resume Next
Dim rs1 As ADODB.Recordset
Dim query As String
query = "Select * from TDesa where KodeDesa = '" & Me.xKode.Text & "'"
Set rs1 = New ADODB.Recordset
rs1.Open query, Mydb, adOpenDynamic, adLockOptimistic
If Not rs1.EOF Then
rs1.MoveFirst
With rs1
Me.xKodeDesa.Text = !KodeDesa
Me.xNamaDesa.Text = !NamaDesa
Me.xKodeKecamatan.Text = !KodeKecamatan
End With
End If
End Sub
Public Sub RefreshList()
On Error Resume Next
xSQL = "Select * From TDesa Order By KodeDesa"
TampilData xSQL, ms, Mydb, 1
Me.ms.ColumnHeaders.Item(2).Width = 2000
End Sub
Public Sub FindList(str As String)
On Error Resume Next
xSQL = "Select * From TDesa where " & Me.xMelalui.Text & " Like '%" & str & "%' Order By KodeDesa"
TampilData xSQL, ms, Mydb, 1
Me.ms.ColumnHeaders.Item(2).Width = 2000
End Sub

Private Sub xKodeDesa_Change()

End Sub

Private Sub xMelalui_Click()
xKata.Locked = False
End Sub
Private Sub xKata_Change()
FindList Me.xKata.Text
End Sub





f. Data Pemberian Izin

Dim Rs As ADODB.Recordset
Private Sub cmdBaru_Click()
On Error Resume Next
Clear_Textbox Me
Me.cmdBaru.Enabled = False
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
status = False
End Sub
Private Sub cmdBatal_Click()
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
RefreshList
End Sub
Private Sub cmdEdit_Click()
on_object Me
status = True
Me.cmdSimpan.Enabled = True
Me.cmdBatal.Enabled = True
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
End Sub
Private Sub cmdHapus_Click()
'On Error Resume Next
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
Del = MsgBox("Benar Data Ini Mau Di Hapus ? .......", vbYesNo + vbCritical, "Delete")
If Del = vbYes Then
Set Rs = New ADODB.Recordset
xSQL = "delete from TIzin where KodeIzin = '" & Me.xKode.Text & "'"
Rs.Open xSQL, Mydb, adOpenDynamic, adLockOptimistic
End If
RefreshList
End Sub
Private Sub cmdKeluar_Click()
FrmMenuUtama.xStatus.Text = ""
FrmMenuUtama.xStatus.Text = "MENU UTAMA"
Unload Me
End Sub
Private Sub cmdSimpan_Click()
Me.cmdBaru.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
If status = False Then
KosongkanSimpanData
setFieldRecord 1, "KodeIzin", Me.xKodeIzin.Text, "C"
setFieldRecord 2, "Koordinat", Me.xKoordinat.Text, "C"
setFieldRecord 3, "Propinsi", Me.xPropinsi.Text, "C"
setFieldRecord 4, "Kabupaten", Me.xKabupaten.Text, "C"
setFieldRecord 5, "Desa", Me.xDesa.Text, "C"
setFieldRecord 6, "Luas", Me.xLuas.Text, "C"
setFieldRecord 7, "Kecamatan", Me.xKecamatan.Text, "C"
setFieldRecord 8, "Bahan", Me.xBahan.Text, "C"
setFieldRecord 9, "Perusahaan", Me.xPerusahaan.Text, "C"


SimpanRecord Mydb, "TIzin", False
End If
If status = True Then
setValidasi 1, "KodeIzin", Me.xKode.Text
setFieldRecord 1, "KodeIzin", Me.xKodeIzin.Text, "C"
setFieldRecord 2, "Koordinat", Me.xKoordinat.Text, "C"
setFieldRecord 3, "Propinsi", Me.xPropinsi.Text, "C"
setFieldRecord 4, "Kabupaten", Me.xKabupaten.Text, "C"
setFieldRecord 5, "Desa", Me.xDesa.Text, "C"
setFieldRecord 6, "Luas", Me.xLuas.Text, "C"
setFieldRecord 7, "Kecamatan", Me.xKecamatan.Text, "C"
setFieldRecord 8, "Bahan", Me.xBahan.Text, "C"
setFieldRecord 9, "Perusahaan", Me.xPerusahaan.Text, "C"

SimpanRecord Mydb, "TIzin", True
End If
RefreshList
End Sub

Private Sub Form_Activate()
FrmMenuUtama.xStatus.Text = "FORM INPUT, EDIT DAN HAPUS DATA Izin"
End Sub

Private Sub Form_Load()
Tengah Me
On Error Resume Next
Me.cmdSimpan.Enabled = False
Me.cmdBatal.Enabled = False
Me.cmdEdit.Enabled = False
Me.cmdHapus.Enabled = False
isi_FieldKriteria Me.xMelalui, "TIzin"
IsiKombo "Select Propinsi From TPropinsi", Me.xPropinsi
IsiKombo "Select NamaKabupaten From TKabupaten", Me.xKabupaten
IsiKombo "Select NamaKecamatan From TKecamatan", Me.xKecamatan
IsiKombo "Select NamaDesa From TDesa", Me.xDesa
IsiKombo "Select NamaBahan From TBahan", Me.xBahan
RefreshList

End Sub

Private Sub Ms_dblClick()
Clear_Textbox Me
Me.cmdBatal.Enabled = True
Me.cmdSimpan.Enabled = False
Me.cmdEdit.Enabled = True
Me.cmdHapus.Enabled = True
xKode.Text = getItemList(Me.ms, 1)
TampilList
ms.SetFocus
End Sub

Private Sub ms_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Ms_dblClick
End If
End Sub

Private Sub TampilList()
On Error Resume Next
Dim rs1 As ADODB.Recordset
Dim query As String
query = "Select * from TIzin where KodeIzin = '" & Me.xKode.Text & "'"
Set rs1 = New ADODB.Recordset
rs1.Open query, Mydb, adOpenDynamic, adLockOptimistic
If Not rs1.EOF Then
rs1.MoveFirst
With rs1
Me.xKodeIzin.Text = !KodeIzin
Me.xKoordinat.Text = !Koordinat
Me.xPropinsi.Text = !Propinsi
Me.xDesa.Text = !Desa
Me.xKabupaten.Text = !Kabupaten
Me.xLuas.Text = !Luas
Me.xKecamatan.Text = !Kecamatan
Me.xPerusahaan.Text = !Perusahaan
Me.xBahan.Text = !Bahan
End With
End If
End Sub
Public Sub RefreshList()
On Error Resume Next
xSQL = "Select * From TIzin Order By KodeIzin"
TampilData xSQL, ms, Mydb, 1
Me.ms.ColumnHeaders.Item(2).Width = 2000
End Sub
Public Sub FindList(str As String)
On Error Resume Next
xSQL = "Select * From TIzin where " & Me.xMelalui.Text & " Like '%" & str & "%' Order By KodeIzin"
TampilData xSQL, ms, Mydb, 1
Me.ms.ColumnHeaders.Item(2).Width = 2000
End Sub
Private Sub xMelalui_Click()
xKata.Locked = False
End Sub
Private Sub xKata_Change()
FindList Me.xKata.Text
End Sub
Private Sub xPerusahaan_Change()
End Sub