Koding Form 1 Lampu
Private Sub Command1_Click()
If no_antri_panggil < no_antri Then
no_antri_panggil = no_antri_panggil + 1
Label4.Caption = no_antri_panggil
txtTerbilang.Text = Trim(Bilang(Label4.Caption))
Text1.Text = Trim(Bilang(Label4.Caption))
Call panggil_L1
no_antri = no_antri - 1
Label9.Caption = no_antri
End If
End Sub
Sub panggil_L2()
Dim arrJumlahKarakterSpasi() As String
arrJumlahKarakterSpasi = Split(txtTerbilang.Text, " ")
Call sndPlaySound(App.Path & "\Sounds\nomor-urut.wav", SND_NOSTOP)
For i = LBound(arrJumlahKarakterSpasi) To UBound(arrJumlahKarakterSpasi)
Call sndPlaySound(App.Path & "\Sounds\" & arrJumlahKarakterSpasi(i) & ".wav", SND_NOSTOP)
Next
Call sndPlaySound(App.Path & "\Sounds\loket.wav", SND_NOSTOP)
Call sndPlaySound(App.Path & "\Sounds\dua.wav", SND_NOSTOP)
End Sub
Private Sub Command2_Click()
Dim arrJumlahKarakterSpasi() As String
arrJumlahKarakterSpasi = Split(Text1.Text, " ")
Call sndPlaySound(App.Path & "\Sounds\nomor-urut.wav", SND_NOSTOP)
For i = 0 To UBound(arrJumlahKarakterSpasi)
Call sndPlaySound(App.Path & "\Sounds\" & arrJumlahKarakterSpasi(i) & ".wav", SND_NOSTOP)
Next
Call sndPlaySound(App.Path & "\Sounds\loket.wav", SND_NOSTOP)
Call sndPlaySound(App.Path & "\Sounds\satu.wav", SND_NOSTOP)
End Sub
Private Sub Command3_Click()
If no_antri_panggil < no_antri Then
no_antri_panggil = no_antri_panggil + 1
Label5.Caption = no_antri_panggil
txtTerbilang.Text = Trim(Bilang(Label5.Caption))
Text2.Text = Trim(Bilang(Label5.Caption))
Call panggil_L2
no_antri = no_antri - 1
Label9.Caption = no_antri
End If
End Sub
Private Sub Command4_Click()
Dim arrJumlahKarakterSpasi() As String
arrJumlahKarakterSpasi = Split(Text2.Text, " ")
Call sndPlaySound(App.Path & "\Sounds\nomor-urut.wav", SND_NOSTOP)
For i = 0 To UBound(arrJumlahKarakterSpasi)
Call sndPlaySound(App.Path & "\Sounds\" & arrJumlahKarakterSpasi(i) & ".wav", SND_NOSTOP)
Next
Call sndPlaySound(App.Path & "\Sounds\loket.wav", SND_NOSTOP)
Call sndPlaySound(App.Path & "\Sounds\dua.wav", SND_NOSTOP)
End Sub
Private Sub Command5_Click()
no_antri = 0
no_antri_panggil = 0
Label4.Caption = no_antri_panggil
Label5.Caption = no_antri_panggil
Label3.Caption = no_antri
Label9.Caption = no_antri
Text1.Text = ""
Text2.Text = ""
Command6.Enabled = False
End Sub
Private Sub Command6_Click()
Label3.Visible = True
Label6.Visible = False
no_antri = no_antri + Val(Textantri.Text)
Label3.Caption = no_antri
Label9.Caption = no_antri
End Sub
Private Sub Command7_Click()
Form2.Show
Label3.Visible = False
Label6.Visible = True
End Sub
Private Sub Form_Load()
Me.KeyPreview = True
no_antri = 0
no_antri_panggil = 0
Sounds(1) = App.Path & "\Sounds\satu.wav"
Sounds(2) = App.Path & "\Sounds\dua.wav"
Sounds(3) = App.Path & "\Sounds\tiga.wav"
Sounds(4) = App.Path & "\Sounds\empat.wav"
Sounds(5) = App.Path & "\Sounds\lima.wav"
Sounds(6) = App.Path & "\Sounds\enam.wav"
Sounds(7) = App.Path & "\Sounds\tujuh.wav"
Sounds(8) = App.Path & "\Sounds\delapan.wav"
Sounds(9) = App.Path & "\Sounds\sembilan.wav"
Sounds(10) = App.Path & "\Sounds\sepuluh.wav"
Sounds(11) = App.Path & "\Sounds\sebelas.wav"
Sounds(12) = App.Path & "\Sounds\puluh.wav"
Sounds(13) = App.Path & "\Sounds\ratus.wav"
Sounds(14) = App.Path & "\Sounds\belas.wav"
Sounds(15) = App.Path & "\Sounds\nomor-urut.wav"
Sounds(16) = App.Path & "\Sounds\loket.wav"
End Sub
Private Sub mnAbout_Click()
aboutcompany.Show
End Sub
Private Sub mnExit_Click()
End
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call Command6_Click
If KeyAscii = 43 Then Call Command7_Click
If KeyAscii = 49 Then Call Command1_Click
If KeyAscii = 50 Then Call Command2_Click
If KeyAscii = 51 Then Call Command3_Click
If KeyAscii = 52 Then Call Command4_Click
End Sub
Koding Form 2 Lampu
Dim no_antri, no_antri_panggil As Integer
Private Sub Command1_Click()
Form1.Textantri = Text1.Text
Form1.Command6.Enabled = True
Unload Me
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
Text1.Text = ""
End Sub
Koding Password Lampu Merah
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub txtPass_KeyPress(KeyAscii As Integer)
Static Kesempatan As Integer
If KeyAscii <> 13 Then Exit Sub
With txtPass
If .Text = "santos" Then
Unload Me
frmUtama.Show
Else
MsgBox "PASSWORD YANG ANDA ISIKAN SALAH...", vbCritical, "IZIN AKSES DITOLAK"
.Text = ""
.SetFocus
Kesempatan = Kesempatan + 1
If Kesempatan = 3 Then
MsgBox "MAAF!! ANDA TIDAK BERHAK MENGGUNAKAN PROGRAM INI...", vbCritical, "PROGRAM DITUTUP"
Kesempatan = 0: End
End If
End If
End With
End Sub
Koding Lampu Form Utama
Private Declare Function Inp Lib "inpout32.dll" _
Alias "Inp32" (ByVal PortAddress As Integer) As Integer
Private Declare Sub Out Lib "inpout32.dll" _
Alias "Out32" (ByVal PortAddress As Integer, ByVal Value As Integer)
Dim pantul As Integer
Dim idxLampuHijau As Integer
Private Sub LampuMati()
Dim ctl As Control
Out &H378, 256
Out &H37A, 11
For Each ctl In Me.Controls
If TypeOf ctl Is Shape Then
If ctl.Name = "shpLampuMerah" Then ctl.BackColor = RGB(70, 0, 0)
If ctl.Name = "shpLampuKuning" Then ctl.BackColor = RGB(70, 70, 0)
If ctl.Name = "shpLampuHijau" Then ctl.BackColor = RGB(0, 70, 0)
End If
Next
End Sub
Private Sub LampuMerahNyala(Index As Integer)
Select Case Index
Case 0
Out &H378, 1 + Val(Inp(&H378))
Case 1
Out &H378, 2 + Val(Inp(&H378))
Case 2
Out &H378, 4 + Val(Inp(&H378))
Case 3
Out &H378, 8 + Val(Inp(&H378))
End Select
shpLampuMerah(Index).BackColor = vbRed
End Sub
Private Sub LampuMerahMati(Index As Integer)
Select Case Index
Case 0
Out &H378, Val(Inp(&H378)) - 1
Case 1
Out &H378, Val(Inp(&H378)) - 2
Case 2
Out &H378, Val(Inp(&H378)) - 4
Case 3
Out &H378, Val(Inp(&H378)) - 8
End Select
shpLampuMerah(Index).BackColor = RGB(50, 0, 0)
End Sub
Private Sub LampuKuningNyala(Index As Integer)
Select Case Index
Case 0
Out &H378, 16 + Val(Inp(&H378))
Case 1
Out &H378, 32 + Val(Inp(&H378))
Case 2
Out &H378, 64 + Val(Inp(&H378))
Case 3
Out &H378, 128 + Val(Inp(&H378))
End Select
shpLampuKuning(Index).BackColor = vbYellow
End Sub
Private Sub LampuKuningMati(Index As Integer)
Select Case Index
Case 0
Out &H378, Val(Inp(&H378)) - 16
Case 1
Out &H378, Val(Inp(&H378)) - 32
Case 2
Out &H378, Val(Inp(&H378)) - 64
Case 3
Out &H378, Val(Inp(&H378)) - 128
End Select
shpLampuKuning(Index).BackColor = RGB(50, 50, 0)
End Sub
Private Sub LampuHijauNyala(Index As Integer)
ResetArahAnim
Select Case Index
Case 0
Out &H37A, 3
idxLampuHijau = 0
Case 1
Out &H37A, 15
idxLampuHijau = 1
Case 2
Out &H37A, 9
idxLampuHijau = 2
Case 3
Out &H37A, 10
idxLampuHijau = 3
End Select
shpLampuHijau(Index).BackColor = vbGreen
tmrArah.Enabled = True
End Sub
Private Sub LampuHijauMati(Index As Integer)
tmrArah.Enabled = False
ResetArahAnim
Select Case Index
Case 0
Out &H37A, 11
Case 1
Out &H37A, 11
Case 2
Out &H37A, 11
Case 3
Out &H37A, 11
End Select
shpLampuHijau(Index).BackColor = RGB(0, 50, 0)
End Sub
Private Sub cmdExit_Click()
Unload Me
MsgBox "TERIMAKASIH TELAH MENCOBA PROGRAM INI"
End Sub
Private Sub cmdRun_Click()
Dim intNum As Integer
LampuMati
tmrLampu.Interval = 1
tmrLampu.Enabled = True
End Sub
Private Sub cmdStop_Click()
tmrArah.Enabled = False
LampuMati
tmrLampu.Enabled = False
End Sub
Private Sub ResetArahAnim()
With lblArahAnim(0)
.Move 0 - .Width, (picArah(0).ScaleHeight - .Height) / 2
End With
With lblArahAnim(1)
.Move (picArah(1).ScaleWidth - .Width) / 2, 0 - .Height
End With
With lblArahAnim(2)
.Move picArah(2).ScaleWidth + .Width, (picArah(2).ScaleHeight - .Height) / 2
End With
With lblArahAnim(3)
.Move (picArah(3).ScaleWidth - .Width) / 2, picArah(3).ScaleHeight + .Height
End With
End Sub
Private Sub Form_Load()
ResetArahAnim
LampuMati
blnHijau = True
blnKuning = False
blnMerah = False
pantul = 100
End Sub
Private Sub Form_Unload(Cancel As Integer)
LampuMati
End Sub
Private Sub lblLampuHijau_Click(Index As Integer)
LampuMati
LampuHijauNyala Index
End Sub
Private Sub lblLampuHijau_DblClick(Index As Integer)
LampuHijauMati Index
End Sub
Private Sub lblLampuKuning_Click(Index As Integer)
LampuMati
LampuKuningNyala Index
End Sub
Private Sub lblLampuKuning_DblClick(Index As Integer)
LampuKuningMati Index
End Sub
Private Sub lblLampuMerah_Click(Index As Integer)
LampuMati
LampuMerahNyala Index
End Sub
Private Sub lblLampuMerah_DblClick(Index As Integer)
LampuMerahMati Index
End Sub
Private Sub tmrAnim_Timer()
With lblJudul
.Left = .Left + pantul
If .Left < 0 Then pantul = 100
If .Left > Me.ScaleWidth - .Width Then pantul = -100
End With
End Sub
Private Sub tmrArah_Timer()
With lblArahAnim(idxLampuHijau)
Select Case idxLampuHijau
Case 0
.Left = .Left + 20
If .Left > picArah(idxLampuHijau).ScaleWidth Then .Left = 0 - .Width
Case 1
.Top = .Top + 20
If .Top > picArah(idxLampuHijau).ScaleHeight Then .Top = 0 - .Height
Case 2
.Left = .Left - 20
If .Left < 0 - .Width Then .Left = picArah(idxLampuHijau).ScaleWidth
Case 3
.Top = .Top - 20
If .Top < 0 - .Height Then .Top = picArah(idxLampuHijau).ScaleHeight
End Select
End With
End Sub
Private Sub tmrLampu_Timer()
Static Index As Integer
Static intLampu As Integer
Dim intNum As Integer
Select Case intLampu
Case 0 'Hijau
LampuMati
tmrLampu.Interval = Val(txtHijau(Index).Text) * 1000
LampuHijauNyala Index
For intNum = 0 To 3
If intNum <> Index Then LampuMerahNyala intNum
Next
intLampu = 1
Case 1 'Kuning
LampuMati
tmrLampu.Interval = Val(txtKuning(Index).Text) * 1000
LampuKuningNyala Index
For intNum = 0 To 3
If intNum <> Index Then LampuMerahNyala intNum
Next
intLampu = 0
Index = Index + 1
If Index = 4 Then Index = 0
End Select
End Sub
Private Sub txtHijau_Change(Index As Integer)
With txtHijau(Index)
If IsNumeric(.Text) = False Then SendKeys vbBack: Exit Sub
End With
End Sub
Private Sub txtKuning_Change(Index As Integer)
With txtKuning(Index)
If IsNumeric(.Text) = False Then SendKeys vbBack: Exit Sub
End With
End Sub