Setelah kita melihat contoh program aplikasi penerimaan siswa baru pada sekolah mengemudi abie stir karawang menggunakan visual basic. saya akan memberikan kode listingnya (sourcecode).
Berikut ini adalah source code/ kode listing form user.

Pertama Silahkan Buat form dibawah ini, dan ubah name pada propertiesnya :
Catatan :
A. buat textbox baru dan beri name "tusername2" pada propertiesnya Visible=false
B. Pada components tambahkan :
- crystal report control,
- microsoft hierarchical flexgrid control 6.0,
- microsoft windows common control 6.0,
- microsoft windows common control-2 6.0
C. Tabel Menggunakan microsoft hierarchical flexgrid control 6.0,
D. Tambahkan Timer

1. Klik pada cbtambah dan pastekan kodingnya :
Private Sub cbtambah_Click()
Call koneksi
Call bersih
Call aktif

 rsdatauser.Open "select*from tuser order by kodeuser desc", KON
With rsdatauser
 If .BOF And .EOF Then
  tkodeuser.Text = "USR" + "01"
  Else
   tkodeuser.Text = "USR" + Right(Str(Val(Right(.Fields("kodeuser"), 2)) + 101), 2)
   End If
   End With
   tkodeuser.Enabled = False
tnamauser.SetFocus
cbbatal.Enabled = True
cbsunting.Enabled = False
cbperbarui.Enabled = False
cbhapus.Enabled = False
Call tampil
tpassword.Enabled = True
cblevel.Enabled = True
cbtambah.Enabled = False
End Sub

 2. Klik pada cbsimpan dan pastekan koding berikut ini :
Call username
If tkodeuser.Text = "" Or tnamauser.Text = "" Or tusername.Text = "" Or cblevel.Text = "" Or tpassword.Text = "" Then
MsgBox "Data Belum terisi semua", vbCritical
ElseIf Len(tnamauser.Text) < 3 Then
MsgBox "Nama user harus lebih dari 2 karakter", vbCritical
tnamauser.SetFocus
ElseIf Len(tusername.Text) < 3 Then
MsgBox "Username harus lebih dari 2 karakter", vbCritical
tusername.SetFocus
ElseIf Len(tpassword.Text) < 3 Then
MsgBox "Agama harus lebih dari 2 karakter", vbCritical
tpassword.SetFocus
Else
Call simpan
End If

 3. Klik pada cbsunting dan pastekan koding berikut :
tusername2.Text = tusername.Text
Call koneksi
rsdatauser.Open "select*from tuser where kodeuser ='" & tcariusr.Text & "'", KON
With rsdatauser
 tkodeuser.Text = .Fields("kodeuser")
 tnamauser.Text = .Fields("namauser")
 tusername.Text = .Fields("username")
 tpassword.Text = .Fields("password")
  cblevel.Text = .Fields("level")
 End With
 Call aktif
 cblevel.Enabled = False
 tkodeuser.Enabled = False
 cbtambah.Enabled = False
 cbsimpan.Enabled = False
 cbhapus.Enabled = False
 cbsunting.Enabled = False

 4. Klik pada cbperbarui dan pastekan koding berikut :
If tkodeuser.Text = "" Or tnamauser.Text = "" Or tusername.Text = "" Or cblevel.Text = "" Or tpassword.Text = "" Then
MsgBox "Data Belum terisi semua", vbCritical
ElseIf Len(tnamauser.Text) < 3 Then
MsgBox "Nama user harus lebih dari 2 karakter", vbCritical
tnamauser.SetFocus
ElseIf Len(tusername.Text) < 3 Then
MsgBox "Username harus lebih dari 2 karakter", vbCritical
tusername.SetFocus
ElseIf Len(tpassword.Text) < 3 Then
MsgBox "Agama harus lebih dari 2 karakter", vbCritical
tpassword.SetFocus

 Else
Call username_perbarui

 End If

5. Klik pada cbhapus dan pastekan koding berikut :
Call koneksi
a = MsgBox("Yakin Ingin Hapus Data ini?", vbQuestion + vbYesNo, "tanya")
If a = vbYes Then
rsdatauser.Open "delete from tuser where kodeuser='" & tcariusr.Text & "'", KON
MsgBox "Data telah terhapus", vbInformation
bersih
tcariusr.Text = ""
Call nonaktif
cbtambah.Enabled = True
End If
Call tampil

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

7. Klik pada cbcariusr dan pastekan koding berikut :
Call koneksi
rsdatauser.Open "select*from tuser where kodeuser='" & tcariusr.Text & "'", KON
  If rsdatauser.EOF Then
MsgBox "Data Tidak Ditemukan", vbCritical
Call bersih
tcariusr.SetFocus
Else
With rsdatauser
 tkodeuser.Text = .Fields("kodeuser")
 tnamauser.Text = .Fields("namauser")
 tusername.Text = .Fields("username")
 tpassword.Text = .Fields("password")
  cblevel.Text = .Fields("level")
 End With
 Call nonaktif
  tkodeuser.Enabled = False
 cbsunting.Enabled = True
 cbhapus.Enabled = True
cbbatal.Enabled = True
If tkodeuser.Text = "USR01" Then
cbhapus.Enabled = False
cblevel.Enabled = False
End If
End If

8. Klik pada cetak dan pastekan koding berikut :
cr.ReportFileName = "D:\Perkuliahan\Tugas Akhir\Tugas Akhir\program\Laporan\datauser.rpt"
cr.WindowState = crptMaximized
cr.RetrieveDataFiles
cr.Action = 1

9. Klik pada bmenu dan pastekan koding berikut :
a = MsgBox("Yakin Untuk Menutup Form Ini Dan kembali ke Menu Utama ?", vbQuestion + vbYesNo, "INFO")
If a = vbYes Then
fuser.Hide
Call aktifadmin
End If

10. Buat Sub aktif dan pastekan koding berikut :
Sub aktif()
tkodeuser.Enabled = True
tnamauser.Enabled = True
tusername.Enabled = True
tpassword.Enabled = True
cblevel.Enabled = True
cbtambah.Enabled = True
cbsimpan.Enabled = True
cbsunting.Enabled = True
cbhapus.Enabled = True
cbperbarui.Enabled = True
cbbatal.Enabled = True
End Sub

 11. Buat Sub nonaktif dan pastekan koding berikut :
Sub nonaktif()
tkodeuser.Enabled = False
tnamauser.Enabled = False
tusername.Enabled = False
tpassword.Enabled = False
cblevel.Enabled = False
cbtambah.Enabled = False
cbsimpan.Enabled = False
cbsunting.Enabled = False
cbhapus.Enabled = False
cbperbarui.Enabled = False
cbbatal.Enabled = False
End Sub


12.Buat Sub username_perbarui dan pastekan koding berikut :
Sub username_perbarui()
Dim a As String
Call koneksi
rsdatauser.Open "select*from tuser where username='" & tusername & "'", KON

 If rsdatauser.EOF Then

 Call perbarui

 ElseIf tusername2.Text = tusername.Text Then
Call perbarui
Else
a = rsdatauser!username
MsgBox "Username " & a & "  Sudah Terisi", vbCritical, "SIMPAN"
tusername.SetFocus
End If
End Sub

13. Buat Sub perbarui dan pastekan koding berikut :
Sub perbarui()
Call koneksi

 rsdatauser.Open "update tuser set namauser='" & tnamauser & "',username='" & tusername & "',password='" & tpassword & "',level='" & cblevel & "' where kodeuser='" & tkodeuser.Text & "'", KON

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

14.Buat sub simpan dan pastekan koding berikut :
Sub simpan()
Call koneksi
rsdatauser.Open "insert into tuser values('" & tkodeuser & "','" & tnamauser & "','" & tusername & "','" & tpassword & "','" & cblevel & "')", KON
MsgBox "Data Sudah Tersimpan", vbInformation
Call tampil
Call bersih
Call nonaktif
cbtambah.Enabled = True
End Sub

15.Buat Sub aktifadmin dan pastekan koding berikut :
Sub aktifadmin()
fmenu.mlog.Enabled = True
fmenu.mganti.Enabled = True
    fmenu.mdata.Enabled = True
    fmenu.mdatauser.Enabled = True
    fmenu.mdatabiaya.Enabled = True
    fmenu.mdatasiswa.Enabled = False
    fmenu.mriwayat.Enabled = True
    fmenu.mlogout.Enabled = True
    fmenu.mloguser.Enabled = False
    fmenu.mmobil.Enabled = True
    fmenu.mjam.Enabled = True
End Sub

16. Buat Form load dan pastekan koding berikut :
Private Sub Form_Load()

 Me.Width = 11940
Me.Height = 9825
Call tampil
Call bersih
Call nonaktif
cbtambah.Enabled = True
Me.Left = 100
Me.Top = 0
 tkodeuser.MaxLength = 5
 tnamauser.MaxLength = 25
 tusername.MaxLength = 10
 tpassword.MaxLength = 5

 End Sub

17. Buat Sub Tampil dan pastekan koding berikut :
Sub tampil()
 Call koneksi
 rsdatauser.Open "select*from tuser", KON
 Set grid.DataSource = rsdatauser
End Sub

18. BUat Sub Bersih dan pastekan koding berikut :
Sub bersih()
tkodeuser.Text = Clear
tnamauser.Text = Clear
tusername.Text = Clear
tpassword.Text = Clear
tcariusr.Text = Clear
End Sub

19. Buat Sub username dan pastekan koding berikut :
Sub username()
Call koneksi
rsdatauser.Open "select*from tuser where username='" & tusername.Text & "'", KON
If rsdatauser.EOF Then
tpassword.Enabled = True
cblevel.Enabled = True
Else
MsgBox "Username tidak tersedia", vbCritical
tusername.Text = ""
tusername.SetFocus
End If
End Sub



Lihat Juga : Database penerimaan siswa baru sekolah mengemudi