Ver Mensaje Individual
  #6 (permalink)  
Antiguo 03/12/2009, 16:53
Avatar de pkj
pkj
 
Fecha de Ingreso: julio-2006
Ubicación: Órbita sincrónica
Mensajes: 899
Antigüedad: 17 años, 9 meses
Puntos: 29
Respuesta: Un Reto: Mensaje de texto rotativo

Te agradezco tu honradez, pero lo he pasado demasiado bien como para cobrar.

EDITO ESTE MENSAJE PARA EVITAR ACUMULACION DE CÓDIGO SIMILAR Y REEMPLAZO LA FUNCION

El caso es que estaba seguro de que la solución no era tan dificil partiendo de lo que ya había hecho, y al final he acabado haciendo justo lo que pedias para que sea más práctica la función.

Resumen:
Función que devuelve un texto aleatorio a partir de un texto base que contenga una o varias partes opcionales.
Para marcar 2 o más partes como opcionales se introducen entre {} y se separan con |
Una opción puede contener otras partes opcionales y estas partes a otras casi sin límite siempre que se encapsulen correctamente.
Ejemplo:
Código :
Ver original
  1. Dim Texto As String
  2. Dim Resultado As String
  3. Texto = "Ven y trae a {quien {quieras|tu {elijas|desees}}|la familia|los amigos}"
  4. Resultado = AutoTexto(Texto)
  5. MsgBox Resultado

Código :
Ver original
  1. Function AutoTexto(ByVal TextoBase As String) As String
  2.   On Local Error Resume Next
  3.   AutoTexto = TextoBase
  4.   Do
  5.     Dim PosicionInicio As Long
  6.     PosicionInicio = InStr(PosicionInicio + 1, AutoTexto, "{")
  7.     If PosicionInicio <> 0 Then
  8.       Dim PosicionFin As Long
  9.       PosicionFin = InStr(PosicionInicio + 1, AutoTexto, "}")
  10.       If PosicionFin > PosicionInicio Then
  11.         Dim BuscaMas As Long
  12.         BuscaMas = PosicionInicio
  13.         Do
  14.           BuscaMas = InStr(BuscaMas + 1, AutoTexto, "{")
  15.           If BuscaMas > 0 And BuscaMas < PosicionFin Then
  16.             PosicionFin = InStr(PosicionFin + 1, AutoTexto, "}")
  17.             If PosicionFin = 0 Then Exit Do
  18.           Else
  19.             Exit Do
  20.           End If
  21.         Loop
  22.         If PosicionFin = 0 Then Exit Do
  23.         Dim Contador As Long
  24.         Contador = Contador + 1
  25.         Dim Lista() As String
  26.         ReDim Preserve Lista(Contador)
  27.         Lista(Contador) = Mid$(AutoTexto, PosicionInicio + 1, PosicionFin - PosicionInicio - 1)
  28.         AutoTexto = Left$(AutoTexto, PosicionInicio - 1) & "TextoVariable" & Format(Contador, "000000") & Mid$(AutoTexto, PosicionFin + 1)
  29.         PosicionInicio = 0
  30.       Else
  31.         Exit Do
  32.       End If
  33.     Else
  34.       Exit Do
  35.     End If
  36.   Loop
  37.   Dim F As Long
  38.   For F = 1 To Contador
  39.     If InStr(1, Lista(F), "{") <> 0 And InStr(1, Lista(F), "}") <> 0 And InStr(1, Lista(F), "}") > InStr(1, Lista(F), "{") Then
  40.       Lista(F) = AutoTexto(Lista(F))
  41.     End If
  42.     Dim Opciones() As String
  43.     Opciones = Split(Lista(F), "|")
  44.     Randomize Timer
  45.     Dim Eleccion As String
  46.     If Trim$(Replace(Lista(F), "|", "")) <> "" Then
  47.       Do
  48.         Eleccion = Opciones(Rnd * UBound(Opciones))
  49.         If Trim$(Eleccion) <> "" Then Exit Do
  50.       Loop
  51.     Else
  52.       Eleccion = Opciones(Rnd * UBound(Opciones))
  53.     End If
  54.     AutoTexto = Replace(AutoTexto, "TextoVariable" & Format(F, "000000"), Eleccion)
  55.   Next F
  56.   On Local Error GoTo 0
  57. End Function

EDITO ESTE MENSAJE PARA EVITAR ACUMULACION DE CÓDIGO SIMILAR Y REEMPLAZO LA FUNCION

Ha sido divertido.
Como curiosidad te cuento que cuando ya había probado esta nueva versión y estaba a punto de publicarla se me ocurrió ampliar la parte final del texto de prueba y por suerte decidí probarlo en el programa antes de guardar el mensaje, y resulta que fallaba estrepitosamente.
He tardado un buen rato y estaba a punto de perder la paciencia cuando al fin he encontrado el tonto fallo.
De todas formas he pasado un rato muy entretenido, he creado una función que cualquier día me puede servir para algo y espero haber echado una mano que tambien alegra la vida.

Si aparece un nuevo fallo comentadlo.

Saludos.
__________________
No hay preguntas tontas, solo gente estup..., ¡No!, ¿como era? No hay gente que pregunte a tontos... ¡Nooo!... ¡Vaya cabeza!

Última edición por pkj; 04/12/2009 a las 04:47