Option Explicit
Dim Voice As SpVoice
Private Sub Form_Load()
Set Voice = New SpVoice
Dim Token As ISpeechObjectToken
For Each Token In Voice.GetVoices
VoiceL.AddItem (Token.GetDescription())
Next
VoiceL.ListIndex = 0
End Sub
Private Sub SaveToWavCheckBox_Click()
If Cmd_Say.Caption = "朗读" Then
Cmd_Say.Caption = "保存"
Else
Cmd_Say.Caption = "朗读"
End If
End Sub
Private Sub Cmd_Say_Click()
If Cmd_Pause.Caption = "恢复" Then Voice.Resume: Cmd_Pause.Caption = "暂停"
Voice.Speak Txt_Show.Text, SVSFlagsAsync
On Error GoTo Speak_Error
If SaveToWavCheckBox Then
SaveToWav
Else
If Not Txt_Show.Text = "" Then
Voice.Speak Txt_Show.Text, SVSFlagsAsync
End If
End If
Txt_Show.SetFocus
Exit Sub
Speak_Error:
MsgBox "朗读错误!", vbOKOnly
End Sub
Private Sub Cmd_Pause_Click()
If Cmd_Pause.Caption = "暂停" Then
Cmd_Pause.Caption = "恢复"
Voice.Pause
Else
Cmd_Pause.Caption = "暂停"
Voice.Resume
End If
End Sub
Private Sub Cmd_Stop_Click()
If Cmd_Pause.Caption = "恢复" Then Voice.Resume: Cmd_Pause.Caption = "暂停"
Voice.Speak vbNullString, SVSFPurgeBeforeSpeak
End Sub
Private Sub SaveToWav()
Dim cpFileStream As New SpFileStream
cpFileStream.Format.Type = SAFT22kHz16BitMono
ComDlg.CancelError = True
On Error GoTo Cancel
ComDlg.Flags = cdlOFNOverwritePrompt + cdlOFNPathMustExist + cdlOFNNoReadOnlyReturn
ComDlg.DialogTitle = "保存至文件"
ComDlg.Filter = "All Files (*.*)|*.*|Wave Files " & "(*.wav)|*.wav"
ComDlg.FilterIndex = 2
ComDlg.ShowSave
cpFileStream.Open ComDlg.FileName, SSFMCreateForWrite, False
Set Voice.AudioOutputStream = cpFileStream
Voice.Speak Txt_Show.Text, SVSFDefault
cpFileStream.Close
Set cpFileStream = Nothing
Set Voice.AudioOutputStream = Nothing
Cancel:
Exit Sub
End Sub
Private Sub Txt_Show_KeyPress(KeyAscii As Integer)
'设置热键全选
If KeyAscii = 1 Then
Txt_Show.SelStart = 0
Txt_Show.SelLength = Len(Txt_Show.Text)
End If
End Sub
Private Sub Voice_EndStream(ByVal StreamNum As Long, ByVal StreamPos As Variant)
' MsgBox "朗读完毕"
End Sub
Private Sub VoiceL_Click()
' 改变朗读语言
Set Voice.Voice = Voice.GetVoices().Item(VoiceL.ListIndex)
End Sub