Question

VB6当某个时间到时发出声音

判断是不是到达某正点时间，当正点时发现声音，可以是存在的某个声音文件的声音，最好加上驱动计算机主板蜂鸣器也发出声音。

请写出整个程序。感谢。

Answer 1

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

private sub timer1_timer()
if hour(time)=你要几点都行 then
beep 1000,1000 '第一个1000是他的声音的大小[或频率]，第二个是时间 1000=1秒
end if
end Sub

--------------------
要用外部的音乐要简单的可以 加个wediaplayer的控件 把url="c:/1.mp3" 把路径改下就行 。
或者要用api好象也是可以的。。。

Answer 2

用vb6就可以了
新建一个窗体，弄一个按钮
然后写入代码：
------------------------------------------------------
Option Explicit
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Sub Command1_Click()
Dim X(24) As Integer, I As Integer, J As Integer
X(1) = 784: X(2) = 659: X(3) = 523: X(4) = 784
X(5) = 659: X(6) = 523: X(7) = 880: X(8) = 698
X(9) = 587: X(10) = 880: X(11) = 698: X(12) = 587
X(13) = 1568: X(14) = 1318: X(15) = 1046
X(16) = 1568: X(17) = 1318: X(18) = 1046
X(19) = 1760: X(20) = 1396: X(21) = 1174
X(22) = 1760: X(23) = 1396: X(24) = 1174
For I = 1 To 2
For J = 1 To 24
Beep X(J), 200
Next J
Next I
End Sub
------------------------------------------------------
运行看看

Answer 3

这个类似收音机报时的效果^_^ 正点报时 9点时 响8个一样的 最后一响提高音调

Private Declare Function beep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim flag As Integer
Private Sub Timer1_Timer()
Dim minu As Integer, h As Integer
minu = Val(Minute(Now()))
h = Val(Hour(Now()))
Debug.Print minu
If minu = 0 Then
Call beepp(h)
End If
End Sub
Sub beepp(ByVal h As Integer)
For i = 1 To h
If i <> h Then
beep 1000, 300
Else
beep 1500, 300
End If
Sleep (1000)
Next i
Sleep (60000)
End Sub

Answer 4

Option Explicit
Dim last, ret As Long, t As SYSTEMTIME
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
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 Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Const SND_FILENAME = &H20000
Private Const SND_SYNC = &H0

Private Sub Form_Load()
last = -1
Timer1.Interval = 500
End Sub

Private Sub Timer1_Timer()
GetSystemTime t
If t.wMinute = 0 And last <> t.wHour Then
last = t.wHour
ret = PlaySound(App.Path + "\Clock.wav", 0, SND_FILENAME Or SND_SYNC)
'注：可以把"clock.wav"改成其他文件名
Beep 1000, 1000
End If
End Sub

使用前在窗体里加一个timer控件

Answer 5

先加载Speech SDK控件,然后代码如下:
Public WithEvents RC As SpSharedRecoContext

Public myGrammar As ISpeechRecoGrammar

Private Sub Form_Load()
Set RC = New SpSharedRecoContext
Set myGrammar = RC.CreateGrammar
RC.Voice.GetVoices

myGrammar.DictationSetState SGDSActive

End Sub

Private Sub RC_Recognition(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal RecognitionType As SpeechLib.SpeechRecognitionType, ByVal Result As SpeechLib.ISpeechRecoResult)
Label1.Caption = Result.PhraseInfo.GetText
End Sub

Public WithEvents RC As SpSharedRecoContext

Public myGrammar As ISpeechRecoGrammar

Private Sub Form_Load()
Set RC = New SpSharedRecoContext
Set myGrammar = RC.CreateGrammar
RC.Voice.GetVoices

myGrammar.DictationSetState SGDSActive

End Sub

Private Sub RC_Recognition(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal RecognitionType As SpeechLib.SpeechRecognitionType, ByVal Result As SpeechLib.ISpeechRecoResult)
Label1.Caption = Result.PhraseInfo.GetText
End Sub
详细情况请看我的确主页:
http://blog.56.com/?u=hope_wang&session=PDrq9
http://hope_wang.56.com
里面有详细的介绍