利用VB编写文本朗读精灵

Option Explicit
' ÉùÃ÷SAPI¶ÔÏó
Dim WithEvents Voice As SpVoice
'ÀʶÁ·ç¸ñ
Dim m_speakFlags As SpeechVoiceSpeakFlags
' ÉèÖÃĬÈϸñʽ.
Const DefaultFmt = "22kHz 16Bit Mono"
Private isspeaking As Boolean
Private ispaused As Boolean
Private Sub Command1_Click()
'±£´æΪWAVÎļþ
    ComDlg.CancelError = True
    On Error GoTo ErrHandler
    'ÉèÖöԻ°¿ò±êÌâ
    ComDlg.DialogTitle = "±£´æµ½ÉùÒôÎļþ"
    ' Set filters
    ComDlg.Filter = "ËùÓÐÎļþ(*.*)|*.*|ÉùÒôÎļþ(*.wav)|*.wav"
    ComDlg.FilterIndex = 2
    'ÏÔʾ±£´æ¶Ô»°¿ò
    ComDlg.ShowSave
    Dim cpFileStream As New SpFileStream
    ' ÉèÖÃÊä³ö¸ñʽΪËùÑ¡¸ñʽ
    cpFileStream.Format.Type = FormatCB.ItemData(FormatCB.ListIndex)
    cpFileStream.Open ComDlg.FileName, SSFMCreateForWrite, False
    Voice.AllowAudioOutputFormatChangesOnNextSet = False
    Set Voice.AudioOutputStream = cpFileStream
    Voice.Speak MainTxtBox.Text, m_speakFlags
    Voice.WaitUntilDone -1
    cpFileStream.Close
    Set cpFileStream = Nothing
   
    MsgBox "WAV Îļþ³É¹¦±£´æ!", vbOKOnly, "Îļþ´æÅÌ"
    Exit Sub
ErrHandler:
    If Not cpFileStream Is Nothing Then
        Set cpFileStream = Nothing
    End If
End Sub
Private Sub Form_Load()
    ' ´´½¨ÓïÒô¶ÔÏó
    Set Voice = New SpVoice
    Dim Token As ISpeechObjectToken
    For Each Token In Voice.GetVoices
        VoiceCB.AddItem (Token.GetDescription())
    Next
    VoiceCB.ListIndex = 0
    AddItemToFmtCB
    ' ÉèÖÃËÙ¶ÈÓëÒôÁ¿
    RateSldr.Value = Voice.Rate
    VolumeSldr.Value = Voice.Volume
    'ÉèÖÃĬÈϸñʽ
    FormatCB.Text = DefaultFmt
    SetSpeakingState False, False
    Exit Sub
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Set Voice = Nothing
End Sub
Private Sub FormatCB_Click()
    On Error GoTo ErrHandler
    Voice.AllowAudioOutputFormatChangesOnNextSet = False
    Voice.AudioOutputStream.Format.Type = FormatCB.ItemData(FormatCB.ListIndex)
    Set Voice.AudioOutputStream = Voice.AudioOutputStream
    Exit Sub
ErrHandler:
    MsgBox "ÉèÖøñʽ´íÎó: ", Err.Description
End Sub
Private Sub PauseBtn_Click()
'ÔÝÍ£
    Select Case PauseBtn.Caption
    Case "ÔÝÍ£"
        Voice.Pause
        SetSpeakingState isspeaking, True
    Case "¼ÌÐø"
        Voice.Resume
        SetSpeakingState isspeaking, False
    End Select
End Sub
Private Sub RateSldr_Scroll()
    Voice.Rate = RateSldr.Value
End Sub
Private Sub SpeakBtn_Click()
'ÀʶÁ
    On Error GoTo ErrHandler
    If MainTxtBox.Text = "" Then
        Exit Sub
    End If
    If Not (ispaused And isspeaking) Then
        Voice.Speak MainTxtBox.Text, m_speakFlags
    End If
    If ispaused Then Voice.Resume
    SetSpeakingState True, False
    Exit Sub
ErrHandler:
    SetSpeakingState False, ispaused
End Sub
Private Sub StopBtn_Click()
'Í£Ö¹
    On Error GoTo ErrHandler
    Voice.Speak vbNullString, SVSFPurgeBeforeSpeak
    If ispaused Then Voice.Resume
     SetSpeakingState False, False
    Exit Sub
ErrHandler:
End Sub
Private Sub VoiceCB_Click()
    ' ¸Ä±äÓïÑÔ
    Set Voice.Voice = Voice.GetVoices().Item(VoiceCB.ListIndex)
End Sub
Private Sub VolumeSldr_Scroll()
    'ÉèÖÃÒôÁ¿
    Voice.Volume = VolumeSldr.Value
End Sub
Private Sub AddFmts(ByRef name As String, ByVal fmt As SpeechAudioFormatType)
    Dim index As String
    index = FormatCB.ListCount
    FormatCB.AddItem name, index
    FormatCB.ItemData(index) = fmt
End Sub
Private Sub AddItemToFmtCB()
    AddFmts "8kHz 8Bit Mono", SAFT8kHz16BitMono
    AddFmts "8kHz 8Bit Stereo", SAFT8kHz8BitStereo
    AddFmts "8kHz 16Bit Mono", SAFT8kHz16BitMono
    AddFmts "8kHz 16Bit Stereo", SAFT8kHz16BitStereo
   
    AddFmts "11kHz 8Bit Mono", SAFT11kHz8BitMono
    AddFmts "11kHz 8Bit Stereo", SAFT11kHz8BitStereo
    AddFmts "11kHz 16Bit Mono", SAFT11kHz16BitMono
    AddFmts "11kHz 16Bit Stereo", SAFT11kHz16BitStereo
   
    AddFmts "12kHz 8Bit Mono", SAFT12kHz8BitMono
    AddFmts "12kHz 8Bit Stereo", SAFT12kHz8BitStereo
    AddFmts "12kHz 16Bit Mono", SAFT12kHz16BitMono
    AddFmts "12kHz 16Bit Stereo", SAFT12kHz16BitStereo
   
    AddFmts "16kHz 8Bit Mono", SAFT16kHz8BitMono
    AddFmts "16kHz 8Bit Stereo", SAFT16kHz8BitStereo
    AddFmts "16kHz 16Bit Mono", SAFT16kHz16BitMono
    AddFmts "16kHz 16Bit Stereo", SAFT16kHz16BitStereo
   
    AddFmts "22kHz 8Bit Mono", SAFT22kHz8BitMono
    AddFmts "22kHz 8Bit Stereo", SAFT22kHz8BitStereo
    AddFmts "22kHz 16Bit Mono", SAFT22kHz16BitMono
    AddFmts "22kHz 16Bit Stereo", SAFT22kHz16BitStereo
   
    AddFmts "24kHz 8Bit Mono", SAFT24kHz8BitMono
    AddFmts "24kHz 8Bit Stereo", SAFT24kHz8BitStereo
    AddFmts "24kHz 16Bit Mono", SAFT24kHz16BitMono
    AddFmts "24kHz 16Bit Stereo", SAFT24kHz16BitStereo
   
    AddFmts "32kHz 8Bit Mono", SAFT32kHz8BitMono
    AddFmts "32kHz 8Bit Stereo", SAFT32kHz8BitStereo
    AddFmts "32kHz 16Bit Mono", SAFT32kHz16BitMono
    AddFmts "32kHz 16Bit Stereo", SAFT32kHz16BitStereo
   
    AddFmts "44kHz 8Bit Mono", SAFT44kHz8BitMono
    AddFmts "44kHz 8Bit Stereo", SAFT44kHz8BitStereo
    AddFmts "44kHz 16Bit Mono", SAFT44kHz16BitMono
    AddFmts "44kHz 16Bit Stereo", SAFT44kHz16BitStereo
   
    AddFmts "48kHz 8Bit Mono", SAFT48kHz8BitMono
    AddFmts "48kHz 8Bit Stereo", SAFT48kHz8BitStereo
    AddFmts "48kHz 16Bit Mono", SAFT48kHz16BitMono
    AddFmts "48kHz 16Bit Stereo", SAFT48kHz16BitStereo
End Sub
Private Sub SetSpeakingState(ByVal bSpeaking As Boolean, ByVal bPaused As Boolean)
    SpeakBtn.Enabled = True
    StopBtn.Enabled = bSpeaking
    PauseBtn.Enabled = bSpeaking
    If bPaused Then
        PauseBtn.Caption = "¼ÌÐø"
    Else
        PauseBtn.Caption = "ÔÝÍ£"
    End If
    isspeaking = bSpeaking
    ispaused = bPaused
End Sub