Random post

Home Program Visual Basic Penerimaan Siswa Baru Sekolah Mengemudi √ Isyarat Listing Form Data User Penerimaan Siswa Gres Sekolah Mengemudi

Thursday, November 1, 2018

√ Isyarat Listing Form Data User Penerimaan Siswa Gres Sekolah Mengemudi

Diterbitkan

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

Pertama Silahkan Buat form dibawah ini, dan ubah name pada propertiesnya :
Catatan :
A. buat textbox gres 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 gres sekolah mengemudi
Sumber http://www.hendrisetiawan.com

Artikel Terkait

hiyahiya

Next Post
Previous Post