Source Code :
Dim dbs As Database
Private Declare Function PlaySound Lib "winmm.dll"
Alias _
"PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long,
_
ByVal dwFlags
As Long) As Long
Public Function PlayWaveFile(strFileName As String, Optional
blnAsync As Boolean) As Boolean
Dim lngFlags As
Long
Const snd_sync =
&H0
Const snd_Async =
&H1
Const
snd_Nodefault = &H2
Const snd_Filename
= &H20000
lngFlags =
snd_Nodefault Or snd_Filename Or snd_sync
If blnAsync Then
lngFlags = lngFlags Or snd_Async
PlayWaveFile =
PlaySound(strFileName, 0&, lngFlags)
End Function
Private Sub a_Click()
Set dbs = OpenDatabase(App.Path &
"\pitakon.mdb")
Set rssoal = dbs.OpenRecordset("select * from
pertanyaan where id_pertanyaan = " & z.Text & "")
jawaban.Text = rssoal!jawaban
jawaban1.Text = "a"
If jawaban.Text = jawaban1.Text Then
nilai.Text = Val(nilai.Text) + 2
jaw.Caption = "Benar"
retval = PlayWaveFile(App.Path & "\yeah.wav",
True)
Else
jaw.Caption = "Salah"
retval = PlayWaveFile(App.Path & "\oh_no.wav",
True)
End If
z.Text = Val(z.Text) + 1
det.Text = "0"
End Sub
Private Sub b_Click()
Set dbs = OpenDatabase(App.Path &
"\pitakon.mdb")
Set rssoal = dbs.OpenRecordset("select * from
pertanyaan where id_pertanyaan = " & z.Text & "")
jawaban.Text = rssoal!jawaban
jawaban1.Text = "b"
If jawaban.Text = jawaban1.Text Then
nilai.Text = Val(nilai.Text) + 2
jaw.Caption = "Benar"
retval = PlayWaveFile(App.Path & "\yeah.wav",
True)
Else
jaw.Caption = "Salah"
retval = PlayWaveFile(App.Path & "\oh_no.wav",
True)
End If
z.Text = Val(z.Text) + 1
det.Text = "0"
End Sub
Private Sub baru_Click()
Dim na As String
na = InputBox("Masukkan nama anda", "Identitas")
nama.Caption = na
pertanyaan.Visible = True
a.Visible = True
b.Visible = True
c.Visible = True
d.Visible = True
e.Visible = True
nilai.Visible = True
Timer1.Interval = 1000
Picture1.Visible = False
z.Text = "1"
nilai.Text = "0"
End Sub
Private Sub c_Click()
Set dbs = OpenDatabase(App.Path &
"\pitakon.mdb")
Set rssoal = dbs.OpenRecordset("select * from
pertanyaan where id_pertanyaan = " & z.Text & "")
jawaban.Text = rssoal!jawaban
jawaban1.Text = "c"
If jawaban.Text = jawaban1.Text Then
nilai.Text = Val(nilai.Text) + 2
jaw.Caption = "Benar"
retval = PlayWaveFile(App.Path & "\yeah.wav",
True)
Else
jaw.Caption = "Salah"
retval = PlayWaveFile(App.Path & "\oh_no.wav",
True)
End If
z.Text = Val(z.Text) + 1
det.Text = "0"
End Sub
Private Sub d_Click()
Set dbs = OpenDatabase(App.Path &
"\pitakon.mdb")
Set rssoal = dbs.OpenRecordset("select * from
pertanyaan where id_pertanyaan = " & z.Text & "")
jawaban.Text = rssoal!jawaban
jawaban1.Text = "d"
If jawaban.Text = jawaban1.Text Then
nilai.Text = Val(nilai.Text) + 2
jaw.Caption = "Benar"
retval = PlayWaveFile(App.Path & "\yeah.wav",
True)
Else
jaw.Caption = "Salah"
retval = PlayWaveFile(App.Path & "\oh_no.wav",
True)
End If
z.Text = Val(z.Text) + 1
det.Text = "0"
End Sub
Private Sub e_Click()
Set dbs = OpenDatabase(App.Path &
"\pitakon.mdb")
Set rssoal = dbs.OpenRecordset("select * from
pertanyaan where id_pertanyaan = " & z.Text & "")
jawaban.Text = rssoal!jawaban
jawaban1.Text = "e"
If jawaban.Text = jawaban1.Text Then
nilai.Text = Val(nilai.Text) + 2
jaw.Caption = "Benar"
retval = PlayWaveFile(App.Path & "\yeah.wav",
True)
Else
jaw.Caption = "Salah"
retval = PlayWaveFile(App.Path & "\oh_no.wav",
True)
End If
z.Text = Val(z.Text) + 1
det.Text = "0"
End Sub
Private Sub Form_Load()
Timer1.Interval = 0
z.Text = "1"
jaw.Caption = "Benar atau Salah akan ditampilkan
disini"
pertanyaan.Visible = False
a.Visible = False
b.Visible = False
c.Visible = False
d.Visible = False
e.Visible = False
nilai.Visible = False
men.Text = "0"
det.Text = "0"
With penilaian1
.Row = 0
.Col = 0
.Text = "Nama"
.Row = 0
.Col = 1
.Text = "Nilai"
.Row = 0
.Col = 2
.Text = "Predikat"
.Row = 0
.Col = 3
.Text = "Waktu"
End With
baris.Text = penilaian1.Rows
End Sub
Private Sub keluar_Click()
Unload Me
End Sub
Private Sub Penilaian2_Click()
Picture1.Visible = False
End Sub
Private Sub Timer1_Timer()
det.Text = det.Text + 1
If det.Text > 60 Then
men.Text = men.Text + 1
det.Text = "0"
z.Text = Val(z.Text) + 1
End If
End Sub
Private Sub z_Change()
If z.Text <= 50 Then
Set dbs = OpenDatabase(App.Path &
"\pitakon.mdb")
Set rssoal = dbs.OpenRecordset("select * from
pertanyaan where id_pertanyaan = " & z.Text & "")
pertanyaan.Caption = rssoal!tanya
jawaban2.Text = rssoal!jawaban
a.Caption = "A. " + rssoal!a
b.Caption = "B. " + rssoal!b
c.Caption = "C. " + rssoal!c
d.Caption = "D. " + rssoal!d
e.Caption = "E. " + rssoal!e
a.Value = False
b.Value = False
c.Value = False
d.Value = False
e.Value = False
Else
predikat.Visible = True
If nilai.Text >= 90 Then
predikat.Caption = "Anda jenius sekali!!!!"
ElseIf nilai.Text < 90 And nilai.Text >= 70 Then
predikat.Caption = "Anda pintar sekali!!!!"
ElseIf nilai.Text < 70 And nilai.Text >= 40 Then
predikat.Caption = "Anda biasa sekali!"
ElseIf nilai.Text < 40 Then
predikat.Caption = "Goblok!!!!"
With penilaian1
penilaian1.Row = baris.Text - 1
penilaian1.Col = 0
penilaian1.Text = nama.Caption
penilaian1.Row = baris.Text - 1
penilaian1.Col = 1
penilaian1.Text = nilai.Text
penilaian1.Row = baris.Text - 1
penilaian1.Col = 2
penilaian1.Text = predikat.Caption
penilaian1.Row = baris.Text - 1
penilaian1.Col = 3
penilaian1.Text = men.Text & " : " & det.Text
baris.Text
= baris.Text + 1
penilaian1.Rows = baris.Text
End With
End If
MsgBox "Pertanyaan sudah selesai!nilai anda adalah
:" & nilai.Text & "", vbInformation, "Selesai"
Call Form_Load
Picture1.Visible = True
End If
det.Text = "0"
End Sub
Tulisan By Munirmaestro
Selamat datang Di Blog Saya,Mohon LIKE atau Follow agar saling Kenal...Terimah kasih
Tidak ada komentar:
Posting Komentar