Source Code Aplikasi Peraturan Perundangan Bidang Kehutanan dengan Visual Basic

Source Code Aplikasi Peraturan Perundangan Bidang Kehutanan dengan Visual Basic

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