用VB[basic语言]让电脑发声的程序怎么写
5个回答
2013-12-21
展开全部
给你个类模块,用起来比较简单。MMedia.cls '----------------------------------------------------
Option Explicit
'--------------TrueZq 最新更新2001-01-12---------------------
'文件名: MMedia.cls
'说明: : 一个多媒体类,能播放Avi、Wave、Midi文件
'用法:
'Dim Multimedia As New Mmedia
'Multimedia.mmOpen "c:\test.wav"
'Multimedia.mmPlay
'!记住:在程序结束时,一定要用Set Multimedia=nothing释放资源!!!
'-----------------------------------------------------
' -=-=-=- 属性 -=-=-=-
' sFilename 当前的文件名
' nLength 文件长度(只读)
' nPosition 当前位置
' sStatus 当前状态(只读)
' bWait True/False.决定是否等待播放完
' -=-=-=- 方法 -=-=-=-=-
' mmOpen <Filename> 打开要播放的文件
' mmClose 关闭当前文件
' mmPause 暂停
' mmStop 停止 停止后可以跳到开始再次播放
' mmSeek <Position> Seeks to a position in the file
' mmPlay 播放
'--------------------------------------------------------------
Private sAlias As String '别名
'Private hWnd As Long
Private sFilename As String ' 当前的文件名
Private nLength As Single ' 文件长度Private nPosition As Single ' 当前位置
Private sStatus As String ' 当前状态
Private bWait As Boolean ' 决定是否等待播放完
Const WS_CHILD = &H40000000
'------------ API 声明 -------------
Private Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As LongPrivate Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
'Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Function GetShortPath(strFileName As String) As String
Dim lngRes As Long, strPath As String
'Create a buffer
strPath = String$(165, 0) '这句是关键
'retrieve the short pathname
lngRes = GetShortPathName(strFileName, strPath, 164)
'remove all unnecessary chr$(0)'s
GetShortPath = left$(strPath, lngRes)
End Function
'Private Declare Function GetActiveWindow Lib "USER32" () As Integer
'当sTheFile是一个Avi文件时,参数hWnd指定动画在哪里播放
'若hWnd=0,则新开一个窗口播放动画。
'如果听不到Midi音乐,请在Windows下用媒体播放器测试一下。
'文件名不能带空格
Public Sub mmOpen(ByVal sTheFile As String, Optional hWnd As Long = 0)
Dim nReturn As Long
Dim sType As String '文件类型
Static nNum As IntegerIf sAlias <> "" Then '关闭开始打开的文件
mmClose
End IfsTheFile = GetShortPath(sTheFile)If (Dir(sTheFile) = "") Then '判断是否是一个存在的文件
sFilename = "文件" & sTheFile & " 不存在!"
Exit Sub
Else
sFilename = sTheFile
' nNum = nNum + 1
End If
' Stop
sAlias = sFilename '用文件名作别名,避免别名冲突!
' 判断文件类型
Select Case UCase$(right$(sTheFile, 3))
Case "WAV"
sType = "Waveaudio"
Case "AVI"
sType = "AviVideo"Case "MID"
sType = "Sequencer"
Case Else
' 未知文件格式,退出。
Exit Sub
End SelectIf sType = "AviVideo" And hWnd > 0 Then
nReturn = mciSendString("open " & sTheFile & " ALIAS " & sAlias _
& " TYPE AVIVideo parent " & hWnd & " style " & LTrim$(str$(WS_CHILD)), 0&, 0, 0)
Else
nReturn = mciSendString("Open " & sTheFile & " ALIAS " & sAlias _
& " TYPE " & sType, "", 0, 0)
End IfEnd Sub
'关闭当前打开的多媒体文件
Public Sub mmClose()
Dim nReturn As Long'如果没有文件打开,则退出
If sAlias = "" Then Exit SubnReturn = mciSendString("Close " & sAlias, "", 0, 0)
sAlias = ""
sFilename = ""End Sub
'暂停
Public Sub mmPause()Dim nReturn As LongIf sAlias = "" Then
Exit Sub
ElseIf Status = "paused" Then '如果先前已经暂停了,则解除暂停
mmPlay
Else
nReturn = mciSendString("Pause " & sAlias, "", 0, 0)
End If
'nPosition = Position
End Sub
'播放
Public Sub mmPlay()Dim nReturn As LongIf sAlias = "" Then
Exit Sub
ElseIf Position = Length Then '如果已经到末尾
mmSeek 0 '跳到开始处
End If
If bWait Then
nReturn = mciSendString("Play " & sAlias & " wait", "", 0, 0)
Else
nReturn = mciSendString("Play " & sAlias, "", 0, 0)
End If
End Sub
'停止
'停止后跳到开始,以便再次播放
Public Sub mmStop()Dim nReturn As LongIf sAlias = "" Then Exit SubnReturn = mciSendString("Stop " & sAlias, "", 0, 0)
mmSeek 0 '跳到开始位置
End Sub
'跳到指定的位置,并且处于暂停状态
'当nPosition的值>Length 或者nPosition<0时,将忽略这次操作
Public Sub mmSeek(ByVal nPosition As Single)Dim nReturn As Long
nReturn = mciSendString("Seek " & sAlias & " to " & nPosition, "", 0, 0)
End Sub
'方法Filename返回当前打开的文件名
Property Get filename() As String
filename = sFilename
End Property
'指定要播放的文件名,然后将它打开
'对于需要指定容器的Avi文件,不要以这种方式打开。
Property Let filename(ByVal sTheFile As String)
sTheFile = GetShortPath(sTheFile)
mmOpen sTheFile
End Property
'读取属性Wait的值
'Msgbox Multimedia.Wait
Property Get Wait() As Boolean
Wait = bWait
End Property
'设置等待属性
'用法:Multimedia.Wait=True
Property Let Wait(bWaitValue As Boolean)
bWait = bWaitValue
End Property
'获得长度值
Property Get Length() As SingleDim nReturn As Long, nLength As Integer
Dim sLength As String * 255If sAlias = "" Then
Length = 0
Exit Property
End If
nReturn = mciSendString("Status " & sAlias & " length", sLength, 255, 0)
nLength = InStr(sLength, Chr$(0))
Length = Val(left$(sLength, nLength - 1))
End Property
Property Let Position(ByVal nPosition As Single)
mmSeek nPosition
End Property
'获取当前位置
Property Get Position() As SingleDim nReturn As Integer, nLength As IntegerDim sPosition As String * 255
If sAlias = "" Then Exit Property
nReturn = mciSendString("Status " & sAlias & " position", sPosition, 255, 0)
nLength = InStr(sPosition, Chr$(0))
Position = Val(left$(sPosition, nLength - 1))
End Property
'当前打开文件的状态
'有以下几种:playing paused stopped
Property Get Status() As StringDim nReturn As Integer, nLength As Integer
Dim sStatus As String * 255If sAlias = "" Then Exit Property
nReturn = mciSendString("Status " & sAlias & " mode", sStatus, 255, 0)nLength = InStr(sStatus, Chr$(0))
Status = left$(sStatus, nLength - 1)End Property
'从头开始播放
Public Sub mmRestart()
Dim nReturn As LongIf sAlias = "" Then Exit SubmmSeek 0
mmPlay
End Sub
'类的初始化
Private Sub Class_Initialize()
' sAlias = "" '别名初值为空
End Sub
'关闭打开的多媒体设备
'当该类的对象所在的窗体(或模块)卸载时,自动调用该过程
Private Sub Class_Terminate()
mmClose
End Sub
Option Explicit
'--------------TrueZq 最新更新2001-01-12---------------------
'文件名: MMedia.cls
'说明: : 一个多媒体类,能播放Avi、Wave、Midi文件
'用法:
'Dim Multimedia As New Mmedia
'Multimedia.mmOpen "c:\test.wav"
'Multimedia.mmPlay
'!记住:在程序结束时,一定要用Set Multimedia=nothing释放资源!!!
'-----------------------------------------------------
' -=-=-=- 属性 -=-=-=-
' sFilename 当前的文件名
' nLength 文件长度(只读)
' nPosition 当前位置
' sStatus 当前状态(只读)
' bWait True/False.决定是否等待播放完
' -=-=-=- 方法 -=-=-=-=-
' mmOpen <Filename> 打开要播放的文件
' mmClose 关闭当前文件
' mmPause 暂停
' mmStop 停止 停止后可以跳到开始再次播放
' mmSeek <Position> Seeks to a position in the file
' mmPlay 播放
'--------------------------------------------------------------
Private sAlias As String '别名
'Private hWnd As Long
Private sFilename As String ' 当前的文件名
Private nLength As Single ' 文件长度Private nPosition As Single ' 当前位置
Private sStatus As String ' 当前状态
Private bWait As Boolean ' 决定是否等待播放完
Const WS_CHILD = &H40000000
'------------ API 声明 -------------
Private Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As LongPrivate Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
'Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Function GetShortPath(strFileName As String) As String
Dim lngRes As Long, strPath As String
'Create a buffer
strPath = String$(165, 0) '这句是关键
'retrieve the short pathname
lngRes = GetShortPathName(strFileName, strPath, 164)
'remove all unnecessary chr$(0)'s
GetShortPath = left$(strPath, lngRes)
End Function
'Private Declare Function GetActiveWindow Lib "USER32" () As Integer
'当sTheFile是一个Avi文件时,参数hWnd指定动画在哪里播放
'若hWnd=0,则新开一个窗口播放动画。
'如果听不到Midi音乐,请在Windows下用媒体播放器测试一下。
'文件名不能带空格
Public Sub mmOpen(ByVal sTheFile As String, Optional hWnd As Long = 0)
Dim nReturn As Long
Dim sType As String '文件类型
Static nNum As IntegerIf sAlias <> "" Then '关闭开始打开的文件
mmClose
End IfsTheFile = GetShortPath(sTheFile)If (Dir(sTheFile) = "") Then '判断是否是一个存在的文件
sFilename = "文件" & sTheFile & " 不存在!"
Exit Sub
Else
sFilename = sTheFile
' nNum = nNum + 1
End If
' Stop
sAlias = sFilename '用文件名作别名,避免别名冲突!
' 判断文件类型
Select Case UCase$(right$(sTheFile, 3))
Case "WAV"
sType = "Waveaudio"
Case "AVI"
sType = "AviVideo"Case "MID"
sType = "Sequencer"
Case Else
' 未知文件格式,退出。
Exit Sub
End SelectIf sType = "AviVideo" And hWnd > 0 Then
nReturn = mciSendString("open " & sTheFile & " ALIAS " & sAlias _
& " TYPE AVIVideo parent " & hWnd & " style " & LTrim$(str$(WS_CHILD)), 0&, 0, 0)
Else
nReturn = mciSendString("Open " & sTheFile & " ALIAS " & sAlias _
& " TYPE " & sType, "", 0, 0)
End IfEnd Sub
'关闭当前打开的多媒体文件
Public Sub mmClose()
Dim nReturn As Long'如果没有文件打开,则退出
If sAlias = "" Then Exit SubnReturn = mciSendString("Close " & sAlias, "", 0, 0)
sAlias = ""
sFilename = ""End Sub
'暂停
Public Sub mmPause()Dim nReturn As LongIf sAlias = "" Then
Exit Sub
ElseIf Status = "paused" Then '如果先前已经暂停了,则解除暂停
mmPlay
Else
nReturn = mciSendString("Pause " & sAlias, "", 0, 0)
End If
'nPosition = Position
End Sub
'播放
Public Sub mmPlay()Dim nReturn As LongIf sAlias = "" Then
Exit Sub
ElseIf Position = Length Then '如果已经到末尾
mmSeek 0 '跳到开始处
End If
If bWait Then
nReturn = mciSendString("Play " & sAlias & " wait", "", 0, 0)
Else
nReturn = mciSendString("Play " & sAlias, "", 0, 0)
End If
End Sub
'停止
'停止后跳到开始,以便再次播放
Public Sub mmStop()Dim nReturn As LongIf sAlias = "" Then Exit SubnReturn = mciSendString("Stop " & sAlias, "", 0, 0)
mmSeek 0 '跳到开始位置
End Sub
'跳到指定的位置,并且处于暂停状态
'当nPosition的值>Length 或者nPosition<0时,将忽略这次操作
Public Sub mmSeek(ByVal nPosition As Single)Dim nReturn As Long
nReturn = mciSendString("Seek " & sAlias & " to " & nPosition, "", 0, 0)
End Sub
'方法Filename返回当前打开的文件名
Property Get filename() As String
filename = sFilename
End Property
'指定要播放的文件名,然后将它打开
'对于需要指定容器的Avi文件,不要以这种方式打开。
Property Let filename(ByVal sTheFile As String)
sTheFile = GetShortPath(sTheFile)
mmOpen sTheFile
End Property
'读取属性Wait的值
'Msgbox Multimedia.Wait
Property Get Wait() As Boolean
Wait = bWait
End Property
'设置等待属性
'用法:Multimedia.Wait=True
Property Let Wait(bWaitValue As Boolean)
bWait = bWaitValue
End Property
'获得长度值
Property Get Length() As SingleDim nReturn As Long, nLength As Integer
Dim sLength As String * 255If sAlias = "" Then
Length = 0
Exit Property
End If
nReturn = mciSendString("Status " & sAlias & " length", sLength, 255, 0)
nLength = InStr(sLength, Chr$(0))
Length = Val(left$(sLength, nLength - 1))
End Property
Property Let Position(ByVal nPosition As Single)
mmSeek nPosition
End Property
'获取当前位置
Property Get Position() As SingleDim nReturn As Integer, nLength As IntegerDim sPosition As String * 255
If sAlias = "" Then Exit Property
nReturn = mciSendString("Status " & sAlias & " position", sPosition, 255, 0)
nLength = InStr(sPosition, Chr$(0))
Position = Val(left$(sPosition, nLength - 1))
End Property
'当前打开文件的状态
'有以下几种:playing paused stopped
Property Get Status() As StringDim nReturn As Integer, nLength As Integer
Dim sStatus As String * 255If sAlias = "" Then Exit Property
nReturn = mciSendString("Status " & sAlias & " mode", sStatus, 255, 0)nLength = InStr(sStatus, Chr$(0))
Status = left$(sStatus, nLength - 1)End Property
'从头开始播放
Public Sub mmRestart()
Dim nReturn As LongIf sAlias = "" Then Exit SubmmSeek 0
mmPlay
End Sub
'类的初始化
Private Sub Class_Initialize()
' sAlias = "" '别名初值为空
End Sub
'关闭打开的多媒体设备
'当该类的对象所在的窗体(或模块)卸载时,自动调用该过程
Private Sub Class_Terminate()
mmClose
End Sub
2013-12-21
展开全部
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Sub Form_Load()
playsnd 587, 100: playsnd 784, 100: playsnd 880, 100: playsnd 988, 100:: playsnd 988, 200: playsnd 0, 100
playsnd 988, 100: playsnd 880, 100: playsnd 988, 100: playsnd 1047, 200: playsnd 988, 100: playsnd 988, 100
playsnd 880, 100: playsnd 100, 150: playsnd 880, 100: playsnd 784, 100:: playsnd 988, 100: playsnd 0, (5)
playsnd 988, 100: playsnd 0, (5)::: playsnd 988, 100: playsnd 0, (5):::: playsnd 988, 100: playsnd 880, 100
playsnd 784, 100: playsnd 740, 100: playsnd 784, 200: playsnd 100, 200:: playsnd 784, 100: playsnd 880, 100
playsnd 784, 100: playsnd 988, 100: playsnd 0, (5)::: playsnd 988, 100:: playsnd 0, (5)::: playsnd 988, 100
playsnd 0, (5)::: playsnd 988, 100: playsnd 100, 100: playsnd 587, 100:: playsnd 784, 100: playsnd 1175, 100
playsnd 0, (5)::: playsnd 1175, 99: playsnd 988, 100: playsnd 0, (5):::: playsnd 988, 100: playsnd 0, (5)
playsnd 987, 100: playsnd 100, 100: playsnd 784, 100: playsnd 0, (5):::: playsnd 784, 100: playsnd 880, 200
playsnd 784, 100: playsnd 0, (5)::: playsnd 784, 100: playsnd 0, (5):::: playsnd 784, 50:: playsnd 659, (50)
playsnd 784, 100: playsnd 659, 100: playsnd 784, 100: playsnd 880, 100:: playsnd 100, 100: playsnd 587, 110
playsnd 784, 120: playsnd 880, 130: playsnd 740, 140: playsnd 784, 200:: playsnd 1, 1::::: playsnd 1, 1
End
End Sub
Function playsnd(ByVal x As Long, y As Long)
Beep x, y * 3
DoEvents
End Function 这是一段音乐的 源码 你可以 自己试试
Private Sub Form_Load()
playsnd 587, 100: playsnd 784, 100: playsnd 880, 100: playsnd 988, 100:: playsnd 988, 200: playsnd 0, 100
playsnd 988, 100: playsnd 880, 100: playsnd 988, 100: playsnd 1047, 200: playsnd 988, 100: playsnd 988, 100
playsnd 880, 100: playsnd 100, 150: playsnd 880, 100: playsnd 784, 100:: playsnd 988, 100: playsnd 0, (5)
playsnd 988, 100: playsnd 0, (5)::: playsnd 988, 100: playsnd 0, (5):::: playsnd 988, 100: playsnd 880, 100
playsnd 784, 100: playsnd 740, 100: playsnd 784, 200: playsnd 100, 200:: playsnd 784, 100: playsnd 880, 100
playsnd 784, 100: playsnd 988, 100: playsnd 0, (5)::: playsnd 988, 100:: playsnd 0, (5)::: playsnd 988, 100
playsnd 0, (5)::: playsnd 988, 100: playsnd 100, 100: playsnd 587, 100:: playsnd 784, 100: playsnd 1175, 100
playsnd 0, (5)::: playsnd 1175, 99: playsnd 988, 100: playsnd 0, (5):::: playsnd 988, 100: playsnd 0, (5)
playsnd 987, 100: playsnd 100, 100: playsnd 784, 100: playsnd 0, (5):::: playsnd 784, 100: playsnd 880, 200
playsnd 784, 100: playsnd 0, (5)::: playsnd 784, 100: playsnd 0, (5):::: playsnd 784, 50:: playsnd 659, (50)
playsnd 784, 100: playsnd 659, 100: playsnd 784, 100: playsnd 880, 100:: playsnd 100, 100: playsnd 587, 110
playsnd 784, 120: playsnd 880, 130: playsnd 740, 140: playsnd 784, 200:: playsnd 1, 1::::: playsnd 1, 1
End
End Sub
Function playsnd(ByVal x As Long, y As Long)
Beep x, y * 3
DoEvents
End Function 这是一段音乐的 源码 你可以 自己试试
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
2013-12-21
展开全部
beep就可以 调用主板的蜂鸣器 可以自己调整长短与频率 这样就能做出最简单的曲子了
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
2013-12-21
展开全部
用系统API函数可以实现,具体的话,加我QQ,我给你发给实例 36 1789 273
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
2013-12-21
展开全部
直接输入beep是电脑的提示音,如果放音乐的话加个播放器控件就可以
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询