用VB[basic語言]讓電腦發聲的程序怎麽寫
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