Wednesday, October 31, 2018

√ Aba-Aba Listing Form Siswa Penerimaan Siswa Gres Sekolah Mengemudi Vb6

Setelah kita melihat contoh jadwal aplikasi penerimaan siswa gres pada sekolah mengemudi abie stir karawang menggunakan visual basic. aku akan menunjukkan isyarat listingnya (sourcecode).
Berikut ini ialah source code/ isyarat listing form user.

Pertama Silahkan Buat form dibawah ini, dan ubah name pada propertiesnya :

Catatan :
A. Pada components tambahkan :
- crystal report control (beri name cr)
- microsoft hierarchical flexgrid control 6.0,
- microsoft windows common control 6.0,
- microsoft windows common control-2 6.0
B. Tabel Menggunakan microsoft hierarchical flexgrid control 6.0,
C. Tambahkan Timer
D. Pada tgllahir, pada propertiesnya
- Maxdate= 2030-12-31
- Mindate= 1935-01-01
E. Pada cbjenis, pada propertiesnya
- Listnya tambahkan laki-laki dan wanita
F. Pada tanggal lahir memakai DT Picker
G. Simpan form dengan nama "fsiswa"


1. Klik pada cbtambah dan pastekan kodingnya :
Call koneksi
Call bersih

rsdatasiswa.Open "select*from tsiswa order by nis desc", KON
With rsdatasiswa
 If .BOF And .EOF Then
  tnosiswa.Text = "TBK" + "001"
  Else
   tnosiswa.Text = "TBK" + Right(Str(Val(Right(.Fields("nis"), 3)) + 1001), 3)
   End If
   End With
tnosiswa.Enabled = False
cbjenis.Enabled = False
cbbatal.Enabled = True
cbsunting.Enabled = False
cbperbarui.Enabled = False
cbhapus.Enabled = False
tsimc.Enabled = False
cbtambah.Enabled = False
tagama.Enabled = False
tnamasiswa.Enabled = True
tnamasiswa.SetFocus
ttl.Enabled = True
tgllahir.Enabled = True


Call tampil

2. Klik pada cbsimpan dan pastekan kodingnya :
If tnosiswa.Text = "" Or tnamasiswa.Text = "" Or ttl.Text = "" Or cbjenis.Text = "" Or tagama.Text = "" Or tnoktp.Text = "" Or tnohp.Text = "" Or tpekerjaan.Text = "" Or tpendidikan.Text = "" Then
MsgBox "Data Belum terisi semua", vbCritical
ElseIf Len(tnamasiswa.Text) < 3 Then
MsgBox "Nama siswa harus lebih dari 2 karakter", vbCritical
tnamasiswa.SetFocus
ElseIf Len(ttl.Text) < 4 Then
MsgBox "Tempat lahir harus lebih dari 3 karakter", vbCritical
ttl.SetFocus
ElseIf Len(tagama.Text) < 3 Then
MsgBox "Agama harus lebih dari 2 karakter", vbCritical
tagama.SetFocus
ElseIf Len(talamat.Text) < 10 Then
MsgBox "Alamat harus lebih dari 9 karakter", vbCritical
talamat.SetFocus
ElseIf Len(tnoktp.Text) < 16 Then
MsgBox "No KTP  harus 16 karakter", vbCritical
tnoktp.SetFocus
ElseIf Len(tnohp.Text) < 11 Then
MsgBox "No Hp harus lebih dari 10 karakter", vbCritical
tnohp.SetFocus
ElseIf Len(tpekerjaan.Text) < 3 Then
MsgBox "Pekerjaan harus lebih dari 2 karakter", vbCritical
tpekerjaan.SetFocus
ElseIf Len(tpendidikan.Text) < 3 Then
MsgBox "Pendidikan harus lebih dari 2 karakter", vbCritical
tpendidikan.SetFocus
ElseIf Len(ttl.Text) < 4 Then
MsgBox "Tempat lahir harus lebih dari 4 karakter", vbCritical
ttl.SetFocus
Else
     Call ktp
     End If

3. Klik pada cbsunting dan pastekan kodingnya :
tnoktp2.Text = tnoktp.Text
Call koneksi
rsdatasiswa.Open "select*from tsiswa where nis='" & tcari.Text & "'", KON
With rsdatasiswa
 tnosiswa.Text = .Fields("nis")
 tnamasiswa.Text = .Fields("namasiswa")
  ttl.Text = .Fields("tempatlahir")

 cbjenis.Text = .Fields("jenisk")
  tagama.Text = .Fields("agama")
  talamat.Text = .Fields("alamat")
   tnoktp.Text = .Fields("noktp")
    tnohp.Text = .Fields("nohp")
     tsimc.Text = .Fields("simc")
       tpekerjaan.Text = .Fields("pekerjaan")
        tpendidikan.Text = .Fields("pendidikan")
 End With
 Call aktif
 tnosiswa.Enabled = False
 cbtambah.Enabled = False
 cbsimpan.Enabled = False
 cbhapus.Enabled = False
 cbsunting.Enabled = False
 tsimc.Enabled = False

 tpekerjaan.Enabled = False
 tagama.Enabled = False
 tpendidikan.Enabled = False

4. Klik pada cbperbarui dan pastekan kodingnya :
If tnosiswa.Text = "" Or tnamasiswa.Text = "" Or ttl.Text = "" Or cbjenis.Text = "" Or talamat.Text = "" Or tagama.Text = "" Or tnoktp.Text = "" Or tnohp.Text = "" Or tpekerjaan.Text = "" Or tpendidikan.Text = "" Then
MsgBox "Data Belum terisi semua", vbCritical
ElseIf Len(tnamasiswa.Text) < 3 Then
MsgBox "Nama siswa harus lebih dari 2 karakter", vbCritical
tnamasiswa.SetFocus
ElseIf Len(ttl.Text) < 4 Then
MsgBox "Tempat lahir harus lebih dari 3 karakter", vbCritical
ttl.SetFocus
ElseIf Len(tagama.Text) < 3 Then
MsgBox "Agama harus lebih dari 2 karakter", vbCritical
tagama.SetFocus
ElseIf Len(talamat.Text) < 10 Then
MsgBox "Alamat harus lebih dari 9 karakter", vbCritical
talamat.SetFocus
ElseIf Len(tnoktp.Text) < 16 Then
MsgBox "No KTP  harus 16 karakter", vbCritical
tnoktp.SetFocus
ElseIf Len(tnohp.Text) < 11 Then
MsgBox "No Hp harus lebih dari 10 karakter", vbCritical
tnohp.SetFocus
ElseIf Len(tpekerjaan.Text) < 3 Then
MsgBox "Pekerjaan harus lebih dari 2 karakter", vbCritical
tpekerjaan.SetFocus
ElseIf Len(tpendidikan.Text) < 3 Then
MsgBox "Pendidikan harus lebih dari 2 karakter", vbCritical
tpendidikan.SetFocus
ElseIf Len(ttl.Text) < 4 Then
MsgBox "Tempat lahir harus lebih dari 4 karakter", vbCritical
ttl.SetFocus
Else
Call ktp_perbarui
End If

5. Klik pada cbhapus dan pastekan kodingnya :
Call koneksi
a = MsgBox("Yakin Ingin Hapus Data ini?", vbQuestion + vbYesNo, "tanya")
If a = vbYes Then
rsdatasiswa.Open "delete from tsiswa where nis='" & tcari.Text & "'", KON
bersih
tcari.Text = ""
MsgBox "Data Berhasil di hapus", vbInformation, "Info"
End If
Call nonaktif
cbtambah.Enabled = True
Call tampil


6. Klik pada cbbatal dan pastekan kodingnya :
Call bersih
Call nonaktif
cbtambah.Enabled = True


7. Klik pada cbcari dan pastekan kodingnya :
Call koneksi
rsdatasiswa.Open "select*from tsiswa where nis='" & tcari.Text & "'", KON

  If rsdatasiswa.EOF Then
MsgBox "Data Tidak Ditemukan", vbCritical
Call bersih
Call nonaktif
tcari.Enabled = True
cbcari.Enabled = True
tcari.SetFocus
cbtambah.Enabled = True
Else
With rsdatasiswa
 tnosiswa.Text = .Fields("nis")
 tnamasiswa.Text = .Fields("namasiswa")
 ttl.Text = .Fields("tempatlahir")

 cbjenis.Text = .Fields("jenisk")
  tagama.Text = .Fields("agama")
  talamat.Text = .Fields("alamat")
   tnoktp.Text = .Fields("noktp")
    tnohp.Text = .Fields("nohp")
     tsimc.Text = .Fields("simc")
       tpekerjaan.Text = .Fields("pekerjaan")
        tpendidikan.Text = .Fields("pendidikan")
 End With
 Call nonaktif
 tnosiswa.Enabled = False
 cbsunting.Enabled = True
 cbhapus.Enabled = True
cbbatal.Enabled = True
End If

8. Klik pada cetak dan pastekan kodingnya (sesuaikan alamat lokasi penempatan crystal reportnya) :
cr.ReportFileName = "D:\Perkuliahan\Tugas Akhir\Tugas Akhir\program\Laporan\datasiswa.rpt"
cr.WindowState = crptMaximized
cr.RetrieveDataFiles
cr.Action = 1


9. Klik pada tgllahir dan pastekan kodingnya (deklarasinya ubah ke change) :
Call valid_tgl

10. Klik pada bmenu dan pastekan kodingnya (deklarasinya ubah ke click) :
a = MsgBox("Yakin Untuk Menutup Form Ini Dan kembali ke Menu Utama ?", vbCritical + vbYesNo, "INFO")
If a = vbYes Then
fsiswa.Hide
Call aktifuser
End If

11. Klik pada dll dan pastekan kodingnya (deklarasinya ubah ke click) :
tagama.Enabled = True

12. Klik pada hindu dan pastekan kodingnya  (deklarasinya ubah ke click):
tagama.Text = "Hindu"
talamat.SetFocus
tagama.Enabled = False

13. Klik pada irt dan pastekan kodingnya  (deklarasinya ubah ke click):
tpekerjaan.Text = "IRT"
tpekerjaan.Enabled = False

14. Klik pada islam dan pastekan kodingnya  (deklarasinya ubah ke click):
tagama.Text = "Islam"
talamat.SetFocus
tagama.Enabled = False

15. Klik pada kristen dan pastekan kodingnya  (deklarasinya ubah ke click):
tagama.Text = "Kristen"
talamat.SetFocus
tagama.Enabled = False

16. Klik pada lainlain dan pastekan kodingnya  (deklarasinya ubah ke click):
tpekerjaan.Enabled = True

17. Klik pada mahasiswa dan pastekan kodingnya  (deklarasinya ubah ke click):
tpekerjaan.Text = "Mahasiswa"
tpekerjaan.Enabled = False

18. Klik pada pegawai dan pastekan kodingnya  (deklarasinya ubah ke click):
tpekerjaan.Text = "Pegawai"
tpekerjaan.Enabled = False

19. Klik pada pns dan pastekan kodingnya (deklarasinya ubah ke click):
tpekerjaan.Text = "PNS"
tpekerjaan.Enabled = False

20. Klik pada pt dan pastekan kodingnya  (deklarasinya ubah ke click):
tpendidikan.Text = "Perguruan Tinggi"
tpendidikan.Enabled = False

21. Klik pada sd dan pastekan kodingnya (deklarasinya ubah ke click) :
tpendidikan.Text = "SD"
tpendidikan.Enabled = False

22. Klik pada simc dan pastekan kodingnya  (deklarasinya ubah ke click):
If simc.Value = 1 Then
tsimc.Text = "Ada"
tsimc.Enabled = False
Else
tsimc.Text = "Tidak Ada"
tsimc.Enabled = False
End If

23. Klik pada sma dan pastekan kodingnya (deklarasinya ubah ke click) :
tpendidikan.Text = "SMA"
tpendidikan.Enabled = False

24. Klik pada smp dan pastekan kodingnya  (deklarasinya ubah ke click):
tpendidikan.Text = "SMP"
tpendidikan.Enabled = False

25. Klik pada wiraswasta dan pastekan kodingnya  (deklarasinya ubah ke click):
tpekerjaan.Text = "Wiraswasta"
tpekerjaan.Enabled = False

26. Klik pada budha dan pastekan kodingnya  (deklarasinya ubah ke click):
tagama.Text = "Budha"
talamat.SetFocus
tagama.Enabled = False

27. Klik pada tnoktp dan pastekan kodingnya  (deklarasinya ubah ke change):
If tnoktp.Text = "000000" Then
MsgBox "Maaf Data tidak Valid", vbCritical
tnoktp.Text = ""
Else
End If

28. Klik pada tnohp dan pastekan kodingnya  (deklarasinya ubah ke change):
If tnohp.Text = "00000000" Then
MsgBox "Maaf Data tidak Valid", vbCritical
tnohp.Text = ""
Else
End If

30. Buat SUB  form_load dan pastekan kodingnya  :
Call nonaktif
cbtambah.Enabled = True
tsimc.Enabled = False
Me.Left = 100
Me.Top = 0
tnamasiswa.MaxLength = 30
ttl.MaxLength = 35
tagama.MaxLength = 10
talamat.MaxLength = 40
tnoktp.MaxLength = 16
tnohp.MaxLength = 12
tpekerjaan.MaxLength = 20
Me.Width = 19350
Me.Height = 9645
Call tampil

31. Buat SUB valid_tgl dan pastekan kodingnya  :
Dim totalhari As Integer
  Dim umur As Integer
  Dim hari As Integer

  totalhari = DateDiff("d", tgllahir.Value, Date)
  tumur.Text = totalhari / 365
  hari = totalhari - (umur * 365)
  If tumur.Text <= 16 Then
  MsgBox "Umur Anda tidak Mencukupi, Minimal 17th & mempunyai KTP", vbCritical
  Call nonaktif
  tnamasiswa.Enabled = True
  ttl.Enabled = True
  tgllahir.Enabled = True
  tgllahir.SetFocus
ElseIf tumur.Text >= 71 Then
 MsgBox "Maksimal umur ialah 70th !", vbCritical
 Call nonaktif
  tnamasiswa.Enabled = True
  ttl.Enabled = True
  tgllahir.Enabled = True
  tgllahir.SetFocus

  Else
Call aktif
tagama.Enabled = False
tsimc.Enabled = False
tpekerjaan.Enabled = False
tpendidikan.Enabled = False
cbtambah.Enabled = False
cbsunting.Enabled = False
cbperbarui.Enabled = False
cbhapus.Enabled = False


tnosiswa.Enabled = False
  End If

32. Buat SUB ktp_perbarui dan pastekan kodingnya  :
Dim a As String
Call koneksi
rsdatasiswa.Open "select*from tsiswa where noktp='" & tnoktp & "'", KON

If rsdatasiswa.EOF Then

Call perbarui
ElseIf tnoktp2.Text = tnoktp.Text Then
Call perbarui

Else
a = rsdatasiswa!noktp
MsgBox "NO KTP " & a & "  Sudah Terisi", vbCritical, "SIMPAN"
tnoktp.SetFocus
End If

33. Buat SUB perbarui dan pastekan kodingnya  :
Call koneksi
rsdatasiswa.Open "update tsiswa set namasiswa='" & tnamasiswa & "',tempatlahir='" & ttl & "',tgllahir='" & tgllahir & "',jenisk='" & cbjenis & "',agama='" & tagama & "',alamat='" & talamat & "',noktp='" & tnoktp & "',nohp='" & tnohp & "',simc='" & tsimc & "',pekerjaan='" & tpekerjaan & "',pendidikan='" & tpendidikan & "' where nis='" & tnosiswa & "'", KON

MsgBox "Data Berhasil di Update", vbInformation, "Info"
bersih
Call tampil
Call nonaktif
cbtambah.Enabled = True

34. Buat SUB ktp dan pastekan kodingnya  :
Dim a As String
Call koneksi
rsdatasiswa.Open "select*from tsiswa where noktp='" & tnoktp & "'", KON

If rsdatasiswa.EOF Then

Call simpan

Else
a = rsdatasiswa!noktp
MsgBox "NO KTP " & a & "  Sudah Terisi", vbCritical, "SIMPAN"
tnoktp.SetFocus
End If

35. Buat SUB simpan dan pastekan kodingnya  :
Call koneksi


rsdatasiswa.Open "insert into tsiswa values('" & tnosiswa & "','" & tnamasiswa & "','" & ttl & "','" & tgllahir & "','" & cbjenis & "','" & tagama & "','" & talamat & "','" & tnoktp & "','" & tnohp & "','" & tsimc & "','" & tpekerjaan & "','" & tpendidikan & "')", KON
MsgBox "Data Sudah Tersimpan", vbInformation
Call tampil
Call bersih
Call nonaktif
cbtambah.Enabled = True


36. Buat SUB tampil dan pastekan kodingnya  :
Call koneksi
 rsdatasiswa.Open "select*from tsiswa", KON
 Set grid.DataSource = rsdatasiswa

37. Buat SUB higienis dan pastekan kodingnya  :
tnosiswa.Text = Clear
tnamasiswa.Text = Clear
ttl.Text = Clear

tagama.Text = Clear
talamat.Text = Clear
tnoktp.Text = Clear
tnohp.Text = Clear
tsimc.Text = "Tidak Ada"

tpekerjaan.Text = Clear
tpendidikan.Text = Clear
tcari.Text = Clear
simc.Value = False
islam.Value = False

kristen.Value = False
hindu.Value = False
budha.Value = False
dll.Value = False
pegawai.Value = False
wiraswasta.Value = False
mahasiswa.Value = False
pns.Value = False
irt.Value = False
sd.Value = False
smp.Value = False
sma.Value = False
pt.Value = False


38. Buat SUB aktif dan pastekan kodingnya  :
tnosiswa.Enabled = True
tnamasiswa.Enabled = True
ttl.Enabled = True
cbjenis.Enabled = True
tagama.Enabled = True
talamat.Enabled = True
tnoktp.Enabled = True
tnohp.Enabled = True
tsimc.Enabled = True

tpekerjaan.Enabled = True
tpendidikan.Enabled = True
tgllahir.Enabled = True
cbtambah.Enabled = True
cbsimpan.Enabled = True
cbsunting.Enabled = True
cbhapus.Enabled = True
cbperbarui.Enabled = True
cbbatal.Enabled = True
simc.Enabled = True

pegawai.Enabled = True
wiraswasta.Enabled = True
mahasiswa.Enabled = True
pns.Enabled = True
irt.Enabled = True
sd.Enabled = True
smp.Enabled = True
sma.Enabled = True
pt.Enabled = True
lainlain.Enabled = True
islam.Enabled = True
kristen.Enabled = True
hindu.Enabled = True
budha.Enabled = True
dll.Enabled = True

39. Buat SUB nonaktif dan pastekan kodingnya  :
tnosiswa.Enabled = False
tnamasiswa.Enabled = False
ttl.Enabled = False
cbjenis.Enabled = False
tagama.Enabled = False
talamat.Enabled = False
tnoktp.Enabled = False
tnohp.Enabled = False
tsimc.Enabled = False

tpekerjaan.Enabled = False
tpendidikan.Enabled = False
tgllahir.Enabled = False
cbtambah.Enabled = False
cbsimpan.Enabled = False
cbsunting.Enabled = False
cbhapus.Enabled = False
cbperbarui.Enabled = False
cbbatal.Enabled = False
simc.Enabled = False

pegawai.Enabled = False
wiraswasta.Enabled = False
mahasiswa.Enabled = False
pns.Enabled = False
irt.Enabled = False
sd.Enabled = False
smp.Enabled = False
sma.Enabled = False
pt.Enabled = False
lainlain.Enabled = False
islam.Enabled = False
kristen.Enabled = False
hindu.Enabled = False
budha.Enabled = False
dll.Enabled = False


40. Buat SUB aktifuser dan pastekan kodingnya  :
fmenu.mlog.Enabled = True
fmenu.mganti.Enabled = True
    fmenu.mdata.Enabled = True
    fmenu.mdatabiaya.Enabled = False
    fmenu.mdatauser.Enabled = False
    fmenu.mdatasiswa.Enabled = True
    fmenu.mjadwal.Enabled = True
    fmenu.mtransaksi.Enabled = True
    fmenu.mlaporan.Enabled = True
    fmenu.mlogout.Enabled = True
    fmenu.mloguser.Enabled = False
    fmenu.mmobil.Enabled = False
    fmenu.mjam.Enabled = False


41. Buat pengenalan dan pastekan kodingnya paling atas form   :
Dim a, b As String



Sumber http://www.hendrisetiawan.com