Yo
casi nunca falto a mi palabra, aquí está la mía:
Option Explicit
Private Const sCombination As String = "brblcrclchdrdlflfrgrgljrjlkrkllrllmrmlprplrrrlsrsltrtlwrwlzrzl"
Private Const sVowels As String = "aeiou"
Private Const sConsonants As String = "bcdfgijklmnñpqrstvwxz"
Public Static Function PronunWord(ByVal lLen As Long) As String
Dim lCount As Long
Dim lNum As Long
Dim lLast As Long
Dim lVowelsCount As Long
If Not (lLen And &H80000000) Then
lCount = 0
lLast = 0
Do
CheckAgain:
lNum = RandomNumber(1, 3)
If lNum = 1 And lVowelsCount < 1 Then
lVowelsCount = -1
ElseIf lNum = lLast Then
GoTo CheckAgain
End If
Select Case lNum
Case 3
If Not (lCount > lLen - 3) Then
PronunWord = PronunWord & (MidB$(sCombination, (RandomNumber(1, 30) * 2) - 1, 4) & _
MidB$(sVowels, (RandomNumber(1, 5) * 2) - 1, 2))
lCount = lCount + 3
End If
Case 2
If lCount + 1 < lLen Then
PronunWord = PronunWord & (MidB$(sConsonants, (RandomNumber(1, 20) * 2) - 1, 2) & _
MidB$(sVowels, (RandomNumber(1, 5) * 2) - 1, 2))
lCount = lCount + 2
Else
PronunWord = PronunWord & MidB$(sConsonants, (RandomNumber(1, 20) * 2) - 1, 2)
lCount = lCount + 1
End If
Case Else
PronunWord = PronunWord & MidB$(sVowels, (RandomNumber(1, 5) * 2) - 1, 2)
If lLast = 1 Then
lVowelsCount = lVowelsCount + 1
Else
lVowelsCount = 0
End If
lCount = lCount + 1
End Select
lLast = lNum
Loop Until lCount = lLen
End If
End Function
Private Static Function RandomNumber(ByVal lMin As Long, ByVal lMax As Long) As Long
Randomize
RandomNumber = (lMin - lMax) * Rnd + lMax
End Function
Private Sub Form_Load()
Debug.Print PronunWord(100)
End Sub
Retorna:
purgiruocoouqolfioeugrearkeowaomiglamiolcifiopukliroonedluergeuñaikrofeamelfieefloioueicuooteeclooiu
Comprueba a ver si está bien que la hice en el autobús de vuelta a casa.
Si hay algún fallo mañana corrijo.
DoEvents!
Autor
En línea
