Menjalankan file suara (.wav) pada waktu tertentu (timer), suara di mainkan bila telah mencapai waktu tertentu. Program harus bersifat fleksibel terhadap perobahan waktu yang diinginkan. Misalnya saja pada hari tertentu mungkin saja rentang waktu untuk 1 jam pelajaran berbeda dengan hari lain
Code :
Buat module lalu ketikkan kode berikut :
Option Explicit
Option Base 1
Private Declare Function PlaySound Lib “winmm.dll” Alias “PlaySoundA” _
(ByVal lpszName As String, ByVal hModule As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function waveOutGetNumDevs Lib “winmm.dll” () As Long
Public WavePlay As Boolean
Dim Detik As Long
Dim aTandaBell(20) As String
Dim aTandaBunyi(20) As String
Dim aTandaNada(20) As Integer
Dim I As Integer
Dim SedangBunyi As Boolean
Public Function CanPlayWaves() As Boolean
CanPlayWaves = waveOutGetNumDevs()
End Function
Public Function PlayWaveFile(FileName As String, Optional Async As Boolean) As Boolean
Dim Flags As Long
Const SND_SYNC = &H0 ‘ Play synchronously
Const SND_ASYNC = &H1 ‘ Play asynchronously
Const SND_NODEFAULT = &H2 ‘ No default sound event is used
Const SND_FILENAME = &H20000 ‘ Name is a file name
Flags = SND_NODEFAULT Or SND_FILENAME Or SND_SYNC
If Async Then Flags = Flags Or SND_ASYNC
PlayWaveFile = PlaySound(FileName, 0&, Flags)
End Function
Public Function StopPlayingWave() As Boolean
Const SND_PURGE = &H40
PlaySound vbNullString, 0&, SND_PURGE
End Function
Option Base 1
Private Declare Function PlaySound Lib “winmm.dll” Alias “PlaySoundA” _
(ByVal lpszName As String, ByVal hModule As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function waveOutGetNumDevs Lib “winmm.dll” () As Long
Public WavePlay As Boolean
Dim Detik As Long
Dim aTandaBell(20) As String
Dim aTandaBunyi(20) As String
Dim aTandaNada(20) As Integer
Dim I As Integer
Dim SedangBunyi As Boolean
Public Function CanPlayWaves() As Boolean
CanPlayWaves = waveOutGetNumDevs()
End Function
Public Function PlayWaveFile(FileName As String, Optional Async As Boolean) As Boolean
Dim Flags As Long
Const SND_SYNC = &H0 ‘ Play synchronously
Const SND_ASYNC = &H1 ‘ Play asynchronously
Const SND_NODEFAULT = &H2 ‘ No default sound event is used
Const SND_FILENAME = &H20000 ‘ Name is a file name
Flags = SND_NODEFAULT Or SND_FILENAME Or SND_SYNC
If Async Then Flags = Flags Or SND_ASYNC
PlayWaveFile = PlaySound(FileName, 0&, Flags)
End Function
Public Function StopPlayingWave() As Boolean
Const SND_PURGE = &H40
PlaySound vbNullString, 0&, SND_PURGE
End Function
Buat Form lalu ketikkan kode dibawah ini :
Private Sub Command1_Click()
‘Initialize boolean variable WavePlay
WavePlay = CanPlayWaves
If WavePlay Then ‘If Boolean is true (system can play sound)
PlayWaveFile App.Path + “\trumpet1.wav”, True
End If
End Sub
Private Sub Command1_Click()
‘Initialize boolean variable WavePlay
WavePlay = CanPlayWaves
If WavePlay Then ‘If Boolean is true (system can play sound)
PlayWaveFile App.Path + “\trumpet1.wav”, True
End If
End Sub
Private Sub Form_Load()
Dim nFree As Integer
Dim nFree As Integer
nFree = FreeFile
Detik = 0
SedangBunyi = False
End Sub
Detik = 0
SedangBunyi = False
End Sub
Private Sub Timer1_Timer()
Dim TandaBell As String
Dim TandaBunyi As String
Dim tandaNada As Integer
Detik = Detik + 1
Dim N As Integer
Dim jam As String
Dim menit As String
Dim JamMenit As String
Dim dtk As String
Dim HariIni As String
Dim nFree As String
Dim nomor As Integer
Label1.Caption = Time
HariIni = NamaHari()
Label2.Caption = HariIni
Dim NmFile As String
nFree = 1
NmFile = HariIni + “.cfg”
If Dir(App.Path + “\” + NmFile) <> “” Then
Open App.Path + “\” + NmFile For Input As #nFree
I = 0
While Not EOF(nFree)
I = I + 1
Input #nFree, nomor, TandaBell, TandaBunyi, tandaNada
aTandaBell(I) = TandaBell
aTandaBunyi(I) = TandaBunyi
aTandaNada(I) = tandaNada
Wend
Close #1
End If
Dim TandaBell As String
Dim TandaBunyi As String
Dim tandaNada As Integer
Detik = Detik + 1
Dim N As Integer
Dim jam As String
Dim menit As String
Dim JamMenit As String
Dim dtk As String
Dim HariIni As String
Dim nFree As String
Dim nomor As Integer
Label1.Caption = Time
HariIni = NamaHari()
Label2.Caption = HariIni
Dim NmFile As String
nFree = 1
NmFile = HariIni + “.cfg”
If Dir(App.Path + “\” + NmFile) <> “” Then
Open App.Path + “\” + NmFile For Input As #nFree
I = 0
While Not EOF(nFree)
I = I + 1
Input #nFree, nomor, TandaBell, TandaBunyi, tandaNada
aTandaBell(I) = TandaBell
aTandaBunyi(I) = TandaBunyi
aTandaNada(I) = tandaNada
Wend
Close #1
End If
jam = Hour(Time)
menit = Minute(Time)
dtk = Second(Time)
JamMenit = jam + “.” + menit + “.” + dtk
Label3.Caption = JamMenit
For N = 1 To I
If (aTandaBell(N) = JamMenit) And (UCase(aTandaBunyi(N)) = “ON”) Then
WavePlay = CanPlayWaves
If WavePlay Then ‘If Boolean is true (system can play sound)
If aTandaNada(N) = 1 Then
PlayWaveFile App.Path + “\trumpet1.wav”, True
Else
PlayWaveFile App.Path + “\trumpet2.wav”, True
End If
End If
End If
Next N
End Sub
menit = Minute(Time)
dtk = Second(Time)
JamMenit = jam + “.” + menit + “.” + dtk
Label3.Caption = JamMenit
For N = 1 To I
If (aTandaBell(N) = JamMenit) And (UCase(aTandaBunyi(N)) = “ON”) Then
WavePlay = CanPlayWaves
If WavePlay Then ‘If Boolean is true (system can play sound)
If aTandaNada(N) = 1 Then
PlayWaveFile App.Path + “\trumpet1.wav”, True
Else
PlayWaveFile App.Path + “\trumpet2.wav”, True
End If
End If
End If
Next N
End Sub
Private Function NamaHari()
Dim BilHari As Integer
BilHari = Weekday(Date)
Select Case BilHari
Case 1
NamaHari = “MINGGU”
Case 2
NamaHari = “SENIN”
Case 3
NamaHari = “SELASA”
Case 4
NamaHari = “RABU”
Case 5
NamaHari = “KAMIS”
Case 6
NamaHari = “JUMAT”
Case 7
NamaHari = “SABTU”
End Select
End Function
Dim BilHari As Integer
BilHari = Weekday(Date)
Select Case BilHari
Case 1
NamaHari = “MINGGU”
Case 2
NamaHari = “SENIN”
Case 3
NamaHari = “SELASA”
Case 4
NamaHari = “RABU”
Case 5
NamaHari = “KAMIS”
Case 6
NamaHari = “JUMAT”
Case 7
NamaHari = “SABTU”
End Select
End Function
0 comments:
Post a Comment