¿Qué pasa? :huh: ¿Donde están los retos que caracterizan a esta sección? :-( :xD
A ver que os parece este:
Parte 1:
Crear una función que compare dos palabras (sin importar mayúsculas) y devuelva:
0 : Error
1 : La 1ª palabra va antes en el abecedario
2 : La 2ª palabra va antes en el abecedario
3 : Ambas palabras son iguales
Ejemplos:
"rana" - "" -> 0
"hola" - "holas" -> 1
"bienvenido" - "bienvenida" -> 2
"Ejemplo" - "eJempLIficar" -> 2
"igual" - "igual" -> 3
"PALABRA" - "palabra" -> 3
Espero haber sido claro...;) Si hay alguna duda preguntad.
Por supuesto vale todo y el más rápido gana :)
PD: La Parte 2 la propondré cuando esté la parte 1 finalizada... :rolleyes:
DoEvents! :P
HOLA!!!
Listo!!!
Private Function FirstWord7913(W1 As String, W2 As String) As Long
If LenB(W1) = 0 Then
FirstWord7913 = 0
Exit Function
End If
If LenB(W2) = 0 Then
FirstWord7913 = 0
Exit Function
End If
Dim ST1 As Byte
Dim ST2 As Byte
ST1 = LCase$(W1)
ST2 = LCase$(W2)
If LenB(ST1) = LenB(ST2) Then
If InStrB(1, ST1, ST2, vbBinaryCompare) Then
FirstWord7913 = 3
Exit Function
End If
End If
Dim B1() As Byte
Dim B2() As Byte
B1 = ST1
B2 = ST2
Dim X As Long
If UBound(B1) > UBound(B2) Then
For X = 1 To UBound(B2) Step 2
If B1(X) < B2(X) Then
FirstWord7913 = 1
Exit Function
ElseIf B1(X) > B2(X) Then
FirstWord7913 = 2
Exit Function
End If
Next
FirstWord7913 = 2
Exit Function
Else
For X = 1 To UBound(B1) Step 2
If B1(X) < B2(X) Then
FirstWord7913 = 1
Exit Function
ElseIf B1(X) > B2(X) Then
FirstWord7913 = 2
Exit Function
End If
Next
FirstWord7913 = 1
Exit Function
End If
End Function
GRACIAS POR LEER!!!
@79137913: No creo que esa versión sea demasiado rápida :xD
LenB(W1) / 2 = 0
:o Por que divides entre 2? :-\
Option Explicit
Sub Main()
Debug.Print kCompare("rana", "")
Debug.Print kCompare("hola", "holas")
Debug.Print kCompare("bienvenido", "bienvenida")
Debug.Print kCompare("Ejemplo", "eJempLIficar")
Debug.Print kCompare("igual", "igual")
Debug.Print kCompare("PALABRA", "palabra")
End Sub
Public Static Function kCompare(ByRef s1 As String, ByRef s2 As String) As Long
Dim b() As Long
If (LenB(s1) <> 0) And (LenB(s2) <> 0) Then
If (Not Not b) = False Then
ReDim b(-1 To 1)
b(-1) = 1
b(1) = 2
b(0) = 3
End If
kCompare = b(StrComp(s1, s2, vbTextCompare))
End If
End Function
Si no hubieses elegido esos numeros todo seria mas fácil :xD
HOLA!!!
XD se me paso Karcrack, lo vi despues :P
De a poco la voy a ir optimizando
Funcion actualizada:
Cambiado Asc por AscW
Funcion convertida a Long
Agregada comparacion por InstrB
GRACIAS POR LEER!!!
Cuando aprendere a programar como ustedes :( no se rien q todavia q lo hago jaja:
Option Explicit
Private Sub Form_Load()
Debug.Print CheckWord("elfo", "elefante")
Debug.Print CheckWord("ave", "zorro")
Debug.Print CheckWord("hola", "")
Debug.Print CheckWord("zero", "zerocool")
Debug.Print CheckWord("feo", " ")
Debug.Print CheckWord("frog", "frog")
Debug.Print CheckWord("faso", "fasa")
Debug.Print CheckWord("JOJO", "jojo")
End Sub
Function CheckWord(sFirst As String, sSecond As String) As Long
Dim i As Integer
Dim max As Integer
sFirst = LCase$(Trim$(sFirst))
sSecond = LCase$(Trim$(sSecond))
' Verificar error
If sFirst = "" Or sSecond = "" Then
CheckWord = 0: Exit Function
End If
' Establecer valor maximo del bucle
If Len(sFirst) < Len(sSecond) Then
max = Len(sFirst)
Else
max = Len(sSecond)
End If
'Bucle
For i = 1 To max
If (Left(sFirst, i) < Left(sSecond, i)) Then
CheckWord = 1
Exit Function
ElseIf (Left(sFirst, i) > Left(sSecond, i)) Then
CheckWord = 2
Exit Function
' Si por ahora es igual..
ElseIf (Left(sFirst, i) = Left(sSecond, i)) Then
If i = max Then ' Si ya termina el bucle comprobamos..
If Len(sFirst) > Len(sSecond) Then
CheckWord = 2
Exit Function
End If
If Len(sFirst) < Len(sSecond) Then
CheckWord = 1
Exit Function
End If
' Por descarte..
CheckWord = 3
Exit Function
End If
End If
Next i
End Function
Salida:
2
1
0
1
1
3
2
3
Edit: Ahora veo q me falto lo de comparar con las mayusculas fuck, conrazon se mataban ustedes jaja, no creo q me den las bolas para hacer :)
HOLA!!!
Jajaja, no me habia percatado del strcomp XD ya fue voy a seguir viendo, GRANDE Karcrack :P
GRACIAS POR LEER!!!
Ma q asco q das Karcrack xD !!
(http://www.cibercronicas.com/wp-content/uploads/2010/11/cool-face.jpg)
PROBLEM? :xD :xD
PD: Quien haga las pruebas de velocidad que sea bondadoso y desactive la comprobacion de tamaño del buffer y esas cositas para que todo sea mas rapido y divertido :laugh:
:¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬
Mi forma era igual que la tuya! :(
Te odio, pero me buscaré la vida para hacerlo diferente, quizás no más rapido pero si diferente. :P
Asi que no testeeis aun... >:(
Por la tarde posteo la parte 2 del reto :)
Gracias por participar... :-*
DoEvents! :P
HOLA!!!
Con razon el "Por supuesto vale todo" :¬¬
GRACIAS POR LEER!!!
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..
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
HOLA!!!
Cita de: XXX-ZERO-XXX en 11 Marzo 2011, 16:43 PM
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!!!
@79137913:Reparado, habia un problema con la comprobación de tamaños :xD
Cita de: Karcrack en 11 Marzo 2011, 15:00 PM
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 :P, o sino mas facil con Choose (aunque no se si mas rapido :P)
Ah claro, ya entendi xD
@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.
Tramposo, no sabia que se podian hacer funciones estaticas :xD :xD
Cita de: raul338 en 11 Marzo 2011, 22:33 PM
Tramposo, no sabia que se podian hacer funciones estaticas :xD :xD
Dije al principio que valía todo... :silbar:
ATENCIÓN : No tiene porque devolver los números del primer post!!!
Aquí dejo la mía:
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
(http://st-listas.20minutos.es/images/2011-03/279093/2911201_640px.jpg?1299698127)
DoEvents! :P
(http://images1.memegenerator.net/ImageMacro/4389154/you-win-this-time.jpg?imageSize=Medium&generatorName=Pissed-off-Obama)
TRAMPOOOOOOOOSOOOOOO!!
Anda que modificar las normas a tu gusto... ya te vale :¬¬
Jajajajaja :laugh:
Si te fijas, en ningún momento dije que debia que devolver esos números... :silbar: :-*
Tu función devuelve un resultado erróneo aquí:
Debug.Print kCompare("feo", " ")
Debería devolver la segunda y devuelve la primera... :rolleyes:
Ahora dejo mi versión 2:
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:
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:
---------------------------------------------
0
1
3
3
2
2
---------------------------------------------
3
1
0
1
3
2
3
2
(http://gamersmafia.com/storage/comments/547/47/maximum_trolling.jpg)
DoEvents! :P
Cita de: Mr.Frog™ en 12 Marzo 2011, 14:51 PM
Tu función devuelve un resultado erróneo aquí:
Debug.Print kCompare("feo", " ")
Debería devolver la segunda y devuelve la primera... :rolleyes:
Ummm... En abecedario el [espacio] no esta incluido, asi que "feo" va antes que " feo"... >:D
Cita de: Karcrack en 12 Marzo 2011, 16:06 PM
Ummm... En abecedario el [espacio] no esta incluido, asi que "feo" va antes que " feo"... >:D
:xD
Tan sutil como siempre... :¬¬
Me temo que lógico sería:
1.-Signos y símbolos
2.-Números
3.-Letras
Además
el vb me apoya, si hago esto:
Private Sub Form_Load()
With List1
.AddItem "4paleto"
.AddItem "paleto"
.AddItem " paleto"
End With
End SubY pongo la propiedad
Sorted en el
List1 (
para ordenar el contenido del mismo) este es el resultado:
(http://img218.imageshack.us/img218/2161/nuevaimagendemapadebitsgs.png)
Quizás quieras revisar tu función. :rolleyes:
DoEvents! :P
VB NO te apoya... StrComp() :silbar:
:xD
Y QuickSort tambien ¿no? :¬¬
Private Sub Form_Load()
Dim a() As String
Dim vItem
a = Split("karcrack es un pesado 4ejemplo %ejemplo", " ")
QuickSort a
For Each vItem In a
Debug.Print vItem
Next
End Sub
Resultado:
%ejemplo
4ejemplo
es
karcrack
pesado
un
No insistas, todos los ejemplos (menos el tuyo :xD) lo ordenan así... :silbar:
DoEvents! :P
HOLA!!!
Mmm, lamentablemente en este caso creo que tiene que devolver error si comparas una palabra con una cadena de espacios, pero al comparar "palabra" con" palabra" tiene que devolver iguales, pero es necesario que tome en cuenta los espacios, ya que "hola como andas" va antes que "holacomoestas" no se si me entienden... Seria lo mas correcto.
GRACIAS POR LEER!!!
Pero 7913, eso seria para otra cosa, esto es sobre palabras nomas xD y si usas el mio creo q anda ya para eso pero la idea es con palabras solamente.
Quien gano entonces? Frog haciendo trampa o Karcrack con errores? xD jajaj
Cita de: XXX-ZERO-XXX en 12 Marzo 2011, 18:36 PM
Pero 7913, eso seria para otra cosa, esto es sobre palabras nomas xD y si usas el mio creo q anda ya para eso pero la idea es con palabras solamente.
Quien gano entonces? Frog haciendo trampa o Karcrack con errores? xD jajaj
Yo no hice trampa en ningún momento. :¬¬
Yo soy el que planteó el reto, así que os tendréis que adaptar a las normas del mismo al igual que hago yo cuando participo en otro.
Cuando la función de Karcrack devuelva resultados "correctos" lo testearé.
Y después propondré la
Parte 2 del reto...
DoEvents! :P
Pues entonces me da la sensación de que planteas mal el reto... Si lo que quieres es que las ordene siguiendo el orden de cada carácter en la Tabla Ascii esta mal planteado.
Tu pides alfabeticamente... Y el alfabeto no contempla el espacio... luego lógicamente debería ser situado después de todas las letras del alfabeto...
http://es.wikipedia.org/wiki/Alfabeto_latino
Aún así StrComp() compara según el Ascii Code... así que teóricamente mi función ha de seguir tus directrices...
Lo siento tienes razón, lo planteé mal entonces... :silbar:
Según la tabla ascii :)
DoEvents! :P
Bueno pero no te enojes Frog xD, hace los test q me interesa saber si mi codigo esta demasiadoo lento o q
Cita de: Mr.Frog™ en 12 Marzo 2011, 19:33 PM
Lo siento tienes razón, lo planteé mal entonces... :silbar:
Según la tabla ascii :)
DoEvents! :P
(http://plethorapress.typepad.com/photos/uncategorized/i_win_1.gif)