Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: fx700 en Octubre 25, 2011, 02:01:05 pm
-
Alguna idea para ejecutar mas de 100 caracteres en la funciona de LEANDRO por ejemplo en un text1 tengo 500 caractares tendria que dividirlos en 5 partes de 100 y ejecutar la funcion 5 veces, como podria automatiza esto.
Estoy haciendo esto rusticamente y el problema esta cuando la funcion mid me recupera un string en medio de una palabra por ejemplo dice "proc" y luego "esador", si alguien tiene algo mas optimizado me vendria bien.:
Private Sub Command1_Click()
Debug.Print Len(Text1)
Debug.Print GoogleSpeak(Mid(Text1, 1, 100), "es", True)
Debug.Print GoogleSpeak(Mid(Text1, 100, 100), "es", True)
Debug.Print GoogleSpeak(Mid(Text1, 200, 100), "es", True)
Debug.Print GoogleSpeak(Mid(Text1, 300, 100), "es", True)
Debug.Print GoogleSpeak(Mid(Text1, 400, 100), "es", True)
End Sub
http://leandroascierto.com/blog/472/ (http://leandroascierto.com/blog/472/)
-
HOLA!!!
Se te ocurrio por casualidad usar un for ¬¬
Private Sub Command1_Click()
Debug.Print Len(Text1)
Debug.Print GoogleSpeak(Mid(Text1, 1, 100), "es", True)
for x = 100 to 401 step 100
Debug.Print GoogleSpeak(Mid(Text1, x, 100), "es", True)
next
End Sub
GRACIAS POR LEER!!!
-
Hola Fx700 ...
Porque no usas el SDK de loquendo ... !! Salu2
-
Mejor dejo un ejemplo para que vean donde esta el problema, si el texto dice:
Hola este el foro de ....... encontraras bue(aqui llego al caracter 100 y se corta)
nos codigos y usuarios......, ademas el foro dispone de una se(aqui llega a 100 otra vez y se corta)
ccion de utilitarios.
El problema esta en los cortes que hace al llegar al caractes 100, lo que quiero es controlar que no se quede una palabra a medias por ejemplo:
Hola este el foro de ....... encontraras(como al llegar al caractes 100 cortara la palabra asi que solo debe llegar hasta el 97)
buenos codigos y usuarios......, ademas el foro dispone de una seccion(aqui lo mismo evitar que corte la frase)
de utilitarios
Por ultimo podria hacer que corte y llame a la funcion nuevamente cuando encuentre un punto "." o punto y coma ";" siempre y cuando este en un rango intermedio para evitar muchos cortes.
-
Otra cosa que quisiera y no podido resolver es que los archivos no se sobreescriban y que no sean temporales.
-
Hola fx700 ...
Tengo el SDK loquendo 6.5.5 y 6.6 ... Con varias voces ... Carlos, Diego, Sonia, Mario, y no se que otros mas ... También vienen en diferentes idiomas ... Carlos tiene una voz de locutor y una calidad de lectura excelente ... Junto con sonia en español .... también tienes dentro del español tonadas en el habla ... ejemplo Diego es latino ... habla como argentino, jeje imagina que para notar esto la calidad de habla a la que me refiero es excelente, configurando la frecuencia máxima de sonido que es 44KHZ ... para que tengas una idea de eso es la calidad de la musica en MP3... Hay muchas voces y en varios idiomas ...
Respetando acentos, puntos y comas, y dándole el tiempo correcto a la voz, el resultado es sorprendente de verdad ... es muy fácil de usar .... Solía instalar Speech SDK 5 antes de los SDK 6.5.5 y 6.6, para poder aprovechar sus ejemplos en varios lenguajes ... Hace mucho hice un programa con loquendo, en un sistema de gestión de personal, el cual tenia varios modos, bajo, intermerdio y modo aprendizaje, esto permitía establecer la modalidad y no volver loco a un usuario que ya sabía usar el sistema con lecturas habladas inecesarias y dejar a su criterio la interacción con loquendo. Se indiacaba las acciones que uno realizaba dentro del sistema, y breves explicaciones de lo que se requiere a modo de automatizar el aprendizaje entre los usuarios ... además de leer lo que se quisiera como reportes. Se quedaron con la boca abierta los usuarios jejeje ... y además insentivó a los usuarios para la implementación ... Me dió resultados sobresalientes ... por eso te lo recomende ... el tamaño comprimido de los tres SDK deben estar rondando los 400 megas ... fijate si los ubicas en la red ... yo te paso los ejemplos de como usarlos ... salu2
-
HOLA softmania te refieres a que instale este pack?
http://www.microsoft.com/download/en/details.aspx?displaylang=en&id=10121 (http://www.microsoft.com/download/en/details.aspx?displaylang=en&id=10121)
-
splitea tu texto por espacios:
Dim strItems() As String
Dim strAcum As String
Dim lngIndex As Long
strItems = Split(Text1, " ")
For lngIndex = 0 To UBound(lngIndex)
If Len(strAcum & strItems(lngIndex)) > 100 Then
GoogleSpeak(strAcum, "es", True)
strAcum = ""
End If
strAcum = strAcum & strItems(lngIndex) & " "
Next lngIndex
en teoria deberia andar.
saludos
-
HOLA!!!
No por nada, pero split viene de farica con " " predeterminado asi que esta sentencia:
strItems = Split(Text1, " ")
La reducis asi:
strItems = Split(Text1)
GRACIAS POR LEER!!!
-
Hola, modifique la función para que lea texto mas largos, lo que hice fue partir el texto separando por "," y "." en caso de que estos no existan por espacio.
no es super fluido la pronunciación pero safa bastante.
También con el api mciSendString es asíncrona aproveche esta ventaja para ir descargando y reproduciendo.
Option Explicit
'-----------------------------------------------------------------------------------------------------
'Autor: Leandro Ascierto
'Web: www.leandroascierto.com.ar
'Abreviaturas
'de, da, es, fi, fr, en, it, nl, pl, pt, sv"
'Alemán , Danés, Español, Finlandia, Francés, Inglés, Italiano, Neerlandés, Polaco, Portugués, Sueco
'----------------------------------------------------------------------------------------------------
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Function GoogleSpeak(ByVal sText As String, Optional ByVal Language As String = "es", Optional ByVal bDoevents As Boolean) As Boolean
On Error Resume Next
Dim sTempPath As String, ml As String
Dim cText As Collection
Dim cPaths As Collection
Dim i As Long
Dim bStatePlay As Boolean
Dim lTrackCount As Long
Dim lTrack As Long
Dim FileLength As Long
Set cPaths = New Collection
Set cText = New Collection
sText = Replace(sText, vbCrLf, " ")
Do While Len(sText)
cText.Add MySplit(sText)
Loop
lTrackCount = cText.Count
For i = 1 To cText.Count
cPaths.Add Environ("Temp") & "\TempMP3.MP3" & i
Next
lTrack = 1
ml = String(30, 0)
For i = 1 To cText.Count
If URLDownloadToFile(0&, "http://translate.google.com/translate_tts?tl=" & Language & "&q=" & cText.Item(i), cPaths.Item(i), 0&, 0&) = 0 Then
If mciSendString("status myfile position ", ml, 30, 0&) = 0 Then
If Val(ml) = FileLength Then
Call mciSendString("close myfile", 0&, 0&, 0&)
Kill cPaths.Item(lTrack)
lTrack = lTrack + 1
FileLength = PlaySound(cPaths.Item(lTrack))
End If
Else
FileLength = PlaySound(cPaths.Item(lTrack))
End If
If bDoevents Then DoEvents
End If
Next
Do
If mciSendString("status myfile position ", ml, 30, 0&) = 0 Then
If Val(ml) = FileLength Then
Call mciSendString("close myfile", 0&, 0&, 0&)
Kill cPaths.Item(lTrack)
lTrack = lTrack + 1
If lTrack <= lTrackCount Then
FileLength = PlaySound(cPaths.Item(lTrack))
If FileLength = 0 Then Exit Do
End If
End If
Else
Exit Do
End If
If bDoevents Then DoEvents
Loop
End Function
Private Function PlaySound(ByVal sTempPath As String) As Long
Dim ml As String
Dim FileLength As Long
If mciSendString("open " & Chr$(34) & sTempPath & Chr$(34) & " type MpegVideo" & " alias myfile", 0&, 0&, 0&) = 0 Then
ml = String(30, 0)
Call mciSendString("status myfile length ", ml, 30, 0&)
FileLength = Val(ml)
If FileLength Then
If mciSendString("play myFile", 0&, 0&, 0&) = 0 Then
PlaySound = FileLength
Else
PlaySound = 0
End If
End If
End If
End Function
Private Function MySplit(sText As String) As String
Dim lPos As Long
Dim lPos1 As Long
Dim lPos2 As Long
If Len(sText) > 100 Then
lPos1 = InStrRev(sText, ". ", 100)
lPos2 = InStrRev(sText, ", ", 100)
lPos = IIf(lPos1 > lPos2, lPos1, lPos2)
If lPos = 0 Then lPos = InStrRev(sText, " ", 100)
MySplit = Left$(sText, lPos)
sText = Mid$(sText, lPos + 1)
Else
MySplit = sText
sText = vbNullString
End If
End Function
Private Sub Command1_Click()
Call GoogleSpeak(Text1, "es", True)
End Sub
No lo testie al 100% pero bueno cualquier cuelgue abría que depurarlo para ver si ocurrió algo imprevisto.