[RETO] uCaseCorrect. Corrector de Mayusculas!

[79137913]

HOLA!!!

@BlackZeroX▓▓▒▒░░: SOLUCIONADO, proba con el codigo nuevo.

GRACIAS POR LEER!!!

[Edu]

Bueno ahora con nuevas reglas tengo q cambiar el codigo -_-' pero queda re simple ahora, mejor dejo asi

[Psyke1]

Bueno, aquí dejo mi forma de hacerlo :

Con una clase:

Código (vb) [Seleccionar] Expandir


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:

Código (vb) [Seleccionar] Expandir

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:

Código [Seleccionar] Expandir

¿Hola como estás?  Esto es sólo una prueba Miguel... Y además : ¡funciona genial!  Amo a las ranas!.

DoEvents!

[Edu]

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

[Psyke1]

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

Me confundí al copiar el resultado después de tantas pruebas que hice, ya está arreglado.

DoEvents!

[Edu]

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

[Psyke1]

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 :

Código [Seleccionar] Expandir

.
!
?

DoEvents!

[Psyke1]

Error:

Código (vb) [Seleccionar] Expandir

Debug.Print uCaseCorrect7913(" hola. esto es solo! ¿una prueba? jajjaja")

Código [Seleccionar] Expandir

Llamada a argumento o procedimiento no válidos

Código (vb,35) [Seleccionar] Expandir


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!

[BlackZeroX]

@Mr. Frog

Errores:

Código [Seleccionar] Expandir



¡Cómo ha nevado esta noche!; ¡qué blanco está todo!; ¡qué frío vamos a pasar hoy!» [RAE: Ortografía, 1999, § 5.6.4]



Código [Seleccionar] Expandir



¿hola como estás? , esto es sólo una prueba Miguel... y además : ¡funciona genial!  amo a las ranas!.



Dulces Lunas!¡.

[Psyke1]

Ook, gracias, ya modifiqué, ahora creo que ya está.

Código (vb) [Seleccionar] Expandir

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ódigo [Seleccionar] Expandir

----------------------------------------------------
¡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!