关于TTS输出wav时显示进度的问题(附源码)

Option Explicit
Private WithEvents sVoice As SpVoice

Private Sub Command1_Click()
    Set sVoice = New SpVoice
    Set sVoice.Voice = sVoice.GetVoices.Item(Combo1.ListIndex)
    sVoice.Speak RichTextBox1.Text, SVSFlagsAsync
End Sub

Private Sub Command2_Click()
    Dim sVoice As SpVoice
    Dim objFileStream As SpFileStream
    Dim sName As String
    'Dim S As SpeechLib.ISpeechVoiceStatus
   
    Set sVoice = New SpVoice
    Set sVoice.Voice = sVoice.GetVoices.Item(Combo1.ListIndex)
    Set objFileStream = CreateObject("SAPI.SpFileStream")
    objFileStream.Format.Type = SAFT11kHz16BitMono
    sName = "c:\temp.wav"
   
    objFileStream.Open sName, SSFMCreateForWrite, False
    Set sVoice.AudioOutputStream = objFileStream
   
    sVoice.Speak RichTextBox1.Text, SVSFlagsAsync                '录制文本
    sVoice.WaitUntilDone -1
    MsgBox "OK! The filename is " & sName, vbInformation + 4096, "text4wav"
    Set sVoice = Nothing
    Set objFileStream = Nothing
End Sub

Private Sub Command3_Click()
    sVoice.Speak "", SVSFPurgeBeforeSpeak
    Set sVoice = Nothing
End Sub

Private Sub Form_Load()
    Set sVoice = New SpVoice
    Dim Token As ISpeechObjectToken
    For Each Token In sVoice.GetVoices
        Combo1.AddItem Token.GetDescription()
    Next
    Combo1.ListIndex = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set sVoice = Nothing
End Sub

Private Sub sVoice_Word(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal CharacterPosition As Long, ByVal Length As Long)
    On Error Resume Next
    RichTextBox1.SetFocus
    RichTextBox1.SelStart = CharacterPosition
    RichTextBox1.SelLength = Length
    ProgressBar1.Max = Len(RichTextBox1.Text)
    ProgressBar1.Value = CharacterPosition
End Sub