Aplikasi Perpu Bidang Kehutanan
Aplikasi ini di tujukan untuk User yang ingin yang membutuhkan Peraturan Perundang-undangan bidang kehutanan dan juga para Programmer pemula yang membutuhkan Source codenya baik hanya di pelajari triknya ataupun untuk mengembangkan sistem ini.
Kegunaan dari Aplikasi ini adalah melakukan proses pencarian berdasarkan kriteria yang kita tentukan misalnya pencarian batasan tahun, Mulai tahun 1945 s/d Tahun 2008, pencarian berdasarkan Nomor dsb.
Cakupan Peraturan Perundang-undangan bidang kehutanan antara lain Perpu, Perpres/Kepres, Permenhut, Dirjen, Ka Baplan, Balitbang, Irjen, SekJen, Perda, Perlain mulai tahun 1945 s/d tahun 2008.
Menggunakan Aplikasi
Pertama kali aplikasi di jalankan tampilan awal seperti gambar dibawah ini :
Isikan Kolom
Nomor Jika diinginkan,
Mulai Tahun dan
S/d Tahun, ataupun isikan
Tentang berupa Kata/Kalimat mengenai Perpu Jika di inginkan, Lalu klik Tombol
Cari, Untuk proses Pencarian,
Hasil pencarian akan muncul pada tabel form.
Hasil Pencarian juga bisa di saring lagi sesuai kebutuhan dengan mengklik tombol di sisi kiri aplikasi misalnya
Perpu, Perpres/Kepres, Permenhut, Dirjen, Ka Baplan, Balitbang, Irjen, SekJen, Perda, Perlain.
Setelah semua pencarian selesai di lakukan, kita bisa tampilkan salah satu peraturan dengan mendoble click pada daftar hasil, misalnya ingin menampilkan
UU No 8 tahun 1974, Tentang
Pokok-pokok Kepegawaian, Setelah di klik ganda maka hasil muncul seperti gambar dibawah ini :
Source Code
Source dan Aplikasi lengkap bisa di download di alamat tautan ini :
http://www.4shared.com/file/146715912/cb7b0d4b/SourceCodeVBPerpuKehutanan.html
Sepenggal Source Code VB :
Dim db As New ADODB.Connection
Dim RS As New ADODB.Recordset
Public nilaitombolnya As Integer
Sub TENGAH()
MSHFlexGrid1.ColAlignmentFixed(0) = 4
MSHFlexGrid1.ColAlignmentFixed(1) = 4
End Sub
Sub WARNA()
On Error Resume Next
For X = 1 To RS.RecordCount
If RS!Status = 0 Then
MSHFlexGrid1.Col = 0
MSHFlexGrid1.Row = X
MSHFlexGrid1.CellForeColor = &HFF&
MSHFlexGrid1.Col = 1
MSHFlexGrid1.Row = X
MSHFlexGrid1.CellForeColor = &HFF&
Else
'MSHFlexGrid1.Row = X
MSHFlexGrid1.ForeColor = &H0&
End If
RS.MoveNext
Next
End Sub
Sub tombol3()
nilaiTombol = 2
VniliTombol.Text = nilaiTombol
Command11.BackColor = &HC0C000
Command1.BackColor = &HC0C000
Command13.BackColor = &HC0C000
Command14.BackColor = &HC0C000
End Sub
Private Sub AresButton1_MouseClick()
If Not VnilaiTombol.Text = 0 Then
nilaitombolnya = 1
FormTambah.Show
Else
MsgBox "..Pilih salah satu jenis Peraturan dahulu"
End If
End Sub
Private Sub AresButton2_MouseClick()
On Error GoTo salah
MSHFlexGrid1.Col = 4
vNAMAFILE.Text = App.Path & "\DOC\" + Trim(MSHFlexGrid1.Text) + ""
'Print App.Path & vNAMAFILE.Text
OLE1.CreateLink (vNAMAFILE.Text)
OLE1.DoVerb
Exit Sub
salah:
MsgBox "FILE TIDAK / BELUM ADA "
End Sub
Private Sub CmdMasuk_Click()
Select Case VnilaiTombol.Text
'-------------------------------------- KALO NILAI TOMBOLNYA 0
Case 0
Set RS = Nothing
gabung = Tentang.Text & bintang
If Not Len(NomorUU.Text) = 0 Then
RS.Open "SELECT * FROM Tbl_UU WHERE nomorUU=" + NomorUU.Text + " and tahun between " + TAHUN.Text + " and " + TahunSD.Text + " ORDER BY NOMOR,NO_URUT dESC", db, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = RS
Call WARNA
If Not RS.RecordCount = 0 Then
Label6.Caption = "Ditemukan " & RS.RecordCount & " Peraturan Undang-Undang"
Else
Label6.Caption = "Tidak ditemukan Peraturan Undang-Undang "
End If
Else
RS.Open "SELECT * FROM Tbl_UU WHERE tahun between " + TAHUN.Text + " and " + TahunSD.Text + " ORDER BY NOMOR,NO_URUT dESC", db, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = RS
Call WARNA
If Not RS.RecordCount = 0 Then
Label6.Caption = "Ditemukan " & RS.RecordCount & " Peraturan Undang-Undang"
Else
Label6.Caption = "..Pencarian Tidak ditemukan.."
End If
End If
If Not Len(Tentang.Text) = 0 Then
Set RS = Nothing
gabung = Trim("%") & Tentang.Text & Trim("%")
RS.Open "SELECT * FROM Tbl_UU where tentang like '" + gabung + "' and tahun between " + TAHUN.Text + " and " + TahunSD.Text + " ORDER BY NOMOR,NO_URUT dESC", db, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = RS
Call WARNA
If Not RS.RecordCount = 0 Then
Label6.Caption = "Ditemukan " & RS.RecordCount & " Peraturan Undang-Undang"
Else
Label6.Caption = "Tidak ditemukan Peraturan Undang-Undang "
End If
End If
Set RS = Nothing
If Not Len(Tentang.Text) = 0 And Not Len(NomorUU.Text) = 0 Then
gabung = Trim("%") & Tentang.Text & Trim("%")
RS.Open "SELECT * FROM Tbl_UU where tentang like '" + gabung + "' and tahun between " + TAHUN.Text + " and " + TahunSD.Text + " and nomoruu=" + NomorUU.Text + " ORDER BY NOMOR,NO_URUT dESC", db, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = RS
Call WARNA
If Not RS.RecordCount = 0 Then
Label6.Caption = "Ditemukan " & RS.RecordCount & " Peraturan Undang-Undang"
Else
Label6.Caption = "Tidak ditemukan Peraturan Undang-Undang "
End If
End If
Private Sub Command13_Click()
Call tombol13
Set RS = Nothing
gabung = Tentang.Text & bintang
If Not Len(NomorUU.Text) = 0 Then
RS.Open "SELECT * FROM Tbl_UU WHERE Nomor=12 and nomorUU=" + NomorUU.Text + " and tahun between " + TAHUN.Text + " and " + TahunSD.Text + " ORDER BY NOMOR,NO_URUT dESC", db, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = RS
Call WARNA
If Not RS.RecordCount = 0 Then
Label6.Caption = "Ditemukan " & RS.RecordCount & " Peraturan Undang-Undang"
Else
Label6.Caption = "Tidak ditemukan Peraturan Undang-Undang "
End If
Else
RS.Open "SELECT * FROM Tbl_UU WHERE Nomor=12 and tahun between " + TAHUN.Text + " and " + TahunSD.Text + " ORDER BY NOMOR,NO_URUT dESC", db, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = RS
Call WARNA
If Not RS.RecordCount = 0 Then
Label6.Caption = "Ditemukan " & RS.RecordCount & " Peraturan Undang-Undang"
Else
Label6.Caption = "..Pencarian Tidak ditemukan.."
End If
End If
If Not Len(Tentang.Text) = 0 Then
Set RS = Nothing
gabung = Trim("%") & Tentang.Text & Trim("%")
RS.Open "SELECT * FROM Tbl_UU where tentang like '" + gabung + "' and tahun between " + TAHUN.Text + " and " + TahunSD.Text + " and nomor=12 ORDER BY NOMOR,NO_URUT dESC", db, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = RS
Call WARNA
If Not RS.RecordCount = 0 Then
Label6.Caption = "Ditemukan " & RS.RecordCount & " Peraturan Undang-Undang"
Else
Label6.Caption = "Tidak ditemukan Peraturan Undang-Undang "
End If
End If
Set RS = Nothing
If Not Len(Tentang.Text) = 0 And Not Len(NomorUU.Text) = 0 Then
gabung = Trim("%") & Tentang.Text & Trim("%")
RS.Open "SELECT * FROM Tbl_UU where tentang like '" + gabung + "' and tahun between " + TAHUN.Text + " and " + TahunSD.Text + " and nomor=12 and nomoruu=" + NomorUU.Text + " ORDER BY NOMOR,NO_URUT dESC", db, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = RS
Call WARNA
If Not RS.RecordCount = 0 Then
Label6.Caption = "Ditemukan " & RS.RecordCount & " Peraturan Undang-Undang"
Else
Label6.Caption = "Tidak ditemukan Peraturan Undang-Undang "
End If
End If
Call TENGAH
End Sub
Private Sub mshflexgrid1_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
End Sub
Private Sub CommandButton1_Click()
Call tombol2
Set RS = Nothing
gabung = Tentang.Text & bintang
If Not Len(NomorUU.Text) = 0 Then
RS.Open "SELECT * FROM Tbl_UU WHERE NOMOR =1 and nomorUU=" + NomorUU.Text + " and tahun between " + TAHUN.Text + " and " + TahunSD.Text + " ORDER BY NOMOR,NO_URUT DESC", db, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = RS
Call WARNA
If Not RS.RecordCount = 0 Then
Label6.Caption = "Ditemukan " & RS.RecordCount & " Peraturan Undang-Undang"
Else
Label6.Caption = "Tidak ditemukan Peraturan Undang-Undang "
End If
Else
RS.Open "SELECT * FROM Tbl_UU WHERE NOMOR=1 and tahun between " + TAHUN.Text + " and " + TahunSD.Text + " ORDER BY NOMOR,NO_URUT DESC", db, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = RS
Call WARNA
If Not RS.RecordCount = 0 Then
Label6.Caption = "Ditemukan " & RS.RecordCount & " Peraturan Undang-Undang"
Else
Label6.Caption = "..Pencarian Tidak ditemukan.."
End If
End If
If Not Len(Tentang.Text) = 0 Then
Set RS = Nothing
gabung = Trim("%") & Tentang.Text & Trim("%")
RS.Open "SELECT * FROM Tbl_UU where tentang like '" + gabung + "' and tahun between " + TAHUN.Text + " and " + TahunSD.Text + " and NOMOR =1 ORDER BY NOMOR,NO_URUT", db, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = RS
Call WARNA
If Not RS.RecordCount = 0 Then
Label6.Caption = "Ditemukan " & RS.RecordCount & " Peraturan Undang-Undang"
Else
Label6.Caption = "Tidak ditemukan Peraturan Undang-Undang "
End If
End If
Set RS = Nothing
If Not Len(Tentang.Text) = 0 And Not Len(NomorUU.Text) = 0 Then
gabung = Trim("%") & Tentang.Text & Trim("%")
RS.Open "SELECT * FROM Tbl_UU where tentang like '" + gabung + "' and tahun between " + TAHUN.Text + " and " + TahunSD.Text + " and NOMOR=1 and nomoruu=" + NomorUU.Text + "ORDER BY NOMOR,NO_URUT", db, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = RS
Call WARNA
If Not RS.RecordCount = 0 Then
Label6.Caption = "Ditemukan " & RS.RecordCount & " Peraturan Undang-Undang"
Else
Label6.Caption = "Tidak ditemukan Peraturan Undang-Undang "
End If
End If
Call TENGAH
End Sub
Private Sub Form_GotFocus()
'Select Case nilaikini
MsgBox "DODOL"
End Sub
Private Sub Hapus_MouseClick()
'On Error Resume Next
X = MsgBox("Yakin akan hapus Data " + MSHFlexGrid1.Text + " ini..?", vbYesNo + vbQuestion, "Konfirmasi")
If X = vbYes Then
Form2.Show
Select Case VnilaiTombol.Text
Case 0
DEL1 = "delete * from Tbl_UU where TENTANG='" + Trim(Form2.Tentang.Text) + "'"
db.Execute DEL1
MsgBox "Sukses.."
Set RS = Nothing
RS.Open "SELECT * FROM Tbl_UU ORDER BY NOMOR,NO_URUT DESC", db, adOpenStatic, adLockOptimistic
RS.Requery
Set MSHFlexGrid1.DataSource = RS
MSHFlexGrid1.Refresh
Call WARNA
Case Else
del2 = "delete * from Tbl_UU where TENTANG='" + Form2.Tentang.Text + "' AND NOMOR=" + VnilaiTombol.Text + ""
db.Execute del2
Unload Form2
MsgBox "Sukses.."
Set RS = Nothing
RS.Open "SELECT * FROM Tbl_UU where Nomor=" + VnilaiTombol.Text + " ORDER BY NOMOR,NO_URUT DESC", db, adOpenStatic, adLockOptimistic
RS.Requery
Set MSHFlexGrid1.DataSource = RS
Call WARNA
End Select
Unload Form2
End If
End Sub
Private Sub Image5_Click()
End Sub
Private Sub Image6_Click()
End Sub
Private Sub MSHFlexGrid1_Click()
JENIS.Text = MSHFlexGrid1.Text
End Sub
Private Sub MSHFlexGrid1_DblClick()
On Error GoTo salah
MSHFlexGrid1.Col = 4
vNAMAFILE.Text = App.Path & "\DOC\" + Trim(MSHFlexGrid1.Text) + ""
'Print App.Path & vNAMAFILE.Text
OLE1.CreateLink (vNAMAFILE.Text)
OLE1.DoVerb
Exit Sub
salah:
X = MsgBox(" TIDAK / BELUM ADA FILE DOKUMEN", vbOKOnly + vbInformation, "INFORMASI")
End Sub
Private Sub MSHFlexGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MSHFlexGrid1.ToolTipText = MSHFlexGrid1.Text
End Sub
Private Sub mshflexgrid1_Validate(Cancel As Boolean)
Call WARNA
End Sub
Private Sub Form_Activate()
Call TENGAH
MSHFlexGrid1.RowHeight(0) = 500
MSHFlexGrid1.ColWidth(0) = 4100
MSHFlexGrid1.ColWidth(1) = 10000
MSHFlexGrid1.ColWidth(2) = 20
MSHFlexGrid1.ColWidth(3) = 20
MSHFlexGrid1.ColWidth(4) = 20
MSHFlexGrid1.ColWidth(5) = 20
MSHFlexGrid1.ColWidth(6) = 20
MSHFlexGrid1.ColWidth(7) = 20
MSHFlexGrid1.ColWidth(8) = 20
MSHFlexGrid1.ColWidth(9) = 20
MSHFlexGrid1.ColWidth(10) = 20
MSHFlexGrid1.ColWidth(11) = 20
MSHFlexGrid1.ColWidth(12) = 20
MSHFlexGrid1.ColWidth(13) = 20
Dim X, Y As Integer
For X = 1945 To 2008
TAHUN.AddItem X
Next
For Y = 2008 To 1945 Step -1
TahunSD.AddItem Y
Next
TahunSD.Text = 2008
TAHUN.Text = 1945
Select Case VnilaiTombol.Text
Case 0
Command1_Click
Case 1
Command2.SetFocus
Command2_Click
Case 2
Command3.SetFocus
Command3_Click
Command3_Click
Case 3
Command4.SetFocus
Command4_Click
Command4_Click
Case 4
Command5.SetFocus
Command5_Click
Command5_Click
Case 5
Command6.SetFocus
Command6_Click
Command6_Click
Case 6
Command7.SetFocus
Command7_Click
Command7_Click
Case 7
Command8.SetFocus
Command8_Click
Command8_Click
Case 8
Command9.SetFocus
Command9_Click
Command9_Click
Case 10
Command11.SetFocus
Command11_Click
Command11_Click
Case 11
Command12.SetFocus
Command12_Click
Command12_Click
Case 12
Command13.SetFocus
Command13_Click
Case 13
Command14.SetFocus
Command14_Click
Command14_Click
End Select
End Sub
Private Sub Form_Load()
On Error Resume Next
db.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path & "\dbkehutanan.mdb" + ";Persist Security Info=false;"
db.CursorLocation = adUseClient
RS.Open "SELECT * FROM Tbl_UU ORDER BY ORDER BY NOMOR,NO_URUT dESC", db, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = RS
For X = 1 To RS.RecordCount
If RS!Status = 0 Then
MSHFlexGrid1.Col = 0
MSHFlexGrid1.Row = X
MSHFlexGrid1.CellForeColor = &HFF&
MSHFlexGrid1.Col = 1
MSHFlexGrid1.Row = X
MSHFlexGrid1.CellForeColor = &HFF&
Else
MSHFlexGrid1.ForeColor = &H0&
End If
RS.MoveNext
Next
VnilaiTombol.Text = 0
Label6.Caption = "Ditemukan " & RS.RecordCount & " Peraturan Undang-Undang"
nilaikini = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set db = Nothing
Set RS = Nothing
End Sub
Private Sub Keluar_MouseClick()
Unload Me
End Sub
Private Sub NomorUU_KeyPress(KeyAscii As MSForms.ReturnInteger)
If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or _
KeyAscii = 8 Or _
KeyAscii = 44) Then KeyAscii = 0
If KeyAscii = 44 And llKoma Then KeyAscii = 0
End Sub
Private Sub NomorUU_LostFocus()
NomorUU.Text = Trim(NomorUU.Text)
End Sub
Private Sub Tentang_LostFocus()
Tentang.Text = Trim(Tentang.Text)
End Sub
Private Sub Text1_GotFocus()
If nilaikini = True Then
MsgBox "TEXT"
End If
End Sub
Private Sub TmbEdit_MouseClick()
If Not VnilaiTombol.Text = 0 Then
nilaitombolnya = 2
FormEDIT.Show
Else
MsgBox "..Pilih salah satu jenis Peraturan dahulu"
End If
End Sub
