Option Explicit

Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _

    (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _

     ByVal uReturnLength As Long, ByVal hwndCallback As LongPtr) As Long



Dim WiedergabeListe As Collection, AktuellerIndex&, ResumePosition&, AktuellesWav$, PauseAktiv As Boolean, Abbruch As Boolean



Sub TextToWav(text As String, wavPath As String)

    Dim spk As Object, fil As Object

    mciSendString "close mywav", 0, 0, 0

    Set spk = CreateObject("SAPI.SpVoice")

    Set fil = CreateObject("SAPI.SpFileStream")

    fil.Open wavPath, 3, False

    Set spk.AudioOutputStream = fil

    spk.Speak text

    fil.Close

End Sub



Sub SpieleAktuellesWav()

    If AktuellerIndex > WiedergabeListe.Count Then Exit Sub

    AktuellesWav = WiedergabeListe(AktuellerIndex)

    mciSendString "close mywav", 0, 0, 0

    mciSendString "open """ & AktuellesWav & """ type waveaudio alias mywav", 0, 0, 0

    mciSendString "play mywav", 0, 0, 0

    PruefeWiedergabe

End Sub



Sub PauseWiedergabe()

    PauseAktiv = True

    mciSendString "pause mywav", 0, 0, 0

End Sub



Sub WeiterWiedergabe()

    PauseAktiv = False

    mciSendString "resume mywav", 0, 0, 0

    PruefeWiedergabe

End Sub



Sub StopWiedergabe()

    Abbruch = True

    PauseAktiv = False

    mciSendString "stop mywav", 0, 0, 0

    mciSendString "close mywav", 0, 0, 0

End Sub



Function GetMciPosition() As Long

    Dim ret As String * 32

    mciSendString "status mywav position", ret, 32, 0

    GetMciPosition = Val(ret)

End Function



Function GetMciLength() As Long

    Dim ret As String * 32

    mciSendString "status mywav length", ret, 32, 0

    GetMciLength = Val(ret)

End Function



Sub PruefeWiedergabe()

    Dim pos&, total&, t#

    If PauseAktiv Or Abbruch Then Exit Sub

    pos = GetMciPosition()

    total = GetMciLength()

    If pos >= total Then

        AktuellerIndex = AktuellerIndex + 1

        SpieleAktuellesWav

        Exit Sub

    End If

    t = Timer

    Do While Timer - t < 0.02   ' 20 ms warten

        DoEvents

    Loop

    PruefeWiedergabe

End Sub



Sub StarteWiedergabeListe(ParamArray wavs() As Variant)

    Dim i&

    Set WiedergabeListe = New Collection

    For i = LBound(wavs) To UBound(wavs)

        WiedergabeListe.Add wavs(i)

    Next i

    AktuellerIndex = 1

    PauseAktiv = False

    Abbruch = False

    SpieleAktuellesWav

End Sub



Sub TestTTSQueue()

    Dim w1$, w2$, w3$

    w1 = Environ$("TEMP") & "\tts1.wav"

    w2 = Environ$("TEMP") & "\tts2.wav"

    w3 = Environ$("TEMP") & "\tts3.wav"

    TextToWav "Dies ist der erste Text.", w1

    TextToWav "Dies ist der zweite Text.", w2

    TextToWav "Dies ist der dritte Text.", w3

    StarteWiedergabeListe w1, w2, w3

End Sub