etTextToSpeech Sample Program Source Code

NOTE: This sourcecode is uncommented here, but complete commented code is including it the downloadable project.

To see Delphi Source, click HERE

**********************************************************************************
Option Explicit
Dim WithEvents spVoice1 As SpVoice
Dim MMSysAudioOut1 As ISpeechMMSysAudio
Private bBeenPaused As Boolean
Private iSpeechFlags As Integer Private iLastGoodFormat As Integer
Dim bResult As Boolean
Dim bStreamDone As Boolean Dim L, I, W As Integer
Dim X As etTT37.TxWAVFORMATS ' TeleTools wave format structure

'************************************************

' Form_Load

'************************************************

Private Sub Form_Load()

On Error GoTo ErrHandler

etLine1.Enabled = True

etPlay1.Enabled = True

etRecord1.Enabled = True

bFromFormLoad = True

Set spVoice1 = New SpVoice

spVoice1.EventInterests = SVEAllEvents

Set MMSysAudioOut1 = New SpMMAudioOut

etLine1.DeviceIdleDelay = 3000

TextPhoneNumber.Text = etLine1.CallPhoneNumber

ComboBoxDevice.Clear

etLine1.DeviceId = 0
For L = 0 To etLine1.DeviceCount - 1

ComboBoxDevice.AddItem etLine1.DeviceList(L)

Next L

If ComboBoxDevice.ListCount > 0 Then

ComboBoxDevice.Text = ComboBoxDevice.List(0)

End If

ComboBoxDevice.ListIndex = 0

For W = 0 To etPlay1.DeviceCount - 1

ComboBoxWaveDevice.AddItem etPlay1.DeviceList(W)

Next W

If ComboBoxWaveDevice.ListCount > 0 Then

ComboBoxWaveDevice.Text = ComboBoxWaveDevice.List(0)

End If

ComboBoxWaveDevice.ListIndex = 0 ' point to first device

For X = wfUnknown To wfIMAADPCM08000M04

etRecord1.SourceFormatID = X

ComboBoxWaveFormats.AddItem etRecord1.SourceFormatName

Next X

If ComboBoxWaveFormats.ListCount > 0 Then

ComboBoxWaveFormats.ListIndex = 3

iLastGoodFormat = 3

End If

WriteLog ("Enumerating Voices...")

Dim Token As ISpeechObjectToken

For Each Token In spVoice1.GetVoices

ComboBoxVoices.AddItem (Token.GetDescription())

ComboBoxVoices.ListIndex = 0

WriteLog ("Enumerated Voices")

WriteLog ("About to check attributes...")

SliderSpeechRate.Value = spVoice1.Rate

LabelRatePos.Caption = Str(SliderSpeechRate.Value)

SliderVolume.Value = spVoice1.Volume

LabelVolumePos.Caption = Str(SliderVolume.Value)

WriteLog ("Rate = " & Str(SliderSpeechRate.Value))

WriteLog ("Volume = " & Str(SliderVolume.Value))

WriteLog ("Checked attributes")

iSpeechFlags = SVSFlagsAsync Or SVSFPurgeBeforeSpeak Or SVSFIsXML

ComboBoxWaveDevice.ListIndex = 0

bFromFormLoad = False

cmdButtonHangup.Enabled = False

cmdButtonAnswer.Enabled = False

Exit Sub

ErrHandler:

MsgBox "Error in initialization: " & vbCrLf & vbCrLf & Err.Description & _

vbCrLf & vbCrLf & "Shutting down.", vbOKOnly, "TTSApp"

Set spVoice1 = Nothing

Set MMSysAudioOut1 = Nothing

End

End Sub

'*****************************************************************************

' CheckBoxActive_Click - Activate and Deactivate the TAPI Line device

'*****************************************************************************

Private Sub CheckBoxActive_Click()

If CheckBoxActive.Value = 0 Then

If etLine1.DeviceActive Then

WriteLog ("Deactivating the device...")

cmdButtonStop_Click

etLine1.DeviceActive = False

If Not etLine1.DeviceActive Then

WriteLog ("etLine1.Device.Active = False")

cmdButtonDial.Enabled = False

ComboBoxWaveDevice.Enabled = True

cmdButtonSpeak.Enabled = False

Else

WriteLog (vbTab & "Error = " & etLine1.ErrorText)

CheckBoxActive.Value = 1

End If

Else

If Not etLine1.DeviceActive Then

cmdButtonHangup.Enabled = False

WriteLog ("Activating the " & etLine1.DeviceName & " device...")

etLine1.DeviceActive = True

If etLine1.ErrorNumber = INVALID_SERIAL_NUMBER Then

MsgBox ("Error opening line device: " & etLine1.ErrorText & vbCrLf & vbCrLf & _

"See the help topic:" & vbCrLf & vbCrLf & _

vbTab & "Why Serial Numbers Are Important")

End If

If (Not etLine1.DeviceActive) And (etLine1.ErrorNumber = LINEERR_INVALMEDIAMODE) And _

(InStr(1, etLine1.TAPITSP, "Modem", 1) > 0) Then

etLine1.PrivilegeNone = True 'set proper priviledge for incompatible modems

etLine1.DeviceActive = True

MsgBox ("The program has detected that your device is a (" + etLine1.DeviceName & _

") DATA modem and therefore has no voice capabilities." & vbCrLf & vbCrLf & _

"We will now force a compatibility mode in order to allow you to " & _

" continue while greying out options your modem may not support." & vbCrLf & vbCrLf & _

"This device will be able to:" & vbCrLf & vbCrLf & vbTab & "DIAL" & vbCrLf & vbCrLf & _

"If you think you have a voice modem, expected more functionality, " & _

"or other programs provide more functionality with this modem, see the " & _

"topic 'Working with Modems' in the Appendix of the TeleTools help file.")

End If

If etLine1.DeviceActive Then

WriteLog ("etLine1.Device.Active = True")

cmdButtonSpeak.Enabled = False

cmdButtonDial.Enabled = True

ComboBoxWaveDevice.ListIndex = etLine1.WavePlayID

ComboBoxWaveDevice_Click ' force OnChange event

ComboBoxWaveDevice.Enabled = False

Else

WriteLog (vbTab & "Error = " & etLine1.ErrorText)

CheckBoxActive.Value = 0

End If

Else

WriteLog ("There is a problem, check your device!")

CheckBoxActive.Value = 0

End If

End Sub

'*****************************************************************************

' ComboBoxDevice_Click - Process device change. If no errors, then device is

' TAPI compliant so set privileges accordingly

'*****************************************************************************

Private Sub ComboBoxDevice_Click()

If bFromFormLoad Then Exit Sub
cmdButtonStop_Click

CheckBoxActive.Value = False

etLine1.DeviceId = ComboBoxDevice.ListIndex

WriteLog ("etLine1.DeviceName = " & etLine1.DeviceName)

CheckBoxActive_Click

If etLine1.ErrorNumber <> 0 Then

WriteLog (vbTab & "Error = " & etLine1.ErrorText)

End If

End Sub

'*****************************************************************************

' ComboBoxWaveDevice_Click - Change the wave output device

'*****************************************************************************

Private Sub ComboBoxWaveDevice_Click()

Dim fFormat As ISpeechWaveFormatEx

On Error GoTo ErrHandler

If bFromFormLoad Then Exit Sub

If CheckBoxActive.Value = 1 Then

MMSysAudioOut1.DeviceId = etLine1.WavePlayID

Else

MMSysAudioOut1.DeviceId = ComboBoxWaveDevice.ListIndex

End If

WriteLog ("Audio Out = " & ComboBoxWaveDevice.Text)

etRecord1.SourceFormatID = ComboBoxWaveFormats.ListIndex

Set fFormat = New SpWaveFormatEx

fFormat.FormatTag = etRecord1.SourceFormatTag

fFormat.Channels = etRecord1.SourceFormatChannels

fFormat.SamplesPerSec = etRecord1.SourceFormatSamplesPerSec

fFormat.AvgBytesPerSec = etRecord1.SourceFormatAvgBytesPerSec

fFormat.BlockAlign = etRecord1.SourceFormatBlockAlign

fFormat.BitsPerSample = etRecord1.SourceFormatBitsPerSample

Call MMSysAudioOut1.Format.SetWaveFormatEx(fFormat)

WriteLog ("Source.Format = " & etRecord1.SourceFormatName)

WriteLog ("Source.Format = " & MMSysAudioOut1.Format.Type)

spVoice1.AllowAudioOutputFormatChangesOnNextSet = False

Set spVoice1.AudioOutputStream = MMSysAudioOut1

iLastGoodFormat = ComboBoxWaveFormats.ListIndex

WriteLog ("etLine1.DeviceID = " & Str(etLine1.DeviceId))

If etLine1.ErrorNumber <> 0 Then

WriteLog (vbTab & "Error = " & etLine1.ErrorText)

End If

Exit Sub

ErrHandler:

Dim myError As String

myError = Err.Description

WriteLog ("Set audio output error: " & myError)

If Left(myError, 24) = "Method 'SetWaveFormatEx'" Then

MsgBox ("Bad Wave Format... Try Another!")

ComboBoxWaveFormats.ListIndex = iLastGoodFormat

End If

End Sub

'*****************************************************************************

' ComboBoxVoice_Click - Change the speaking voice

'*****************************************************************************

Private Sub ComboBoxVoices_Click()

Dim SOTokenVoice As ISpeechObjectToken

Set SOTokenVoice = spVoice1.Voice

Set spVoice1.Voice = spVoice1.GetVoices().Item(ComboBoxVoices.ListIndex)

WriteLog ("Current Voice ComboBox.ItemIndex = " & Str(ComboBoxVoices.ListIndex))

WriteLog (vbTab & "Name: " & SOTokenVoice.GetAttribute("Name"))

WriteLog (vbTab & "Vendor: " & SOTokenVoice.GetAttribute("Vendor"))

WriteLog (vbTab & "Age: " & SOTokenVoice.GetAttribute("Age"))

WriteLog (vbTab & "Gender: " & SOTokenVoice.GetAttribute("Gender"))

WriteLog (vbTab & "Language: " + SOTokenVoice.GetAttribute("Language"))

WriteLog (vbTab + "Reg key: " & SOTokenVoice.Id)

End Sub

'*****************************************************************************

' ComboBoxWaveFormats_Click - Change the wave format

'*****************************************************************************

Private Sub ComboBoxWaveFormats_Click()

cmdButtonStop_Click

Call ComboBoxWaveDevice_Click

End Sub

'*****************************************************************************

' SliderSpeechRate_Click - Change the rate of speech

'*****************************************************************************

Private Sub SliderSpeechRate_Click()

spVoice1.Rate = SliderSpeechRate.Value

LabelRatePos.Caption = Str(SliderSpeechRate.Value)

End Sub

'*****************************************************************************

' SliderVolume_Click - Change the speech volume

'*****************************************************************************

Private Sub SliderVolume_Click()

spVoice1.Volume = SliderVolume.Value

LabelVolumePos.Caption = Str(SliderVolume.Value)

End Sub

'*****************************************************************************

' cmdButtonDial_Click - Dial an outgoing call using etLine

'*****************************************************************************

Private Sub cmdButtonDial_Click()

etLine1.CallHandle = 0

etLine1.CallPhoneNumber = TextPhoneNumber.Text

WriteLog ("Dialing [" & TextPhoneNumber.Text & "]")

If etLine1.CallDial Then

cmdButtonDial.Enabled = False

cmdButtonHangup.Enabled = True

Else

WriteLog (vbTab & "Error = " & etLine1.ErrorText)

etLine1.CallHangup

End If

End Sub

'*****************************************************************************

' cmdButtonHangup_Click - Hangup an active call using etLine

'*****************************************************************************

Private Sub cmdButtonHangup_Click()

WriteLog ("Hangup")

If (etLine1.CallHandle <> 0) And (etLine1.CallState <> LINECALLSTATE_IDLE) Then

cmdButtonStop_Click ' make sure to stop speech if playing

If etLine1.CallHangup Then ' if hangup returned true then...

cmdButtonHangup.Enabled = False

Else

WriteLog (vbTab & "Error = " & etLine1.ErrorText)

End If

Else

WriteLog ("Error Hanging Up " & etLine1.ErrorText)

End If

End Sub

'************************************************

' cmdButtonSpeak_Click - Play speech

'************************************************

Private Sub cmdButtonSpeak_Click()

On Error GoTo ErrHandler

If Not bBeenPaused Then

spVoice1.Speak TextBoxTextToSpeak, iSpeechFlags

Else

spVoice1.Resume

bBeenPaused = False

cmdButtonPause.Picture = cmdButtonPause.DisabledPicture

WriteLog ("Speech Resumed")

End If

Exit Sub

ErrHandler:

WriteLog ("Set audio output error: " & Err.Description)

End Sub

'*****************************************************************************

' cmdButonPause_Click - Pause the speech stream

'*****************************************************************************

Private Sub cmdButtonPause_Click()

WriteLog ("Pause pressed")

If bBeenPaused Then

spVoice1.Resume

bBeenPaused = False

cmdButtonPause.Picture = cmdButtonPause.DisabledPicture

WriteLog ("Speech Resumed")

Else

spVoice1.Pause

bBeenPaused = True

cmdButtonPause.Picture = cmdButtonPause.DownPicture

WriteLog ("Speech Paused")

End If

End Sub

'*****************************************************************************

' cmdButtonStop_Click - Stop the speech stream

'*****************************************************************************

Private Sub cmdButtonStop_Click()

On Error GoTo ErrHandler

WriteLog ("stop pressed")

If spVoice1.Status.RunningState = SRSEIsSpeaking Then

WriteLog ("Running State = 2 (SRSEIsSpeaking)")

spVoice1.Speak vbNullString, SVSFPurgeBeforeSpeak

' SpVoice1.Skip "Sentence", reallybignumber ' alternate method

Else

WriteLog ("Running State = " & Str(spVoice1.Status.RunningState))

End If

Exit Sub

ErrHandler:

WriteLog ("Speak Error: " & Err.Description)

End Sub

'*****************************************************************************

' cmdButtonAnswer - Answer an incoming call using etLine

'*****************************************************************************

Private Sub cmdButtonAnswer_Click()

If etLine1.CallAnswer Then

WriteLog ("etLine1.CallAnswer = True")

Else

WriteLog (vbTab & "Error Answering = " & etLine1.ErrorText)

End If

End Sub

'************************************************************************

' cmdButtonLineConfig_Click - Display the device configuration screen for

' the TAPI hardware. This is tied to the hardware manufacturer's

' Terminal Service Provider or driver, also known as a TSP

'************************************************************************

Private Sub cmdButtonLineConfig_Click()

etLine1.DeviceConfigure

End Sub

' ************************************************************************

' cmdButtonTeleScope_Click - Enable TeleScope Tool

' TeleScope is an amazing prototying, testing, debugging, and diagnostic tool

' Click the TeleScope button and watch what happens in it's logs. Place and receive

' calls and a LOT more. See the help file section "Using TeleScope"

' ************************************************************************

Private Sub cmdButtonTeleScope_Click()

etLine1.TeleScopeVisible = True

etPlay1.TeleScopeVisible = True

etRecord1.TeleScopeVisible = True

WriteLog ("TeleScopes set to 'visible'")

End Sub

' ************************************************************************

' cmdButtonClearLog_Click - Clear the call status log window

' ************************************************************************

Private Sub cmdButtonClearLog_Click()

TextCallProgress.Text = Empty

End Sub

' ************************************************************************

' cmdButtonInfo_Click - Display about box

' ************************************************************************

Private Sub cmdButtonInfo_Click()

& vbCrLf & vbCrLf & " www.exceletel.com")

End Sub

'*****************************************************************************

' etLine1_OnOffering - An incoming call is being "offered"

'*****************************************************************************

Private Sub etLine1_OnOffering(ByVal CallHandle As Long)

etLine1.CallHandle = CallHandle

WriteLog ("OnOffering")

cmdButtonAnswer.Enabled = True

End Sub