[RETO] CompWordsAlphabetically

[Edu]

Che Fran, me parece a mi o haces un tipo de trampa? xD es decir q es eso de dividir entre 2 xD?

@Karcrack fijate con esto a ver si anda tu funcion..

Código [Seleccionar] Expandir


Private Sub Form_Load()

    Debug.Print kCompare("elfo", "elefante")
    Debug.Print kCompare("ave", "zorro")
    Debug.Print kCompare("hola", "")
    Debug.Print kCompare("zero", "zerocool")
    Debug.Print kCompare("feo", "    ")
    Debug.Print kCompare("frog", "frog")
    Debug.Print kCompare("faso", "fasa")
    Debug.Print kCompare("JOJO", "jojo")
   
   
End Sub


[79137913]

HOLA!!!

Che *Fran , me parece a mi o haces un tipo de trampa? xD es decir q es eso de dividir entre 2 xD?

*Nick PLZ...

Nah, no es trampa el tema es que lenb devuelve el espacio en memoria  que es igual a el doble de caracteres.

GRACIAS POR LEER!!!

[Karcrack]

@79137913:Reparado, habia un problema con la comprobación de tamaños

[raul338]

Código (vb) [Seleccionar] Expandir


       If (Not Not b) = False Then
           ReDim b(-1 To 1)
           b(-1) = 1
           b(1) = 2
           b(0) = 3
       End If


Porque esa comprobacion? No es que ese array ya tiene algo :-/ lo inicializas de una y listo , o sino mas facil con Choose (aunque no se si mas rapido )

[Edu]

Ah claro, ya entendi xD

[Karcrack]

@raul338:Lo que hace esa linea If (Not Not b) = False Then es comprobar si el array ha sido rellenado... si no lo rellenará... No lo hago ni con un Choose() ni rellenando siempre el array por cuestión de velocidad.

[raul338]

Tramposo, no sabia que se podian hacer funciones estaticas

[Psyke1]

Tramposo, no sabia que se podian hacer funciones estaticas

Dije al principio que valía todo...

ATENCIÓN : No tiene porque devolver los números del primer post!!!

Aquí dejo la mía:

Código (vb) [Seleccionar] Expandir


Option Explicit
Option Compare Text

Private Declare Function lstrcmpW Lib "kernel32.dll" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long

' -1 > Error
' 1  > Iguales
' 0  > primera palabra
' 2  > segunda palabra
Public Static Function CompareMrFrog(ByRef strWord1$, ByRef strWord2$) As Long
   If LenB(strWord1) = 0 Or LenB(strWord2) = 0 Then
       CompareMrFrog = -1
       Exit Function
   End If
   
   If strWord1 = strWord2 Then
       CompareMrFrog = 1
       Exit Function
   End If
   
   CompareMrFrog = lstrcmpW(StrPtr(strWord1), StrPtr(strWord2)) + 1
End Function

@Karcrack


DoEvents!

[Karcrack]

TRAMPOOOOOOOOSOOOOOO!!
Anda que modificar las normas a tu gusto... ya te vale

[Psyke1]

Jajajajaja
Si te fijas, en ningún momento dije que debia que devolver esos números...

Tu función devuelve un resultado erróneo aquí:

Código [Seleccionar] Expandir

   Debug.Print kCompare("feo", "    ")
Debería devolver la segunda y devuelve la primera...

Ahora dejo mi versión 2:

Código (vb) [Seleccionar] Expandir

Option Explicit
Option Base 0

Private Declare Sub PutMem4 Lib "msvbvm60.dll" (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 IsCharUpperW Lib "user32.dll" (ByVal lngChar As Long) As Long

Private lngAscHeader1&(5), lngAscHeader2&(5)
Private intAsc1%(), intAsc2%()

' 0 -> Error
' 1 -> First Word
' 2 -> Equal
' 3 -> Secon Word
Friend Static Function Compare(ByRef strWord1$, ByRef strWord2$) As Long
Dim Q&, L&

   L = LenB(strWord1) \ 2
   If L = 0 Or LenB(strWord2) = 0 Then Exit Function
   
   lngAscHeader1(3) = StrPtr(strWord1)
   lngAscHeader2(3) = StrPtr(strWord2)

   For Q = 0 To L
       If IsCharUpperW(intAsc1(Q)) Then
           intAsc1(Q) = intAsc1(Q) + 32
       End If
       
       If IsCharUpperW(intAsc2(Q)) Then
           intAsc2(Q) = intAsc2(Q) + 32
       End If
       
       If intAsc2(Q) > intAsc1(Q) Then
           Compare = 1
           Exit Function
       ElseIf intAsc2(Q) < intAsc1(Q) Then
           Compare = 3
           Exit Function
       ElseIf Q = L Then
           Compare = 2
           Exit Function
       End If
   Next Q
End Function

Private Sub Class_Initialize()
   lngAscHeader1(0) = &H1&
   lngAscHeader1(1) = &H2&
   lngAscHeader1(4) = &H7FFFFFFF
   PutMem4 VarPtrArray(intAsc1), VarPtr(lngAscHeader1(0))
   
   lngAscHeader2(0) = &H1&
   lngAscHeader2(1) = &H2&
   lngAscHeader2(4) = &H7FFFFFFF
   PutMem4 VarPtrArray(intAsc2), VarPtr(lngAscHeader2(0))
End Sub

Private Sub Class_Terminate()
   PutMem4 VarPtrArray(intAsc1), 0&
   PutMem4 VarPtrArray(intAsc2), 0&
End Sub

Ejemplos:

Código (vb) [Seleccionar] Expandir

Private Sub Form_Load()
Dim c As New Class1

   Debug.Print "---------------------------------------------"
   Debug.Print c.Compare("rana", "")
   Debug.Print c.Compare("hola", "holas")
   Debug.Print c.Compare("bienvenido", "bienvenida")
   Debug.Print c.Compare("Ejemplo", "eJempLIficar")
   Debug.Print c.Compare("igual", "igual")
   Debug.Print c.Compare("PaLaBrA", "palabra")
   Debug.Print "---------------------------------------------"
   Debug.Print c.Compare("elfo", "elefante")
   Debug.Print c.Compare("ave", "zorro")
   Debug.Print c.Compare("hola", "")
   Debug.Print c.Compare("zero", "zerocool")
   Debug.Print c.Compare("feo", "    ")
   Debug.Print c.Compare("frog", "frog")
   Debug.Print c.Compare("faso", "fasa")
   Debug.Print c.Compare("JOJO", "jojo")
End Sub

Resultado:

Código [Seleccionar] Expandir

---------------------------------------------
0
1
3
3
2
2
---------------------------------------------
3
1
0
1
3
2
3
2



DoEvents!