Materi Visual Basic sampai pada tanggal 28-11-2012 adalah tampilan seperti pada Form berikut :
Sedangkan Source Code nya adalah sebagai berikut :
Private Sub Command1_Click()
End
End Sub
Sub hitung_rata()
Dim hitung_rata As Double
hitung_rata = ((Val(txtjml_hadir.Text) / 14 * 100) + Val(txtn_tugas.Text) + Val(txtn_quis.Text) + Val(txtn_uts.Text) + Val(txtn_uas.Text)) / 5
txtn_rata.Text = Format(hitung_rata, "#,##0.00")
End Sub
Sub keterangan()
If Val(txtn_rata.Text) < 55 Then labelket.Caption = "Gagal" ElseIf Val(txtn_rata.Text) >= 55 Then
labelket.Caption = "Lulus"
Else
labelket.Caption = ""
End If
If Val(txtn_rata.Text) >= 85 Then
label_nilai.Caption = "A"
ElseIf Val(txtn_rata.Text) >= 70 Then
label_nilai.Caption = "B"
ElseIf Val(txtn_rata.Text) >= 55 Then
label_nilai.Caption = "C"
ElseIf Val(txtn_rata.Text) >= 40 Then
label_nilai.Caption = "D"
ElseIf Val(txtn_rata.Text) < 40 Then label_nilai.Caption = "E" Else label_nilai.Caption = "" End If End Sub
'---------------------------------------Penggunaan Change-------------------------------------------
Private Sub txtjml_hadir_Change()
Call hitung_rata End Sub Private Sub txtn_tugas_Change() Call hitung_rata End Sub Private Sub txtn_quis_Change() Call hitung_rata End Sub Private Sub txtn_uts_Change() Call hitung_rata End Sub Private Sub txtn_uas_Change() Call hitung_rata End Sub '------------Penggunaan Enter untuk Pindah (Object)/Text Box dan membatasi yang diinputkan hanya angka Private Sub txtjml_hadir_Keypress(keyascii As Integer) If keyascii = 13 Then If (txtjml_hadir.Text) > 14 Then
MsgBox "Jml. Hadir Maximal adalah 14 kali..., Periksa lagi inputan anda...", vbInformation, "Input Ditolak"
txtjml_hadir.SetFocus
SendKeys "{Home}+{End}"
Else
txtn_tugas.SetFocus
End If
End If
If Not (keyascii >= Asc("0") And keyascii <= Asc("9") Or keyascii = vbKeyBack) Then keyascii = 0 End Sub Private Sub txtn_tugas_Keypress(keyascii As Integer) If keyascii = 13 Then If (txtn_tugas.Text) > 100 Then
MsgBox "Nilai dalam range 100..., Periksa lagi inputan anda...", vbInformation, "Input Ditolak"
txtn_tugas.SetFocus
SendKeys "{Home}+{End}"
Else
txtn_quis.SetFocus
End If
End If
If Not (keyascii >= Asc("0") And keyascii <= Asc("9") Or keyascii = vbKeyBack) Then keyascii = 0 End Sub Private Sub txtn_quis_Keypress(keyascii As Integer) If keyascii = 13 Then If (txtn_quis.Text) > 100 Then
MsgBox "Nilai dalam range 100..., Periksa lagi inputan anda...", vbInformation, "Input Ditolak"
txtn_quis.SetFocus
SendKeys "{Home}+{End}"
Else
txtn_uts.SetFocus
End If
End If
If Not (keyascii >= Asc("0") And keyascii <= Asc("9") Or keyascii = vbKeyBack) Then keyascii = 0 End Sub Private Sub txtn_uts_Keypress(keyascii As Integer) If keyascii = 13 Then If (txtn_uts.Text) > 100 Then
MsgBox "Nilai dalam range 100..., Periksa lagi inputan anda...", vbInformation, "Input Ditolak"
txtn_uts.SetFocus
SendKeys "{Home}+{End}"
Else
txtn_uas.SetFocus
End If
End If
If Not (keyascii >= Asc("0") And keyascii <= Asc("9") Or keyascii = vbKeyBack) Then keyascii = 0 End Sub Private Sub txtn_uas_Keypress(keyascii As Integer) If keyascii = 13 Then If (txtn_uas.Text) > 100 Then
MsgBox "Nilai dalam range 100..., Periksa lagi inputan anda...", vbInformation, "Input Ditolak"
txtn_uas.SetFocus
SendKeys "{Home}+{End}"
Else
Call keterangan
cmdbaru.SetFocus
End If
End If
If Not (keyascii >= Asc("0") And keyascii <= Asc("9") Or keyascii = vbKeyBack) Then keyascii = 0 End Sub Sub kosong() txtjml_hadir.Text = "" txtn_tugas.Text = "" txtn_quis.Text = "" txtn_uts.Text = "" txtn_uas.Text = "" txtn_rata.Text = "" labelket.Caption = "" label_nilai.Caption = "" txtmatkul.Text = "" End Sub Private Sub cmdbaru_Click() Call kosong Call kosongnpm txtnpm.SetFocus End Sub '---------------------------------Tambahan untuk npm dan mahasiswa Sub kosongnpm() txtnpm.Text = "" txtnama.Text = "" cbprodi.Clear lbl_digitnpm.Caption = "" End Sub Sub isi_cbprodi() cbprodi.AddItem "Teknik Informatika, S-1" cbprodi.AddItem "Sistem Informasi, S-1" cbprodi.AddItem "Teknik Informatika, D-3" cbprodi.AddItem "Manajemen Informatika, D-3" cbprodi.AddItem "Komputerisasi Akuntansi, D-3" End Sub Private Sub form_activate() Call kosongnpm Call kosong txtnpm.SetFocus txtnpm.MaxLength = 10 End Sub Private Sub txtnpm_Keypress(keyascii As Integer) If keyascii = 13 Then If Len(txtnpm.Text) <> 10 Then
MsgBox "NPM harus 10 digit, cek lagi", vbInformation, "Akses Ditolak"
txtnpm.SetFocus
SendKeys "{End}"
Else
txtnama.SetFocus
SendKeys "{Home}"
End If
End If
'if Not (keyascii >= Asc("0") And keyascii <= Asc("9") Or keyascii = vbKeyBack) Then keyascii = 0 End Sub Private Sub txtnpm_change() Dim jmldigit As Integer jmldigit = Len(txtnpm.Text) lbl_digitnpm.Caption = Trim(jmldigit) + " Digit" End Sub Private Sub txtnama_Keypress(keyascii As Integer) If keyascii = 13 Then Call isi_cbprodi cbprodi.SetFocus SendKeys "{End}" End If End Sub Private Sub cbprodi_Keypress(keyascii As Integer) If keyascii = 13 Then txtmatkul.SetFocus SendKeys "{End}" End If 'if Not (keyascii >= Asc("0") And keyascii <= Asc("9") Or keyascii = vbKeyBack) Then keyascii = 0 End Sub Private Sub txtmatkul_Keypress(keyascii As Integer) If keyascii = 13 Then txtjml_hadir.SetFocus SendKeys "{End}" End If 'if Not (keyascii >= Asc("0") And keyascii <= Asc("9") Or keyascii = vbKeyBack) Then keyascii = 0 End Sub Private Sub timer1_timer() If lbl_digitnpm.Visible = False Then lbl_digitnpm.Visible = True Else lbl_digitnpm.Visible = False End If End Sub