Mensajes

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!

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!

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!

Pero...
Mira esto : http://goo.gl/z14ab

DoEvents!

Que bonito!
Me apunto!
Igual quedaría más divertido metiendo más cosas, como por ejemplo despues de las comas...

DoEvents!

[@ignorantev1.1]

rana, pone los otros codigos tambien.

No solamente los que buscan en arrays.
Manejando arrays soy un queso.

¿Ya está puestos en la pág anterior no?

@ignorantev1.1
Dios, soy un desastre, al llamar tu constante igual que la mía, al copiarlo para el test, copié la mía en vez de la tuya...

PD: Tabla de resultados actualizada!

DoEvents!

Ya está corregida.

Test:

Código [Seleccionar] Expandir

Option Explicit

Private Const sF As String = " 0 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 3524578 5702887 9227465 14930352 24157817 39088169 63245986 102334155 165580141 267914296 433494437 701408733 1134903170 1836311903 "

Function isfibonacciIgno(IngNum As Long) As Boolean
   isfibonacciIgno = InStr(sF, " " & IngNum & " ")
End Function

Public Static Function IsFibonacci_WithCache_MrFrog(ByRef lngNum As Long) As Boolean
   IsFibonacci_WithCache_MrFrog = InStrB(1, sF, " " & lngNum & " ")
End Function

Public Function IsFibonacci_WithCache(ByRef vVal As Long) As Boolean
Dim lng_i          As Long
Dim var_cache()
   var_cache() = Array(0, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, 317811, 514229, 832040, 1346269, 2178309, 3524578, 5702887, 9227465, 14930352, 24157817, 39088169, 63245986, 102334155, 165580141, 267914296, 433494437, 701408733, 1134903170, 1836311903)
   For lng_i = 0 To UBound(var_cache)
       If var_cache(lng_i) = vVal Then IsFibonacci_WithCache = True: Exit For
   Next lng_i
End Function

Public Function FibonacciChecker_eCode(ByRef lNumero As Long) As Boolean
Dim FiSplit() As String
Dim i As Long
Const Fi As String = "0,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711,28657,46368"
FiSplit() = Split(Fi, ",", -1, vbBinaryCompare)

For i = 0 To 23
   If lNumero = CLng(FiSplit(i)) Then FibonacciChecker_eCode = True: Exit Function
   If lNumero < CLng(FiSplit(i)) Then FibonacciChecker_eCode = False: Exit Function
Next i
End Function

Private Sub Form_Load()
If App.LogMode = 0 Then End 'Compile it, stupid!

Dim t As New CTiming
Dim x As Long
   AutoRedraw = True
   
   t.Reset
   For x = 0 To 100000
       IsFibonacci_WithCache_MrFrog x
   Next
   Me.Print "MrFrog", , t.sElapsed
   
   t.Reset
   For x = 0 To 100000
       isfibonacciIgno x
   Next
   Me.Print "ignorantev1.1", , t.sElapsed
   
   t.Reset
   For x = 0 To 100000
       IsFibonacci_WithCache x
   Next
   Me.Print "BlackZer0x", , t.sElapsed
   
   t.Reset
   For x = 0 To 100000
       FibonacciChecker_eCode x
   Next
   Me.Print "Elemental Code", t.sElapsed
End Sub

Resultado:


DoEvents!

Ook, con trampa creo que gano...

Código (vb) [Seleccionar] Expandir

Private Const sF As String = " 0 1 2 35 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 3524578 5702887 9227465 14930352 24157817 39088169 63245986 102334155 165580141 267914296 433494437 701408733 1134903170 1836311903 "

Public Static Function IsFibonacci_WithCache_MrFrog(ByRef lngNum As Long) As Boolean
    IsFibonacci_WithCache_MrFrog = InStrB(1, sF, " " & lngNum & " ")
End Function

DoEvents!

[@Black]

@Black
Oops... Lo peor de todo es que sé los bytes correspondientes a cada variable.
No se porque pensaba que Int() era direfente de CInt() ... En fin, cosas mías, gracias por la corrección.

DoEvents!

GetProcAdress()... y las demás APIS que no recuerdo xP.

Dulces Lunas!¡.

Pero eso que dices no es para llamar funciones de una dll?
La verdad que no veo la manera de sacar el tiempo que tarda en llamar la funcion CBNX...

DoEvents!