HOLA!!!
Este reto consiste en poner mayusculas a las letras que estan delante de un punto , punto y aparte , nueva linea , signo de exclamacion o signo de interrogacion (abiertos o cerrados).
Estructura: uCaseCorrect(Txt as String) as String
La funcion debe corregir las mayusculas de la cadena poniendo mayusculas despues de los puntos y en cuanto a los ¡! y ¿? miren esto : http://goo.gl/z14ab
:¬¬ FROG :¬¬
Creo que con eso lo habran entendido...
GRACIAS POR LEER!!!
Que bonito! :D
Me apunto! :)
Igual quedaría más divertido metiendo más cosas, como por ejemplo despues de las comas... :P
DoEvents! :P
HOLA!!!
Como despues de las comas? XD
Que yo sepa despues de las comas se escribe igual.
Ya se le agregamos los otros signos de puntuacion como ¿? y ¡! Que luego hay que escribir mayusculas.
GRACIAS POR LEER!!!
Pero...
Mira esto : http://goo.gl/z14ab
DoEvents! :P
HOLA!!!
Actualizado el RETO!
Agregadas variables booleanas para seleccionar si queres poner mayusculas despues de puntos, signos de interrogacion o exclamacion.
GRACIAS POR LEER!!!
Pero Frog, en el coso q pasaste es porq dice un Nombre xD, voy a ver si puedo hacer este reto aunquesea xD
HOLA!!!
Al fin!
Termine la funcion, estoy feliz con que sea funcional XD no se como me va a ir con la velocidad, seguro es lenta :P
Private Function uCaseCorrect7913(Txt As String) As String
Dim X As Long
Dim Y As Long
Dim Aux() As String
Dim MED As Long
Dim Ubi() As Long
Dim Susp As Long
Dim SIGNO(2) As String
SIGNO(0) = ".": SIGNO(1) = "?": SIGNO(2) = "!" 'TOMADO DE XXX-ZERO-XXX
Txt = "." & Txt & "a"
ReDim Sus(Int(Len(Txt) / 3))
ReDim Ubi(Len(Txt) + 5)
'".?¡"
For X = 0 To 2
Do
Y = Y + 1
Ubi(Y) = InStr(Ubi(Y - 1) + 1, Txt, SIGNO(X))
Loop While Ubi(Y) <> 0
Next
'COMPROBAR "..."
Do
Susp = InStr(Susp + 1, Txt, "...")
If Susp <> 0 Then
For X = 1 To Y
If Ubi(X) = Susp + 2 Then Ubi(X) = 0
Next
End If
Loop While Susp <> 0
'PONER MAYUSCULAS A LA PUNTUACION
ReDim Preserve Ubi(Y)
For X = 1 To Y
If Ubi(X) > 0 Then
MED = Ubi(X)
Do
MED = MED + 1
Loop While Not (((Asc(Mid$(Txt, MED, 1)) > 64) And Asc(Mid$(Txt, MED, 1)) < 91) Or ((Asc(Mid$(Txt, MED, 1)) > 96) And Asc(Mid$(Txt, MED, 1)) < 123)) And Not (Mid$(Txt, MED, 1) = "," Or Mid$(Txt, MED, 1) = ";" Or Mid$(Txt, MED, 1) = ".")
Mid$(Txt, MED, 1) = UCase$(Mid$(Txt, MED, 1))
End If
Next
'vbNewLine--------vbNewLine
Aux = Split(Txt, vbNewLine)
For X = 0 To UBound(Aux)
MED = 0
If X <> 0 Then
If Right$(Aux(X - 1), 1) = "." Or Right$(Aux(X - 1), 1) = "?" Or Right$(Aux(X - 1), 1) = "!" Then
Do
MED = MED + 1
Loop While Not (((Asc(Mid$(Aux(X), MED, 1)) > 64) And Asc(Mid$(Aux(X), MED, 1)) < 91) Or ((Asc(Mid$(Aux(X), MED, 1)) > 96) And Asc(Mid$(Aux(X), MED, 1)) < 123))
Mid$(Aux(X), MED, 1) = UCase$(Mid$(Aux(X), MED, 1))
End If
End If
Next
For X = 0 To UBound(Aux)
uCaseCorrect7913 = uCaseCorrect7913 & Aux(X) & vbNewLine
Next
uCaseCorrect7913 = Mid$(uCaseCorrect7913, 2, Len(uCaseCorrect7913) - 4)
End Function
GRACIAS POR LEER!!!
Bueno yo dejo la mia, como siempre 0 profesional xD pero bue.. talvez es la forma mas facil y eso es bueno no se.
EDITADOOO: Me dedico a otra cosa mejor mientras.. xD
@79137913
Error:
Cadenas:
* "miguel, ¡cuanto me alegro de que hayas llamado!"
** Debe retornar: "Miguel, ¡cuánto me alegro de que hayas llamado!"
Dulces Lunas!¡.
Me faltan mas cosas pero voy dejando aca, desp voy modificando este post:
Option Explicit
Function uCaseCorrect(txt As String) As String
Dim sFrase As String, sText As String
Dim pos As Long, i As Long, k As Long
Dim signo(4) As String
signo(0) = "¡": signo(2) = "."
signo(1) = "¿": signo(3) = "!": signo(4) = "?"
sText = UCase$(Left$(txt, 1))
sFrase = sText & Mid$(txt, 2)
uCaseCorrect = sFrase
For i = 0 To 4
If InStr(1, sFrase, signo(i)) <> 0 Then
k = 1
Do
pos = InStr(k, sFrase, signo(i))
While Mid$(sFrase, pos + 1, 1) = " "
pos = pos + 1
Wend
sText = UCase$(Mid$(sFrase, pos + 1, 1)) & Mid$(sFrase, pos + 2)
sFrase = Left$(sFrase, pos) & sText
k = k + 1
Loop While InStr(k, sFrase, signo(i)) <> 0
End If
Next i
uCaseCorrect = sFrase
End Function
Private Sub Form_Load()
Debug.Print uCaseCorrect("¡hola! ¿como andas? espero que bien che!!! Que pases bien entonces. chau. bye!")
End Sub
Salida:
Citar
¡Hola! ¿Como andas? Espero que bien che!!! Que pases bien entonces. Chau. Bye!
HOLA!!!
@BlackZeroX▓▓▒▒░░: SOLUCIONADO, proba con el codigo nuevo.
GRACIAS POR LEER!!!
Bueno ahora con nuevas reglas tengo q cambiar el codigo -_-' pero queda re simple ahora, mejor dejo asi ;)
Bueno, aquí dejo mi forma de hacerlo :rolleyes: :
Con una clase:
Option Explicit
'======================================================================
' º Class : cFrogUCase.cls
' º Version : 1.3
' º Author : Mr.Frog ©
' º Country : Spain
' º Mail : vbpsyke1@mixmail.com
' º Date : 16/02/2011
' º Twitter : http://twitter.com/#!/PsYkE1
' º Recommended Websites :
' http://foro.h-sec.org
' http://visual-coders.com.ar
' http://InfrAngeluX.Sytes.Net
'======================================================================
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Function IsCharLowerA Lib "user32" (ByVal cChar As Integer) As Long
Private Declare Function IsCharAlphaNumericA Lib "user32" (ByVal cChar As Integer) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal olestr As Long, ByVal BLen As Long) As Long
Private lngAscHeader&(0 To 5)
Private intAsc%()
Friend Function CorrectUCase(ByRef strText$) As String
Dim lngLength&, Q&
lngLength = LenB(strText) \ 2
If lngLength Then
lngAscHeader(3) = StrPtr(strText)
Do While Q < lngLength
If IsCharAlphaNumericA(intAsc(Q)) Then
If IsCharLowerA(intAsc(Q)) Then intAsc(Q) = intAsc(Q) - 32
Exit Do
End If
Q = Q + 1
Loop
Q = Q + 1
Do While Q < lngLength
If intAsc(Q) < 64 Then
Select Case intAsc(Q)
Case 33, 46, 63 '! . ?
Do
Q = Q + 1
Select Case intAsc(Q)
Case 59, 44, 46 '; , .
Q = Q + 1
GoTo Next_:
End Select
Loop While Q < lngLength And IsCharAlphaNumericA(intAsc(Q)) = 0
If IsCharLowerA(intAsc(Q)) Then intAsc(Q) = intAsc(Q) - 32
End Select
End If
Next_: Q = Q + 1
Loop
PutMem4 VarPtr(CorrectUCase), SysAllocStringByteLen(VarPtr(intAsc(0)), lngLength + lngLength)
End If
End Function
Private Sub Class_Initialize()
lngAscHeader(0) = &H1&: lngAscHeader(1) = &H2&: lngAscHeader(4) = &H7FFFFFFF
PutMem4 VarPtrArray(intAsc), VarPtr(lngAscHeader(0))
End Sub
Private Sub Class_Terminate()
PutMem4 VarPtrArray(intAsc), 0&
End Sub
Prueba:
Private Sub Form_Load()
Dim c As New cFrogUCase
Debug.Print c.CorrectUCase("¿hola como estás? esto es sólo una prueba Miguel... y además : ¡funciona genial! amo a las ranas!.")
Set c = Nothing
End Sub
Retorno:
¿Hola como estás? Esto es sólo una prueba Miguel... Y además : ¡funciona genial! Amo a las ranas!.
DoEvents! :P
Je y entonces frog porq le decias a 79137913 de cambiar el reto? xD entonces mi codigo es valido, hace lo mismo q el tuyo :P
Cita de: XXX-ZERO-XXX en 16 Febrero 2011, 21:16 PM
Je y entonces frog porq le decias a 79137913 de cambiar el reto? xD entonces mi codigo es valido, hace lo mismo q el tuyo :P
Me confundí al copiar el resultado después de tantas pruebas que hice, ya está arreglado. ;)
DoEvents! :P
Citar
Retorno:
Código:
¿Hola como estás? Esto es sólo una prueba Miguel... Y además : ¡funciona genial! Amo a las ranas!.
Despues de "¿Hola como estás? " no empezaria en minuscula?
Esta bien de cualkier forma q lo hagan para mi, la idea del reto se cumple ;)
Cita de: XXX-ZERO-XXX en 16 Febrero 2011, 21:26 PM
Despues de "¿Hola como estás? " no empezaria en minuscula?
Esta bien de cualkier forma q lo hagan para mi, la idea del reto se cumple ;)
Mayúsculas después de :
.
!
?DoEvents! :P
Error:
Debug.Print uCaseCorrect7913(" hola. esto es solo! ¿una prueba? jajjaja")
Llamada a argumento o procedimiento no válidos
Private Function uCaseCorrect7913(Txt As String) As String
Dim X As Long
Dim Y As Long
Dim Aux() As String
Dim MED As Long
Dim Ubi() As Long
Dim SIGNO(4) As String
SIGNO(0) = ".": SIGNO(1) = "?": SIGNO(2) = "!" 'TOMADO DE XXX-ZERO-XXX
Txt = Txt & "a"
ReDim Ubi(Len(Txt) + 5)
'.?¡
For X = 0 To 2
Do
Y = Y + 1
Ubi(Y) = InStr(Ubi(Y - 1) + 1, Txt, SIGNO(X))
Loop While Ubi(Y) <> 0
Next
'vbNewLine--------vbNewLine
Aux = Split(Txt, vbNewLine)
For X = 0 To UBound(Aux)
Mid$(Aux(X), 1, 1) = UCase$(Mid$(Aux(X), 1, 1))
Next
For X = 0 To UBound(Aux)
If X = 0 Then
Mid$(Aux(X), 1, 1) = UCase$(Mid$(Aux(X), 1, 1))
Else
If Right$(Aux(X - 1), 1) = "." Or Right$(Aux(X - 1), 1) = "?" Or Right$(Aux(X - 1), 1) = "!" Then
Mid$(Aux(X), 1, 1) = UCase$(Mid$(Aux(X), 1, 1))
End If
End If
Next
uCaseCorrect7913 = Mid$(uCaseCorrect7913, 1, Len(uCaseCorrect7913) - 3)
End Function
DoEvents! :P
@Mr. Frog
Errores:
¡Cómo ha nevado esta noche!; ¡qué blanco está todo!; ¡qué frío vamos a pasar hoy!» [RAE: Ortografía, 1999, § 5.6.4]
¿hola como estás? , esto es sólo una prueba Miguel... y además : ¡funciona genial! amo a las ranas!.
Dulces Lunas!¡.
Ook, gracias, ya modifiqué, ahora creo que ya está. :D
Private Sub Form_Load()
Dim c As New Class1
Debug.Print "----------------------------------------------------"
Debug.Print c.CorrectUCase("¡Cómo ha nevado esta noche!; ¡qué blanco está todo!; ¡qué frío vamos a pasar hoy!» [RAE: Ortografía, 1999, § 5.6.4]")
Debug.Print c.CorrectUCase("¿hola como estás? , esto es sólo una prueba Miguel... y además : ¡funciona genial! amo a las ranas!.")
Set c = Nothing
End Sub
Resultado:
----------------------------------------------------
¡Cómo ha nevado esta noche!; ¡qué blanco está todo!; ¡qué frío vamos a pasar hoy!» [RAE: Ortografía, 1999, § 5.6.4]
¿Hola como estás? , Esto es sólo una prueba Miguel... Y además : ¡funciona genial! Amo a las ranas!.
Si veis algún detalle más a corregir decirlo ;)
DoEvents! :P
.
Solo corregiste para la 1ra cadena pero la segunda?
P.D.: Estoy bastante ocupado que no puedo participar.
Dulces Lunas!¡.
Ya está! :P
DoEvents! :P
HOLA!!!
@Mr. Frog: Habia tenido un inconveniente al copiar y pegar XD
Me habia quedado la mitad del codigo en el bloc de notas :P
GRACIAS POR LEER!!!
Te queda el mismo error que dijo BlackZer0x que me quedó a mi antes:
Private Sub Form_Load()
Debug.Print "----------------------------------------------------"
Debug.Print uCaseCorrect7913("¡Cómo ha nevado esta noche!; ¡qué blanco está todo!; ¡qué frío vamos a pasar hoy!» [RAE: Ortografía, 1999, § 5.6.4]")
Debug.Print uCaseCorrect7913("¿hola como estás? , esto es sólo una prueba Miguel... y además : ¡funciona genial! amo a las ranas!.")
End Sub
----------------------------------------------------
¡Cómo ha nevado esta noche!; ¡Qué blanco está todo!; ¡Qué frío vamos a pasar hoy!» [RAE: Ortografía, 1999, § 5.6.
¿Hola como estás? , Esto es sólo una prueba Miguel... Y además : ¡funciona genial! Amo a las ranas
Debería de dar:
----------------------------------------------------
¡Cómo ha nevado esta noche!; ¡qué blanco está todo!; ¡qué frío vamos a pasar hoy!» [RAE: Ortografía, 1999, § 5.6.4]
¿Hola como estás? , Esto es sólo una prueba Miguel... Y además : ¡funciona genial! Amo a las ranas!.
DoEvents! :P
HOLA!!!
@Mr. Frog: Creo que ya esta, ahora si funciona como decis :P
Ahora si podes hacer el test de velocidad... aunque ya sabemos cual es mas rapida :(
XD
GRACIAS POR LEER!!!
Texto en Text1:
las declaraciones del presidente de la academia de cine español, álex de la iglesia, ayer por la tarde en el programa la ventana de la cadena ser para defender la finalmente tumbada ley sinde son de las que atacan el hígado y hacen que la sangre suba a la cabeza. o esta gente no se ha dado cuenta de en qué mundo vive, o se cree el ombligo del mundo. "si se follan (sic) una película en internet durante la primera semana de su estreno, esa cinta ya no levanta cabeza", espetó de la iglesia. vaya. bienvenido al mundo real. le diré que no solo les pasa a ustedes. que, por ejemplo, si alguno de mis compañeros periodistas o yo misma escribimos un artículo, una exclusiva o un reportaje a fondo, tenemos que asumir que nuestro trabajo pase a ser gratuito en cuestión de horas, verlo flotar en múltiples páginas de internet y comprobar cómo, cada vez más, es muy complicado poder ingresar dinero por nuestro trabajo. el papel está a punto de pasar a la historia, sí. casi nadie está dispuesto a pagar por lo que puede tener gratis, también. es injusto y es muy difícil encontrar la solución, pues oiga, han descubierto ustedes la pólvora.
la diferencia es que el mundo del periodismo –y hablo de este porque es el que más conozco, aunque hay muchos otros ejemplos– se ve obligado a aceptar que es así porque las cosas evolucionan y, por tanto, los editores se rompen la cabeza a día de hoy para encontrar la solución: la tecla, el formato o la idea revolucionaria que haga compaginar las nuevas tecnologías con el hecho de poder ingresar dinero y que los profesionales puedan recibir un salario sin tener que depender de un mecenas o de las subvenciones del gobierno de turno. mientras medio mundo asume, mientras busca soluciones para reinventarse y superar esta problemática, algunos artistas se creen que solo ellos existen. que son las únicas víctimas del universo. dice de la iglesia que la ley sinde "beneficia a las compañías telefónicas", porque cuanto más se use la red, más ganan. vaya. de perogrullo, claro. pues carguémonos internet, y aquí paz y después gloria.
"yo pido a los políticos que solucionen los problemas", continúa el presidente de la academia de cine. ¿y a los demás, quién se los soluciona? porque le recuerdo que hay múltiples sectores con el agua al cuello, cada uno con su particular soga, y no por eso el gobierno crea una ley para cada uno de ellos que establezca un procedimiento de urgencia. a la gente de a pie no le queda más remedio que someterse a largos procesos judiciales para defender sus derechos. procesos demasiado largos, sí, pero ese ya sería otro tema.
"no hay por un lado los internautas y por otro lado los creadores. yo soy internauta y soy creador", sigue de la iglesia. pues me gustaría saber si el señor presidente de la academia de cine se suscribe cada día a un periódico digital pagando una cuota y si nunca lee información gratuita, como casi todo hijo de vecino. porque de ser así, la siguiente pregunta es: ¿tiene usted un doble discurso o es que cree que solo en el mundo del cine y la música hay creadores y los demás son de segunda categoría?
si se hubiese aprobado la ley sinde, muchos otros estarían también en su derecho de reclamar su propiedad intelectual. el efecto dominó podría ser interminable, hasta suponer que internet perdiese todo el sentido. algunos ya han encontrado la fórmula, respetando los derechos y ofreciendo algo distinto o novedoso por lo que la gente está dispuesta a pagar. pónganse las pilas. aunque claro, una suscripción no es tan rentable como vender un cd o un dvd a 20 euros. la baraja se llama internet. asumamos que no se puede romper, así que juguemos todos. eso sí, sin las cartas marcadas.
Test:
' Compilado quitando comprobación de límites de arrays. :P
Private Sub Form_Load()
Dim t As New CTiming
Dim c1 As Class1
Dim X As Long
Dim s As String
Set c1 = New Class1
AutoRedraw = True
s = Text1.Text
t.Reset
For X = 1 To 20000
uCaseCorrect7913 s
Next
Me.Print "uCaseCorrect7913", t.sElapsed
DoEvents
t.Reset
For X = 1 To 20000
c1.CorrectUCase s
Next
Me.Print "cFrogUCase.cls", t.sElapsed
Set c1 = Nothing
End Sub
Resultado:
(http://img844.imageshack.us/img844/8171/dibujouu.jpg)
DoEvents! :P
jajajaja, me encanta ver estos retos..! Excelente Rana...!
.
Esta mal, delante de la coma...
¡Cómo ha nevado esta noche!; ¡qué blanco está todo!; ¡qué frío vamos a pasar hoy!» [RAE: Ortografía, 1999, § 5.6.4]
¿Hola como estás? , Esto es sólo una prueba Miguel... Y además : ¡funciona genial! Amo a las ranas!.
Error en la coma.
Signos de puntuación (La Coma) (http://es.wikipedia.org/wiki/Signo_de_puntuaci%C3%B3n#La_coma)
Error en puntos suspensivos:
Puntos Suspensivos (http://es.wikipedia.org/wiki/Puntos_suspensivos)
Dulces Lunas!¡.
Ook, nueeevas cosas a añadir... :D
Sería así:
¿Hola como estás? , esto es sólo una prueba Miguel... y además : ¡funciona genial! Amo a las ranas!.
DoEvents! :P
HOLA!!!
Funcional!
GRACIAS POR LEER!!!
Ya está corregido el mío también... :)
Prueba:
Private Sub Form_Load()
Dim c1 As Class1
Const s1 As String = "¿hola como estás? , esto es sólo una prueba Miguel... y además : ¡funciona genial! amo a las ranas!."
Set c1 = New Class1
Debug.Print c1.CorrectUCase(s1)
Debug.Print uCaseCorrect7913(s1)
Set c1 = Nothing
End sub
Retorno:
¿Hola como estás? , esto es sólo una prueba Miguel... y además : ¡funciona genial! Amo a las ranas!.
¿Hola como estás? , esto es sólo una prueba Miguel... y además : ¡funciona genial! Amo a las ranas!.A
Cambiando esta linea el 3 por un 4 me da resultado correcto:
uCaseCorrect7913 = Mid$(uCaseCorrect7913, 2, Len(uCaseCorrect7913) - 4)
Test:
'Compilado quitando comprobación de límites de arrays
Option Explicit
Private Sub Form_Load()
Dim t As New CTiming
Dim c1 As Class1
Dim X As Long
Dim s As String
Set c1 = New Class1
AutoRedraw = True
s = Text1.Text '// Mismo contenido que en el anterior test
t.Reset
For X = 1 To 1000
uCaseCorrect7913 s
Next
Me.Print "uCaseCorrect7913", t.sElapsed
DoEvents
t.Reset
For X = 1 To 1000
c1.CorrectUCase s
Next
Me.Print "cFrogUCase.cls", t.sElapsed
Set c1 = Nothing
End Sub
Resultado:
(http://img402.imageshack.us/img402/4255/dibujofln.jpg)
DoEvents! :P
yo no se ustedes pero si quieren algo al 100% mejor publicamos Varias cadenas en TODAS las sircustancias para que mas de uno ya tenga a la mano dichas cadenas y haga pruebas y ls compruebe con una ya que este perfecta, es decir meterle puntos comas al grede pero que sean coherentes y tambien por que no incoherentes; pero que estas ultimas nos reporte donde rayos hay errores.
P.D.: No vi el codigo de la Rana anteriormente completo, pero esta genial ese cambio de tipo de los bytes del char a los 2 bytes del integer para asi manipular la string de forma mas facil, si no mal recuerdo esto mismo lo hacia L.A..
Dulces Lunas!¡.
Este es mi código, espero que os guste. :P
Private Function uCaseCorrector(txt As String) As String
Dim Signos As String
Dim Espacios() As Integer
Dim a, b As Integer
Dim tmp As String
Dim tmp2 As String
'Los signos a controlar, se puede incrementar
Signos = ".;:¿?¡!"
'Sacamos los espacios
ReDim Espacios(1 To Len(txt))
For a = 1 To Len(txt)
b = b + 1
If Mid(txt, a, 1) = " " Then
Espacios(b) = b
b = b - 1
Else
tmp = tmp + Mid(txt, a, 1)
End If
Next a
b = 0
'Corregimos el texto
For b = 1 To Len(Signos)
For a = 1 To Len(tmp)
If Mid(tmp, a, 1) = Mid(Signos, b, 1) And a + 1 < Len(tmp) Then
Mid(tmp, a + 1, 1) = UCase(Mid(tmp, a + 1, 1))
End If
Next a
Next b
'Colocamos los espacios
For a = 1 To Len(txt)
If Espacios(a) <> 0 Then
tmp2 = tmp2 + " " + Mid(tmp, a, 1)
Else
tmp2 = tmp2 + Mid(tmp, a, 1)
End If
Next a
'La Solucion
uCaseCorrector = tmp2
End Function
Saludos