Working with Text to Speech (TTS)
SAPI = Speech Application Program Interface How to define TTS(text to speech)? Text to speech, abbreviated as TTS, is a form of speech synthesis that converts text into spoken voice output. TTS systems were first developed to aid the visually impaired by offering a computer-generated spoken voice that would "read" text to the user. its is a type of speech synthesis application that is used to create a spoken sound version of the text in a computer document,such as a help file or a Web page.Actually its used anywhere on web sites, reading books,reading helps,interacting apps,games... The actual version of windows fall creator TTS is the version 5. VFP can embed as olecontrol or as hidden object the TTS controldefined from the %windir%\system32\speech\common\sapi.dll.its a com object (in other words can be created from createObject or NewObject("SAPI.SPVoice").it have PEM. you can embed the com object [%windir%\system32\speech\common\sapi.dll] in the vfP object browser (vfp/menu/tools) and see all its classes,interfaces,constants,methods properties and events. you can drag the interfaces to a prg file ands work with (for advanced only). the codes below have for goal to make some demos with this object with many capabilities. if you are interested with SAPI constants drag from vfp object browser 832 constants into a h file for ex. In principe the sapi.dll is in the system folder above.its not appears in menu/tools/options/controls but can test it with : vartype[createObject("sapi.spvoice).] must return an object otherwise sapi not installed on system. the voices depend on system and some voices also added (its not free to add male oir female voices.) in my windows fall creator there is 2 voices (french and US English).If you have another voices ,you may have to tweak the code for that for making it working. *Voices installed on my system *Microsoft Hortense Desktop - French* as item 0 *Microsoft Zira Desktop - English (United States) as item 1 for web urls internet vonnrction must be some fast to make the code works as well. there is some free TTS on the web as eSPEAk(there is many voices as Arabic) but the speakers look like robots and have very bad spellings. the advantage in eSpeak can work with MS TTS voices.it have an interface as application and can be manipulated as command line. this is a good starting for who want to know more on this object. [post252]
Click on code to select [then copy] -click outside to deselect
*1* created on sunday 31 of december 2017 updated same date.
*run the code the help is spoken (in the menu location FR or EN).
*Warning:must adjust the voices installed on your system accordingly to the combobox and change the item(?) number in code.
* i cleaned all voices other than native installed on windows fall creator (version 1709) to leave only 2 voices (for a standard demo) as follow:
*i retouched the items number in code for these 2voices only.
*Voices installed on my system
*Microsoft Hortense Desktop - French* as item 0
*Microsoft Zira Desktop - English (United States) as item 1
Public oform
oform=Newobject("ySAPI")
oform.Show
Return
Define Class ySAPI As Form
BorderStyle = 0
Height = 476
Width = 1003
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "Form1"
MaxButton = .F.
ycl = 0
tour=0
Name = "Form1"
Add Object combo1 As ComboBox With ;
Height = 27, ;
Left = 217, ;
Top = 51, ;
Width = 239, ;
Name = "Combo1"
Add Object edit1 As EditBox With ;
FontBold = .T., ;
Height = 456, ;
Left = 461, ;
Top = 12, ;
Width = 534, ;
margin=10,;
ForeColor = Rgb(255,255,255), ;
BackColor = Rgb(0,0,0), ;
Name = "Edit1"
Add Object olecontrol1 As OleControl With ;
oleclass="MSComctlLib.Slider.2",;
Top = 19, ;
Left = 206, ;
Height = 24, ;
Width = 100, ;
Name = "Olecontrol1"
Add Object olecontrol2 As OleControl With ;
oleclass="MSComctlLib.Slider.2",;
Top = 18, ;
Left = 323, ;
Height = 24, ;
Width = 100, ;
Name = "Olecontrol2"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
BackStyle = 0, ;
Caption = "Volume(0-100)", ;
Height = 18, ;
Left = 214, ;
Top = 2, ;
Width = 91, ;
Name = "Label1"
Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
BackStyle = 0, ;
Caption = "Rate (-10-10)", ;
Height = 18, ;
Left = 334, ;
Top = 2, ;
Width = 79, ;
Name = "Label2"
Add Object list1 As ListBox With ;
Height = 445, ;
Left = 3, ;
Top = 24, ;
Width = 192, ;
ItemTips = .T., ;
Name = "List1"
Add Object label4 As Label With ;
AutoSize = .T., ;
FontName = "Webdings", ;
FontSize = 20, ;
BackStyle = 0, ;
Caption = "3", ;
Height = 32, ;
Left = 26, ;
MousePointer = 15, ;
Top = -6, ;
Width = 29, ;
ForeColor = Rgb(255,0,0), ;
ToolTipText = "Collapse/expand", ;
Name = "Label4"
Add Object ycnt As ycnt With ;
Top = 83, ;
Left = 256, ;
Width = 88, ;
Height = 30, ;
SpecialEffect = 0, ;
BackColor = Rgb(0,0,128), ;
Name = "ycnt"
Add Object check1 As Checkbox With ;
Top = 84, ;
Left = 383, ;
Height = 17, ;
Width = 72, ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "ReadOnly", ;
Value = .F., ;
Name = "Check1"
Procedure olecontrol1.Change
oSAPI.Volume=This.Value
Endproc
Procedure olecontrol2.Change
oSAPI.rate=This.Value
Endproc
Procedure yurl
Lparameters xx
With m.oSAPI
.rate=0 &&-10-10 set the voice speed from low to fast, 0=normal
.Volume=80 &&0-100 set the voice volume from silent (0) to max=100
Endwith
*type ALT+D to stop oSapi at any time
*ON KEY LABEL F3 m.OSAPI.pause
*On key label F4 m.OSAPI.resume
*on key label F5 m.OSAPI.speak("",2)
*on key label F7 do ystop.prg &&function or procedure dont available ???here external code ok
Local lcURL
Do Case
Case m.xx=0
m.lcURL="http://texcier-cdi.spip.ac-rouen.fr/IMG/Hugo%204%B0/pagesweb/j%20-%20cosette1.htm"
Case m.xx=1
m.lcURL="http://www.online-literature.com/victor_hugo/les_miserables/28/"
Endcase
Local apie
apie=Newobject("internetExplorer.application") &&can acess to plain text here
With apie
Do Case xx=0
Thisform.combo1.Value=1 &&fr
Case xx=1
Thisform.combo1.Value=2 &&us english
Endcase
Wait Window m.lcURL Timeout 1
.Navigate(m.lcURL)
Thisform.MousePointer=13 &&hide pointer
Local m.t0,m.lok
m.t0=Seconds()
m.lok=.F.
Do While .readystate#4
If Seconds()-t0>60 &&if pb internet(very slow)
m.lok=.T.
Exit
Endi
Enddo
Inke(1)
If m.lok=.T.
Messagebox("there is internet problem....cancelling this procedure!",4+4096,'error',4000)
Return
Endi
m.xtext=.Document.body.innerText
Endwith
apie=Null
Release apie
*_cliptext=m.xtext
Thisform.edit1.Value=m.xtext
Thisform.ycnt.ycom1.Click() &&speak with the defined voice
Thisform.MousePointer=0
Retu
Endproc
Procedure ywav
TEXT to thisform.edit1.value pretext 7 noshow
this message is in english language.
Hello everybody.
Here is the president of the company who speaks to you.
I ask you to confirm whether you listened well to my speech yesterday.
Please comment and expressly send me your comments.
I remain of course at your disposal.
good bye and thank you
ENDTEXT
Thisform.ycl=0
Thisform.combo1.Value=2 &&english us
Inke(1)
Local loStream
loStream = Createobject("SAPI.SPFileStream")
** Create the Wav file
If File(m.yrep+"yVoice.wav") &&unique
Erase (m.yrep+"yVoice.wav")
Endi
loStream.Open("yVoice.wav", 3) &&open to write :The TTS voice will speak this text into this file.
** Specify that the Audio from the voice is sent to the stream
m.oSAPI.AudioOutputStream = loStream
m.oSAPI.Volume=100
m.oSAPI.rate=0
*!* ** Change the voice to english us
m.oSAPI.Voice = m.oSAPI.GetVoices.Item(1)
Thisform.MousePointer=13
m.oSAPI.Speak(Thisform.edit1.Value)
loStream.Close
** Reset the output stream
m.oSAPI.AudioOutputStream = Null
** Open the WAV file for reading purposes
loStream.Open("yVoice.wav")
*speak the recorded wav stream
m.oSAPI.SpeakStream(loStream)
loStream=Null
Thisform.MousePointer=0
Endproc
Procedure yreadwav
*another way to read the wav file created
If !File("yVoice.wav")
Messagebox("yVoice.wav not created yet!",4+4096,'',1200)
Return .F.
Endi
Thisform.edit1.Value=""
Local Wmp As WindowsMediaPlayer
Wmp = Createobject("WMPlayer.OCX.7")
With Wmp
.url="yVoice.Wav"
Inke(1) &&important to load media otherwise return 0
Local m.xdur
m.xdur=.currentmedia.Duration
Messagebox("Duration="+Trans(m.xdur,"99.9")+" sec",032+4096,'',1200)
.settings.autoStart = .T.
.settings.Volume=100
.settings.setMode('loop',.F.) &&.t. for loop
.Controls.Play
Endwith
Inke(m.xdur+0.5)
Wmp=Null
Release Wmp
Endproc
Procedure yreadwmusic
Local m.lcfile
m.lcfile=Getfile('wav')
If Empty(m.lcfile) Or ! Lower(Justext(m.lcfile))=="wav"
Return .F.
Endi
Thisform.edit1.Value=""
Local loStream
loStream = Createobject("SAPI.SPFileStream")
m.oSAPI.Volume=80
m.oSAPI.rate=0
*!* ** Change the voice to english us
m.oSAPI.Voice = m.oSAPI.GetVoices.Item(0) &&any voice
Thisform.MousePointer=13 &&hide mouse pointer
** Open the WAV file for reading purposes
loStream.Open(m.lcfile)
*speak the recorded wav stream
m.oSAPI.SpeakStream(loStream)
loStream=Null
Thisform.MousePointer=0
Endproc
Procedure yvoices
Local m.x
m.x="Voices installed on the system"+Chr(13)+Chr(13)
For Each Voice In m.oSAPI.GetVoices
m.x=m.x+Voice.getDescription+Chr(13)
Next
Thisform.edit1.Value=m.x
Endproc
Procedure my1
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.ForeColor=255
Endproc
Procedure my2
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.ForeColor=0
Endproc
Procedure ytext
Lparameters x
If Pcount()=0 Or !Inlist(x,0,1)
Return .F.
Endi
Local m.lcfile
m.lcfile=Getfile('txt')
If Empty(m.lcfile) Or ! Lower(Justext(m.lcfile))=="txt"
Return .F.
Endi
Messagebox(x)
Thisform.ycl=0
Do Case
Case x=0 &&fr
Thisform.combo1.Value=1
Case x=1 &&en
Thisform.combo1.Value=2
Endcase
Thisform.edit1.Value=Filetostr(m.lcfile)
m.oSAPI.Voice=m.oSAPI.GetVoices.Item(Thisform.combo1.Value-1)
m.oSAPI.Speak(Thisform.edit1.Value,1+2)
Endproc
Procedure yflags
TEXT to thisform.edit1.value pretext 7 noshow
The SpeechVoiceSpeakFlags enumeration lists flags that control the SpVoice.Speak method.
Enum SpeechVoiceSpeakFlags
'SpVoice Flags
SVSFDefault = 0
SVSFlagsAsync = 1
SVSFPurgeBeforeSpeak = 2
SVSFIsFilename = 4
SVSFIsXML = 8
SVSFIsNotXML = 16
SVSFPersistXML = 32
'Normalizer Flags
SVSFNLPSpeakPunc = 64
'TTS Format
SVSFParseSapi =
SVSFParseSsml =
SVSFParseAutoDetect =
'Masks
SVSFNLPMask = 64
SVSFParseMask =
SVSFVoiceMask = 127
SVSFUnusedFlags = -128
End Enum
SVSFDefault : Specifies that the default settings should be used.
The defaults are:
To speak the given text string synchronously (override with SVSFlagsAsync),
Not to purge pending speak requests (override with SVSFPurgeBeforeSpeak),
To parse the text as XML only if the first character is a left-angle-bracket (override with SVSFIsXML or SVSFIsNotXML),
Not to persist global XML state changes across speak calls (override with SVSFPersistXML), and
Not to expand punctuation characters into words (override with SVSFNLPSpeakPunc).
SVSFlagsAsync: Specifies that the Speak call should be asynchronous. That is, it will return immediately after the speak request is queued.
SVSFPurgeBeforeSpeak: Purges all pending speak requests prior to this speak call.
SVSFIsFilename: The string passed to the Speak method is a file name rather than text. As a result, the string itself is not spoken but rather the file the path that points to is spoken.
SVSFIsXML: The input text will be parsed for XML markup.
SVSFIsNotXML: The input text will not be parsed for XML markup.
SVSFPersistXML: Global state changes in the XML markup will persist across speak calls.
SVSFNLPSpeakPunc: Punctuation characters should be expanded into words (e.g. "This is it." would become "This is it period").
SVSFParseSapi: Force XML parsing as MS SAPI.
SVSFParseSsml: Force XML parsing as W3C SSML.
SVSFParseAutoDetect: The TTS XML format is auto-detected. This is the default if none of these TTS XML format values are present in the bit-field.
SVSFNLPMask: Flags handled by SAPI (as opposed to the text-to-speech engine) are set in this mask.
SVSFParseMask: SVSFParseSapi|SVSFParseSsml
SVSFVoiceMask: This is an existing SAPI 5.1 mask that has every flag bit set. In 5.3, it has been extended to contain SVSFParseMask.
SVSFUnusedFlags: This mask has every unused bit set.
*https://msdn.microsoft.com/en-us/library/ms720892(v=vs.85).aspx
ENDTEXT
With Thisform
.ycl=0
.combo1.Value=2 &&en
.ycnt.ycom1.Click
Endwith
Endproc
Procedure yxml
TEXT to thisform.edit1.value pretext 7 noshow
<rate absspeed="0">
<volume level="100">
SAPI TTS XML supports five tags that control the state of the current voice: Volume, Rate, Pitch, Emph, and Spell.
</volume>
</rate>
<rate absspeed="5">
This text should be spoken at rate five.its very fast speaking.
<rate absspeed="-5">
This text should be spoken at rate negative five.its very slow speaking.
</rate>
<rate absspeed="0">
This text should be spoken at rate zero.IOts the normal behavior of a normal voice.
At the end of this code the rate is established to zero as normal voice.
</rate>
</rate>
<rate absspeed="0">
TTS is capable to read xm syntax and return spoken text.can code properties in the xml tag to speak accordingly.
</rate>
<volume level="20">
This text should be spoken at volume level 20.
<volume level="70">
This text should be spoken at volume level 70.
<volume level="100">
This text should be spoken at volume level 100.
</volume>
</volume>
</volume>
*https://msdn.microsoft.com/en-us/library/ms717077(v=vs.85).aspx
ENDTEXT
Thisform.ycl=0
Thisform.combo1.Value=2 &&en
Thisform.ycnt.ycom1.Click
Endproc
Procedure Activate
Inke(1)
If Thisform.tour=0 &&read one time only at start
With m.oSAPI
.Voice=.GetVoices.Item(1) &&en
.Speak("Hello this is a demonstration of capabilities of the text to Speech.Can see the english help for more informations",1+2) &&asynchronous and purge
.WaitUntilDone(-1) &&wait until the last TTS is done.can make a timeout here
.Voice=.GetVoices.Item(0) &&fr
.Speak("Bonjour Ceci est une démonstration de ce dont est capable 'text to Speech.Vous pouvez vor l'aide en français pour plus d'informations. '",1+2)
Endwith
Endi
Thisform.tour=1
Endproc
Procedure Destroy
m.oSAPI=Null
Release m.oSAPI
m.yrep=Null
Release m.yrep
Clea Events
Endproc
Procedure Init
Set Safe Off
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
With Thisform
.olecontrol1.Min=0
.olecontrol1.Max=100
.olecontrol1.Value=100
.olecontrol2.Min=-10
.olecontrol2.Max=10
.olecontrol2.Value=0
Endwith
Publi m.oSAPI
m.oSAPI=Createobject("SAPI.SPVoice")
With m.oSAPI
.rate=Thisform.olecontrol2.Value &&-10-10 set the voice speed from low to fast, 0=normal
.Volume=Thisform.olecontrol1.Value &&0-100 set thge voice volume from silent (0) to max=100
Endwith
With Thisform.combo1
For Each Voice In m.oSAPI.GetVoices
.AddItem(Voice.getDescription)
Next
.ListIndex=1
.Value=1
.Style=2
Endwith
Endproc
Procedure KeyPress
Lparameters nKeyCode, nShiftAltCtrl
If nKeyCode=27 &&press ESC to exit app
Thisform.Release
Endi
Endproc
Procedure edit1.RightClick
Set Color Of Scheme 1 To N+/w*,GR+/N*,,,,w+/R
Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol() Color Scheme 1
Define Bar _Med_slcta Of raccourci Prompt "Sélectionner tout" ;
KEY CTRL+A, "Ctrl+A" ;
PICTRES _Med_slcta ;
MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
Define Bar _Med_paste Of raccourci Prompt "Coller" ;
KEY CTRL+V, "Ctrl+V" ;
PICTRES _Med_paste ;
MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
Define Bar _Med_copy Of raccourci Prompt "Copier" ;
KEY CTRL+C, "Ctrl+C" ;
PICTRES _Med_copy ;
MESSAGE "Copie la sélection et la place dans le Presse-papiers"
Define Bar _Med_cut Of raccourci Prompt "Couper" ;
KEY CTRL+x, "Ctrl+X" ;
PICTRES _Med_cut ;
MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
Define Bar _Med_redo Of raccourci Prompt "Rétablir" ;
KEY CTRL+R, "Ctrl+R" ;
PICTRES _Med_redo
Define Bar _Med_undo Of raccourci Prompt "Annuler" ;
KEY CTRL+Z, "Ctrl+Z" ;
PICTRES _Med_undo ;
MESSAGE "Annule la dernière modification"
Activate Popup raccourci
Endproc
Procedure list1.Init
With This
.AddItem("1.french TTS")
.AddItem("2.English TTS")
.AddItem("3.Speak a web page in FR")
.AddItem("4.Speak a web page in EN")
.AddItem("5.Save TTS to wav")
.AddItem("6.Play wav with WMP")
.AddItem("7.SAPI play a wav music")
.AddItem("8.Get all installd voices")
.AddItem("9.Speak from txt file FR")
.AddItem("10.Speak from txt file EN")
.AddItem("11.Help in EN")
.AddItem("12.Help in FR")
.AddItem("13.Speak flags")
.AddItem("14. Using XML")
.Value=1
.SelectedItemBackColor=Rgb(70,60,50)
.SelectedItemForeColor=Rgb(10,191,160)
.SpecialEffect=1
.FontSize=9
.FontBold=.T.
.ItemBackColor=Rgb(40,40,40)
.ItemForeColor=Rgb(255,204,153)
.BorderColor=Rgb(235,132,0)
.ItemTips=.T.
.MousePointer=15
.ListIndex=1
Endwith
Endproc
Procedure list1.Click
Do Case
Case This.Value=1
TEXT to thisform.edit1.value pretext 7 noshow
Ce message est en français.
Bonjour tout le monde.
Ici c'est le président de la compagnie qui vous parle.
Je vous demande de bien vouloir confirmer si vous avez bien écouté mon discours d'hier.
Veuillez le commenter et m'envoyer expressement vos observations.
je reste bien entendu à votre entière disposition.
au revoir et merci
ENDTEXT
With Thisform
.ycl=0
.combo1.Value=1 &&fr
.ycnt.ycom1.Click
Endwith
Case This.Value=2
TEXT to thisform.edit1.value pretext 7 noshow
this message is in english language.
Hello everybody.
Here is the president of the company who speaks to you.
I ask you to confirm whether you listened well to my speech yesterday.
Please comment and expressly send me your comments.
I remain of course at your disposal.
good bye and thank you
ENDTEXT
With Thisform
.ycl=0
.combo1.Value=2
.ycnt.ycom1.Click
Endwith
Case This.Value=3
Thisform.yurl(0)
Case This.Value=4
Thisform.yurl(1)
Case This.Value=5
Thisform.ywav()
Case This.Value=6
Thisform.yreadwav()
Case This.Value=7
Thisform.yreadwmusic()
Case This.Value=8
Thisform.yvoices
Case This.Value=9
Thisform.ytext(0)
Case This.Value=10
Thisform.ytext(1)
Case This.Value=11
Thisform.yhelp(0) &&en
Case This.Value=12
Thisform.yhelp(1) &&fr
Case This.Value=13
Thisform.yflags()
Case This.Value=14
Thisform.yxml()
Endcase
Endproc
Procedure yhelp
Lparameters x
Do Case
Case x=1
TEXT to thisform.edit1.value pretext 7 noshow
Comment définir TTS (text to speech)?
Text to speech, abrégé en TTS, est une forme de synthèse vocale qui convertit le texte en une sortie vocale.
Les systèmes TTS ont d'abord été développés pour aider les malvoyants en offrant une voix parlée par ordinateur qui «lirait» le texte à l'utilisateur.
C'est un type d'application de synthèse vocale qui est utilisé pour créer une version audio parlée du texte dans un document informatique, tel qu'un fichier d'aide ou
une page Web.En fait, il est utilisé partout sur les sites Web, la lecture de livres, aide à la lecture, l'interaction des applications, des jeux ...
La version actuelle de Windows automne créateur TTS est la version 5.
VFP peut incorporer comme olecontrol ou comme objet caché le contrôle TTS défini à partir du% windir% \ system32 \ speech \ common \ sapi.dll.it un objet com (dans d'autres
Les mots peuvent être créés à partir de createObject ou de NewObject ("SAPI.SPVoice").
vous pouvez intégrer l'objet com [% windir% \ system32 \ speech \ common \ sapi.dll] dans le navigateur d'objets vfP (vfp / menu / tools) et voir toutes ses classes, interfaces,
constantes, propriétés de méthodes et événements.
vous pouvez faire glisser les interfaces vers un fichier prg et travailler avec (pour avancé seulement).
Les codes ci-dessous ont pour but de faire des démos avec cet objet avec beaucoup de possibilités.
En principe le sapi.dll se trouve dans le dossier système ci-dessus. Il n'apparaît pas dans menu / tools / options / controls mais peut le tester avec
vartype [createObject ("sapi.spvoice).] doit renvoyer un objet autrement sapi non installé sur le système.
les voix dépendent du système et certaines voix ont aussi été ajoutées (ce n'est pas gratuit d'ajouter des voix).
dans mon windows automne créateur il y a 2 voix (français et anglais américain) .Si vous avez d'autres voix, vous devrez peut-être modifier le code pour cela
ça marche.
il y a du TTS gratuit sur le web comme eSPEAk (il y a beaucoup de voix comme l'arabe) mais les haut-parleurs ressemblent à des robots et ont de très mauvaises orthographes.
L'avantage est que ce dernier peut fonctionner avec les voix MS TTS. Ils ont une interface en tant qu'application et peuvent être manipulés en tant que ligne de commande.
C'est un bon début pour ceux qui veulent en savoir plus sur cet objet.
note :Vous devez d'abord lister les voix installées et retoucher le code pour lui permettre de travailler correctement conformément aux voix installées.
ENDTEXT
With Thisform
.ycl=0
.combo1.Value=1 &&fr
.ycnt.ycom1.Click()
Endwith
Case x=0
TEXT to thisform.edit1.value pretext 7 noshow
How to define TTS(text to speech)?
Text to speech, abbreviated as TTS, is a form of speech synthesis that converts text into spoken voice output.
TTS systems were first developed to aid the visually impaired by offering a computer-generated spoken voice that would "read" text to the user.
its is a type of speech synthesis application that is used to create a spoken sound version of the text in a computer document,such as a help file or
a Web page.Actually its used anywhere on web sites, reading books,reading helps,interacting apps,games...
The actual version of windows fall creator TTS is the version 5.
VFP can embed as olecontrol or as hidden object the TTS controldefined from the %windir%\system32\speech\common\sapi.dll.its a com object (in other
words can be created from createObject or NewObject("SAPI.SPVoice").it have PEM.
you can embed the com object [%windir%\system32\speech\common\sapi.dll] in the vfP object browser (vfp/menu/tools) and see all its classes,interfaces,
constants,methods properties and events.
you can drag the interfaces to a prg file ands work with (for advanced only).
the codes below have for goal to make some demos with this object with many capabilities.
In principe the sapi.dll is in the system folder above.its not appears in menu/tools/options/controls but can test it with
vartype[createObject("sapi.spvoice).] must return an object otherwise sapi not installed on system.
the voices depend on system and some voices also added (its not free to add voices.)
in my windows fall creator there is 2 voices (french and US English).If you have another voices ,you may have to tweak the code for that for making
it working.
there is some free TTS on the web as eSPEAk(there is many voices as Arabic) but the speakers look like robots and have very bad spellings.
the advantage is this last can work with MS TTS voices.it have an interface as application and can be manipulated as command line.
this is a good starting for who want to know more on this object.
note: Must list first the voices installed and arrage the code to ake it working as expected.can replace french with other installed voice.
ENDTEXT
With Thisform
.ycl=0
.combo1.Value=2 &&en
.ycnt.ycom1.Click()
Endwith
Endcase
Procedure label4.Click
With This
.Caption=Iif(.Caption="3","4","3")
If .Caption="4"
.Parent.list1.Left=-.Parent.list1.Width+20
Else
.Parent.list1.Left=3
Endi
Endwith
Endproc
Procedure check1.InteractiveChange
With Thisform.edit1
.ReadOnly=!.ReadOnly
If .ReadOnly=.T.
.DisabledBackColor=0
.DisabledForeColor=Rgb(0,255,255)
.ForeColor=Rgb(0,255,255)
Else
.ForeColor=Rgb(255,255,255)
Endi
Endwith
Endproc
Enddefine
*
*-- EndDefine: ySAPI
*
Define Class ycnt As Container
Top = 83
Left = 256
Width = 88
Height = 30
SpecialEffect = 0
BackColor = Rgb(0,0,128)
Name = "ycnt"
Add Object ycom2 As CommandButton With ;
Top = 5, ;
Left = 33, ;
Height = 20, ;
Width = 24, ;
FontBold = .T., ;
FontName = "Arial", ;
FontSize = 14, ;
Caption = "II", ;
MousePointer = 15, ;
ToolTipText = "Pause", ;
SpecialEffect = 1, ;
BackColor = Rgb(128,255,0), ;
Name = "ycom2"
Add Object ycom3 As CommandButton With ;
Top = 5, ;
Left = 60, ;
Height = 20, ;
Width = 24, ;
FontName = "Marlett", ;
FontSize = 10, ;
Caption = "g", ;
MousePointer = 15, ;
ToolTipText = "Stop", ;
SpecialEffect = 1, ;
BackColor = Rgb(128,255,0), ;
Name = "ycom3"
Add Object ycom1 As CommandButton With ;
Top = 5, ;
Left = 6, ;
Height = 20, ;
Width = 24, ;
FontName = "Marlett", ;
FontSize = 14, ;
Caption = "4 ", ;
MousePointer = 15, ;
ToolTipText = "Speak/resume", ;
SpecialEffect = 1, ;
BackColor = Rgb(128,255,0), ;
Name = "ycom1"
Procedure Init
With This
.SetAll('mousepointer',15,'commandbutton')
.SetAll("SpecialEffect",2,"commandbutton")
For i=1 To .ControlCount
If Lower(.Controls(i).Class)=="commandbutton"
Bindevent(.Controls(i),"mouseEnter",Thisform,"my1")
Bindevent(.Controls(i),"mouseLeave",Thisform,"my2")
Endi
Endfor
Endwith
Endproc
Procedure ycom2.Click
m.oSAPI.Pause
Endproc
Procedure ycom3.Click
m.oSAPI.Speak("",2)
Thisform.ycl=0
Endproc
Procedure ycom1.Click
m.oSAPI.Voice=oSAPI.GetVoices.Item(Thisform.combo1.Value-1)
If Thisform.ycl=0
m.oSAPI.Speak(Thisform.edit1.Value,1+2)
Thisform.ycl=1
Else
m.oSAPI.Resume
Endi
Endproc
Enddefine
*
*-- EndDefine: ycnt
Click on code to select [then copy] -click outside to deselect
*2* created on sunday 31 of december 2017
*Voices installed on my system
*Microsoft Hortense Desktop - French* as item 0
*Microsoft Zira Desktop - English (United States) as item 1
*the summary help is spoken in the code when run.
*mousemove slowly on the map.
Public oform
oform=Newobject("ySAPI")
oform.Show
Return
Define Class ySAPI As Form
BorderStyle = 3
Height = 700
Width = 1210
ShowWindow = 2
AutoCenter = .T.
Caption = "interactive SAPI.Voice with mouse"
Name = "Form1"
Add Object combo1 As ComboBox With ;
FontSize = 8, ;
Height = 24, ;
Left = 12, ;
Top = 12, ;
Width = 168, ;
Name = "Combo1"
Add Object image1 As Image With ;
Stretch = 2, ;
Height = 660, ;
Left = 1, ;
Top = 48, ;
Width = 1211, ;
Name = "Image1"
Add Object olecontrol1 As OleControl With ;
oleclass="MSComctlLib.Slider.2", ;
Top = 0, ;
Left = 221, ;
Height = 24, ;
Width = 100, ;
Name = "Olecontrol1"
Add Object olecontrol2 As OleControl With ;
oleclass="MSComctlLib.Slider.2", ;
Top = 0, ;
Left = 418, ;
Height = 24, ;
Width = 100, ;
Name = "Olecontrol2"
Add Object label1 As Label With ;
AutoSize = .T., ;
Caption = "Volume", ;
Height = 17, ;
Left = 330, ;
Top = 5, ;
Width = 44, ;
Name = "Label1"
Add Object label2 As Label With ;
AutoSize = .T., ;
Caption = "Rate", ;
Height = 17, ;
Left = 527, ;
Top = 3, ;
Width = 28, ;
Name = "Label2"
Add Object combo2 As ComboBox With ;
Height = 24, ;
Left = 1044, ;
Top = 12, ;
Width = 100, ;
Name = "Combo2"
Add Object command1 As CommandButton With ;
Top = 12, ;
Left = 792, ;
Height = 27, ;
Width = 84, ;
Caption = "Thunder", ;
Name = "Command1"
Add Object label3 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 20, ;
BackStyle = 0, ;
Caption = "?", ;
Height = 35, ;
Left = 1176, ;
MousePointer = 15, ;
Top = 5, ;
Width = 19, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label3"
Procedure Init
Local m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
With Thisform
.olecontrol1.Min=0
.olecontrol1.Max=100
.olecontrol1.Value=100
.olecontrol2.Min=-10
.olecontrol2.Max=10
.olecontrol2.Value=0
Endwith
Publi m.oSAPI
m.oSAPI=Createobject("SAPI.SPVoice")
With m.oSAPI
.rate=Thisform.olecontrol2.Value &&-10-10 set the voice speed from low to fast, 0=normal
.Volume=Thisform.olecontrol1.Value &&0-100 set thge voice volume from silent (0) to max=100
Endwith
With Thisform.combo1
For Each voice In m.oSAPI.getvoices
.AddItem(voice.getDescription)
Next
.ListIndex=1
.Value=1
.Style=2
Endwith
With m.oSAPI
*messagebox(thisform.combo1.value)
*.voice=.getVoices("gender=female").item(0)
.voice=.getvoices.Item(Thisform.combo1.Value-1)
.speak("Hello",1+2) &&asynchronous and purge
Endwith
*arrange labels on the form
Local m.w,m.delta
m.delta=5
m.w=Floor((Thisform.image1.Width-20)/6)
k=0
With Thisform
For i=1 To 18
.Newobject("ylab"+Trans(i),"ylab")
k=k+1
With Eval(".ylab"+Trans(i))
.Caption="Zone"+Trans(i)
.BorderStyle=1
.BackStyle=0
If i=1
.Left=m.delta
.Top=Thisform.image1.Top+m.delta
Else
.Left=Eval("thisform.ylab"+Trans(i-1)+".left")+Eval("thisform.ylab"+Trans(i-1)+".width")+m.delta
If k<=6
.Top=Eval("thisform.ylab"+Trans(i-1)+".top")
Else
k=1
.Left=m.delta
.Top=Eval("thisform.ylab"+Trans(i-1)+".top")+m.w+m.delta
Endi
Endi
.Width=m.w
.Height=m.w
.Visible=.T.
Endwith
Endfor
Endwith
Endproc
Procedure Load
Set Memow To 8192
Local m.myvar
TEXT to m.myvar noshow
le temps est ensoleillé et la température est douce.,the weather is sunny and the temperature is mild.
temps variable avec quelques nuages à l'horizon.,variable weather with some clouds on the horizon.
le vent souffle assez fort et l'humidité est croissante.,the wind is strong enough and the humidity is increasing.
quelques gouttes de pluie accompagnées de rafles de vent.,a few drops of rain accompanied by stalks of wind.
gros nuages pluvieux.,heavy rainy clouds.
température moyenne de 30 degrés.,average temperature of 30 degrees.,
Foudre intermittentes et orages persistants.,Intermittent lightning and persistent thunderstorms.
violent orage et le thermomètre en baisse.,violent thunderstorm and the thermometer down.
Verglas sur les routes.,Ice storm on the roads.
Ciel dégagé et tempéraure clémente.,Clear skies and mild temperatures.
le temps est ensoleillé et la température est douce.,the weather is sunny and the temperature is mild.
temps variable avec quelques nuages à l'horizon.,variable weather with some clouds on the horizon.
le vent souffle assez fort et l'humidité est croissante.,the wind is strong enough and the humidity is increasing.
quelques gouttes de pluie accompagnées de rafles de vent.,a few drops of rain accompanied by stalks of wind.
gros nuages pluvieux.,heavy rainy clouds.
température moyenne de 30 degrés.,average temperature of 30 degrees.
Foudre intermittentes et orages persistants.,Intermittent lightning and persistent thunderstorms.
violent orage et le thermomètre en baisse.,violent thunderstorm and the thermometer down.
ENDTEXT
Create Cursor ycurs (num i,xtext_fr m,xtext_en m)
Local m.x,m.y
For i=1 To Memlines(m.myvar)
m.x=Getwordnum(Mline(m.myvar,i),1,",")
m.y=Getwordnum(Mline(m.myvar,i),2,",")
Insert Into ycurs Values(i,m.x,m.y)
Endfor
*brow
Endproc
Procedure Destroy
oSAPI=Null
Release oSAPI
Clea Events
Endproc
Procedure Activate
m.oSAPI.speak("",2) &&purge
Thisform.command1.Click
m.oSAPI.waituntilDone(-1)
*set volume to max
m.oSAPI.Volume=100
Endproc
Procedure combo1.Click
m.oSAPI.voice=m.oSAPI.getvoices.Item(This.Value-1)
Endproc
Procedure image1.Init
Local loRequest,lcURl
m.lcURl="http://www.meteo.dz/images/Algeria1.jpg"
m.loRequest = Createobject('MsXml2.XmlHttp')
m.loRequest.Open("GET",lcURl,.F.)
m.loRequest.Send()
This.PictureVal=m.loRequest.ResponseBody
m.loRequest=Null
Endproc
Procedure olecontrol1.Change
*** Événement de contrôle ActiveX ***
Try
m.oSAPI.Volume=This.Value
Catch
Endtry
Endproc
Procedure olecontrol1.Init
This.Value=100
This.Change()
Endproc
Procedure olecontrol2.Change
*** Événement de contrôle ActiveX ***
Try
m.oSAPI.rate=This.Value
Catch
Endtry
Endproc
Procedure olecontrol2.Init
This.Value=0
This.Change()
Endproc
Procedure combo2.Init
With This
.AddItem("french")
.AddItem("English")
.Style=2
.Value=1
.ListIndex=1
Endwith
Endproc
Procedure combo2.Click
Do Case
Case This.Value=1
m.oSAPI.voice=m.oSAPI.getvoices.Item(0) &&french
Thisform.combo1.Value=1
Case This.Value=2
m.oSAPI.voice=m.oSAPI.getvoices.Item(1) &&en
Thisform.combo1.Value=2
Endcase
Endproc
Procedure command1.Click
Local loStream
loStream = Createobject("SAPI.SPFileStream")
** Open the WAV file for reading purposes
loStream.Open("http://www.mediacollege.com/downloads/sound-effects/explosion/explosion-04.wav") &&oSAPI can read even wav url sounds (not mp3).
*speak the recorded wav stream
m.oSAPI.Volume=30
m.oSAPI.SpeakStream(loStream)
loStream=Null
Endproc
Procedure label3.Click
Local m.myvar
TEXT to m.myvar pretext 7 noshow
Summary help
this code simulates some interactivity with the SAPI control.
can start,pause,resume, stop the SAPI as a player exactly.
can start it with mouseEnter,mouseLeave events in any control.
it can play wav sounds (even music from any file and even a web file).
Mousemove (slowly) on the map to see the effect.
ENDTEXT
With m.oSAPI
.Volume=100
.rate=0
.voice=.getvoices.Item(1) &&en to adjust
.speak(m.myvar,1+2)
.waituntilDone(-1)
Endwith
Messagebox(m.myvar,0+32+4096,"summary help")
Endproc
Enddefine
*
*-- EndDefine: ySAPI
*
Define Class ylab As Label
Caption = "Label1"
Height = 16
Width = 40
Name = "ylab"
Procedure my1
Lparameters nButton, nShift, nXCoord, nYCoord
This.MousePointer=13
This.BorderStyle=0
This.BackStyle=1
Sele ycurs
Go Int(Val(Substr(This.Name,5)))
If Thisform.combo2.Value=1
oSAPI.speak(xtext_fr,1+2)
Else
oSAPI.speak(xtext_en,1+2)
Endi
Endproc
Procedure my2
Lparameters nButton, nShift, nXCoord, nYCoord
This.BackStyle=0
This.BorderStyle=1
oSAPI.speak("",1+2)
This.MousePointer=15
Endproc
Procedure Init
With This
.AutoSize = .F.
.FontBold = .T.
.FontSize = 36
.WordWrap = .T.
.Alignment = 2
.BackStyle = 0
.Caption = "Zone"+Substr(.Name,6)
.Left = 924
.MousePointer = 15
.Top = 48
.Width = 121
.Height=121
.ForeColor = Rgb(255,0,0)
.Visible=.T.
Endwith
Rand(-1)
This.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
This.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
Bindevent(This,"mouseEnter",This,"my1")
Bindevent(This,"mouseLeave",This,"my2")
Endproc
Enddefine
*
*-- EndDefine: ylab
Click on code to select [then copy] -click outside to deselect
*3* created on tuesday 02 of january 2017
*record a voice into a wav file with a specified format (see below the constants for that)
*this already done in code *1* but detailled here.
#define SAFT48kHz16BitStereo 39
#define SSFMCreateForWrite 3 && Creates file even if file exists and so destroys or overwrites the existing file
local m.yrep
m.yrep=addbs(justpath(sys(16,1)))
set defa to (yrep)
local oFileStream, oVoice as object
local m.lcfile
m.lcfile=m.yrep+"youtput.wav"
oFileStream = CreateObject("SAPI.SpFileStream")
oFileStream.Format.Type = SAFT48kHz16BitStereo
oFileStream.Open (m.lcfile, SSFMCreateForWrite)
oSAPi = CreateObject("SAPI.SpVoice")
oSAPi.AudioOutputStream = oFileStream
oSAPi.Speak( "Hello world this is a recorder text to a wav 48khz 16 bits mono format",3) &&to record silently as wav file
oSAPI.waituntildone(-1)
oFileStream.Close
*clean objects refrences
oSAPi.AudioOutputStream =null
oFilestream=null
oSAPi=null
retu
*Trick: can work with the windows scheduler to read at times predefined some reminders,text,music,...
*SAPI.dll :wav formats as output
*******************************
#define SAFT8kHz8BitMono 4
#define SAFT8kHz8BitStereo 5
#define SAFT8kHz16BitMono 6
#define SAFT8kHz16BitStereo 7
#define SAFT11kHz8BitMono 8
#define SAFT11kHz8BitStereo 9
#define SAFT11kHz16BitMono 10
#define SAFT11kHz16BitStereo 11
#define SAFT12kHz8BitMono 12
#define SAFT12kHz8BitStereo 13
#define SAFT12kHz16BitMono 14
#define SAFT12kHz16BitStereo 15
#define SAFT16kHz8BitMono 16
#define SAFT16kHz8BitStereo 17
#define SAFT16kHz16BitMono 18
#define SAFT16kHz16BitStereo 19
#define SAFT22kHz8BitMono 20
#define SAFT22kHz8BitStereo 21
#define SAFT22kHz16BitMono 22
#define SAFT22kHz16BitStereo 23
#define SAFT24kHz8BitMono 24
#define SAFT24kHz8BitStereo 25
#define SAFT24kHz16BitMono 26
#define SAFT24kHz16BitStereo 27
#define SAFT32kHz8BitMono 28
#define SAFT32kHz8BitStereo 29
#define SAFT32kHz16BitMono 30
#define SAFT32kHz16BitStereo 31
#define SAFT44kHz8BitMono 32
#define SAFT44kHz8BitStereo 33
#define SAFT44kHz16BitMono 34
#define SAFT44kHz16BitStereo 35
#define SAFT48kHz8BitMono 36
#define SAFT48kHz8BitStereo 37
#define SAFT48kHz16BitMono 38
#define SAFT48kHz16BitStereo 39
Click on code to select [then copy] -click outside to deselect
*4* working with vfp object browser
*this code is dragged from the vfp object browser from the interface ISpeechVoice (see how to ...the image below)
*vfp can interact with these interfaces with eventHandlers.
x=NEWOBJECT("myclass")
DEFINE CLASS myclass AS session OLEPUBLIC
IMPLEMENTS ISpeechVoice IN "SpeechLib.SpVoice"
PROCEDURE ISpeechVoice_get_Status() AS VARIANT;
HELPSTRING "Status"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_get_Voice() AS VARIANT;
HELPSTRING "Voice"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_Voice() AS VARIANT;
HELPSTRING "Voice"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_get_AudioOutput() AS VARIANT;
HELPSTRING "Gets the audio output object"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_AudioOutput() AS VARIANT;
HELPSTRING "Gets the audio output object"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_get_AudioOutputStream() AS VARIANT;
HELPSTRING "Gets the audio output stream"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_AudioOutputStream() AS VARIANT;
HELPSTRING "Gets the audio output stream"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_get_Rate() AS Number;
HELPSTRING "Rate"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_put_Rate(eValue AS Number @);
HELPSTRING "Rate"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_get_Volume() AS Number;
HELPSTRING "Volume"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_put_Volume(eValue AS Number @);
HELPSTRING "Volume"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_put_AllowAudioOutputFormatChangesOnNextSet(eValue AS LOGICAL @);
HELPSTRING "AllowAudioOutputFormatChangesOnNextSet"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_get_AllowAudioOutputFormatChangesOnNextSet() AS LOGICAL;
HELPSTRING "AllowAudioOutputFormatChangesOnNextSet"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_get_EventInterests() AS VARIANT;
HELPSTRING "EventInterests"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_put_EventInterests(eValue AS VARIANT @);
HELPSTRING "EventInterests"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_put_Priority(eValue AS VARIANT @);
HELPSTRING "Priority"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_get_Priority() AS VARIANT;
HELPSTRING "Priority"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_put_AlertBoundary(eValue AS VARIANT @);
HELPSTRING "AlertBoundary"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_get_AlertBoundary() AS VARIANT;
HELPSTRING "AlertBoundary"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_put_SynchronousSpeakTimeout(eValue AS Number @);
HELPSTRING "SyncSpeakTimeout"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_get_SynchronousSpeakTimeout() AS Number;
HELPSTRING "SyncSpeakTimeout"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_Speak(Text AS STRING, Flags AS VARIANT) AS Number;
HELPSTRING "Speak"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_SpeakStream(Stream AS VARIANT, Flags AS VARIANT) AS Number;
HELPSTRING "SpeakStream"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_Pause() AS VOID;
HELPSTRING "Pauses the voices rendering."
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_Resume() AS VOID;
HELPSTRING "Resumes the voices rendering."
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_Skip(Type AS STRING, NumItems AS Number) AS Number;
HELPSTRING "Skips rendering the specified number of items."
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_GetVoices(RequiredAttributes AS STRING, OptionalAttributes AS STRING) AS VARIANT;
HELPSTRING "GetVoices"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_GetAudioOutputs(RequiredAttributes AS STRING, OptionalAttributes AS STRING) AS VARIANT;
HELPSTRING "GetAudioOutputs"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_WaitUntilDone(msTimeout AS Number) AS LOGICAL;
HELPSTRING "WaitUntilDone"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_SpeakCompleteEvent() AS Number;
HELPSTRING "SpeakCompleteEvent"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_IsUISupported(TypeOfUI AS STRING, ExtraData AS VARIANT) AS LOGICAL;
HELPSTRING "IsUISupported"
* add user code here
ENDPROC
PROCEDURE ISpeechVoice_DisplayUI(hWndParent AS Number, Title AS STRING, TypeOfUI AS STRING, ExtraData AS VARIANT) AS VOID;
HELPSTRING "DisplayUI"
* add user code here
ENDPROC
ENDDEFINE
Click on code to select [then copy] -click outside to deselect
*5*
*For information
*open source TTS eSPEAK : from http://espeak.sourceforge.net/
Text to Speech engine for English and many other languages. Compact size with clear but artificial pronunciation (Bad in my advice)
Free & Available as a command-line program with many options for a Windows SAPI5 version.
i recommend to download but dont install (all voices are artificial and with very bad quality) .use the mirosoft installed voices (in my PC as said above
Microsoft Hortenze French
Microsoft Zira english/US)
can buy others as your need.
-can be used by the espeak command line utility (espeak.exe 312ko- http://espeak.sourceforge.net/commands.html)this can be coded easily from vfp with shellexecute and bat files built.
download for windows (included command line and TTSApp)=http://sourceforge.net/projects/espeak/files/espeak/espeak-1.48/setup_espeak-1.48.04.exe
-can be used by the app shipped TTSApp.exe (788ko): this can work with microsoft voices above and is compatible with SAPI5.the editbox is unicode and can embed any language.
it have also an animated mouth motion synchronized with the voice.
this TTSApp.exe can be embed on a form with the API setParent.
*there is also many online TTS with more languages.
Click on code to select [then copy] -click outside to deselect
*6* created on Wednesday 03 of january 2018
*How to work with vfp,word,sapi and evenHandler from vfp.
*this sample is originally from Calvin Hsias.Adapted with some new/old futures.
*Word must installed on system and SAPi available (sapi.dll).
*adapt voices to your case (item(0) and item(1) here are French and englich ones).
*warning :in myevents class correct the mxWord.olb path : mine is "C:\Program Files (x86)\Microsoft Office\Office12\msWord.olb" (office 2007).
*can make a code similar with internet explorer (se previous post with IE evenhandler)
*verify if word and SAPI available on system first
If ! Vartype( Createobject("word.application"))="O"
Messagebox("Word not installed...cancelling!",16+4096,'',2000)
Endi
If ! Vartype(Createobject("SAPI.spVoice"))="O"
Messagebox("SAPi.spVoice not availmable on system!....cancelling",4+4096,'',2000)
Endi
Clea All
Local m.xitem
m.xitem=Inputbox("select language : 0 for french - 1 for english","","1")
If Empty(m.xitem) Or !Inlist(m.xitem,"0","1")
m.xitem="1"
Endi
_Screen.AddProperty("xitem",Int(Val(xitem))) &&public for accessing to it from class
_Screen.WindowState=1
Local m.myvar
Do Case
Case _Screen.xitem=1 &&en
TEXT to m.myvar noshow
Select a text to read it automatically !
Here’s some interesting code to run. It starts Microsoft Word and binds some Fox code to some Word events.
Type some text into the document. Select some text.
When the Selection Change event occurs, the Foxpro code creates the speech API object and speaks out loud the currently selected text.
This is done with vfp,TTS,Word and EventHandler.
DblClick on document to stop voice reading
Make any selection and i read it for you !
ENDTEXT
Case _Screen.xitem=0 &&fr
TEXT to m.myvar noshow
Sélectionnez un texte pour le lire automatiquement!
Voici un code intéressant à exécuter. Il démarre Microsoft Word et lie du code Fox à certains événements Word.
Tapez du texte dans le document. Sélectionnez un texte
Lorsque l'événement de changement de sélection se produit, le code Foxpro crée l'objet API de la parole et parle à haute voix le texte sélectionné.
Ceci est fait avec vfp, TTS, Word et EventHandler.
DblCliquez sur le document pour arrêter la lecture de la voix
Selectionnez un text quelconque et je le lirai pour vous!
ENDTEXT
Endcase
_Cliptext=m.myvar
Publi loWord,omyEvents
loWord = Createobject("word.application")
omyEvents = Createobject('myevents')
omyEvents.loWord = loWord
Eventhandler(loWord,omyEvents) &&new word document
loWord.Visible = .T.
loWord.Activate
#Define wdCollapseEnd 0
#Define wdAlignParagraphCenter 1
#Define wdAlignParagraphLeft 0
#Define wdBlue 2
#Define wdRed 6
#Define wdGreen 11
#Define wdUnderlineWords 2
#Define wdUnderlineSingle 1
#Define wdWindowStateMaximize 1
Local ActiveDocument,oRange As Object
ActiveDocument = loWord.Documents.Add()
ActiveDocument.InlineShapes.AddPicture("http://img.over-blog-kiwi.com/100x100-ct/1/43/54/07/20150121/ob_249909_yben.JPG") &&home(1)+"graphics\bitmaps\assorted\beany.bmp")
ActiveDocument.Activate
oRange = ActiveDocument.Range()
oRange.Collapse(wdCollapseEnd)
Local myRange,myRange1,myRange2 As Object
myRange = ActiveDocument.Range (ActiveDocument.Content.End - 1,ActiveDocument.Content.End - 1)
With myRange
.Paste &&paste the data in the clipboard to word
.Bold = 1
.Font.Size = 14
.Font.Name = "Tahoma"
.Font.colorIndex=wdBlue
.ParagraphFormat.Alignment =wdAlignParagraphLeft &&Center
myRange1 = ActiveDocument.Range (ActiveDocument.Content.End - 64,ActiveDocument.Content.End - 1)
With myRange1
.Font.Size=18
.Font.colorIndex=wdRed
.Font.Underline = wdUnderlineWords
Endwith
If _Screen.xitem=1
myRange2 = ActiveDocument.Range (ActiveDocument.Content.End - 90,ActiveDocument.Content.End - 45)
Else
myRange2 = ActiveDocument.Range (ActiveDocument.Content.End -128,ActiveDocument.Content.End - 65)
Endi
With myRange2
.Font.Size=20
.Font.colorIndex=wdGreen
.Font.Underline = wdUnderlineSingle
Endwith
ActiveDocument.Sections(1).PageSetup.LeftMargin = 50
Rand(-1)
Local m.n,m.neff
m.n=Int(3*Rand()+1)
Do Case
Case m.n=1
m.neff=18
Case m.n=2
m.neff=27
Case N=3
m.neff=12
Endcase
#Define MsoTextEffect 11
ActiveDocument.Shapes.AddTextEffect(m.neff,"yEventHandler","Tahoma",36,.T.,.F.,100,0 ,ActiveDocument.Paragraphs(1).Range) &&18,27,12 wordArt effects
.Select
Endwith
*loWord.Quit
*************
*this class is extracted from the vfp object browser (drag the interface to your command window or any editor)
*insert your codes in the procedures as your goal.
Define Class myevents As Custom
oSapi=Null
Implements applicationevents2 In "C:\Program Files (x86)\Microsoft Office\Office12\msWord.olb" &&C:\Program Files\Microsoft Office\OFFICE11\msword.olb"
loWord = Null
Procedure applicationevents2_startup()
* ?Program()
Procedure applicationevents2_quit
* ?Program()
Procedure applicationevents2_DocumentBeforeClose(Cancel,Doc)
* ?Program()
Procedure DocumentBeforeClose(Cancel,Doc)
* ?Program()
Procedure applicationevents2_DocumentBeforePrint(Cancel,Doc)
* ?Program()
Procedure applicationevents2_DocumentBeforeSave(Doc,SaveAsUI,Cancel)
* ?Program()
Procedure applicationevents2_DocumentChange
* ?Program()
Procedure applicationevents2_DocumentOpen(Doc)
* ?Program()
Procedure applicationevents2_NewDocument(Doc)
* ?Program()
Procedure applicationevents2_WindowActivate(Doc,Wn)
* ?Program()
Procedure applicationevents2_WindowBeforeDoubleClick(Sel,Cancel)
*?PROGRAM()
Try
This.oSapi.Speak("",2) &&stop oSapi and purge
Catch
Endtry
Procedure applicationevents2_WindowBeforeRightClick(Sel,Cancel)
*?Program()
Procedure applicationevents2_WindowDeactivate(Doc,Wn)
* ?Program()
If !Vartype(This.oSapi)='O'
This.oSapi=Createobject("SAPI.spVoice")
This.oSapi.Voice=This.oSapi.GetVoices().Item(_Screen.xitem) &&0 french 1 englich to adapt
Endi
This.oSapi.Speak("Au revoir and Bye Bye . i see you soon !",1+2)
This.oSapi.waitUntilDone(-1)
Procedure applicationevents2_WindowSelectionChange(Sel)
?Program(),Sel.Text
If Sel.Start < Sel.End
If !Vartype(This.oSapi)='O'
This.oSapi=Createobject("SAPI.spVoice")
This.oSapi.Voice=This.oSapi.GetVoices().Item(_Screen.xitem) &&0 french 1 englich to adapt
Endi
This.oSapi.Speak(Sel.Text,1+2)
Endif
Procedure Destroy
*?Program()
If !Isnull(This.loWord)
?Eventhandler(This.loWord,This,.T.)
Endif
Enddefine
can see my previous IE evenhandler and write similar code for IE.this is a speaking Msword contents. Calvin Hsias code is here: https://blogs.msdn.microsoft.com/calvin_hsia/2005/05/16/word-to-audible-speech/
there is 3 wordArt effects (see http://www.atoutfox.org/articles.asp?ACTION=FCONSULTER&ID=0000000575)
|
|
Yousfi Benameur |
Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1709(fall creator) & IE11 emulation.