[SRC] cFrogUCase.cls [by Mr. Frog ©]

[Psyke1]

Bueno, aquí dejo mi clase para poner mayúsculas todo aquel carácter que lo requiera, es decir, los que vand espues de "." , "!" y "?" :
Es extremadamente rápido porque uso ApiDoping

Código: (vb) [Seleccionar]

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]

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]

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

[R@MI]

Código: [Seleccionar]

[b]Amo a las ranas!.[/b]

=_=