Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: Psyke1 en Mayo 09, 2011, 02:02:45 pm
-
Bueno, aquí os dejo esta sencilla función. :)
Su finalidad es devolver el Index de un Item que se encuentre en un array ordenado (acepta todo tipo de Arrays : String, Double, Long...), con la opción de devolver el primero que se encuentre en el array y con los parámetros lngStart y lngEnd podemos establecer límites en nuestra búsqueda. :D
Para ordenarlo aconsejo usar esta maravillosa función que hizo mi amigo BlackZer0x (http://foro.elhacker.net/profiles/blackzerox961996199618961896179617-u59494.html) :
http://goo.gl/RG4Bx
Option Explicit
'======================================================================
' º Function : IsInArray
' º Author : Psyke1
' º Country : Spain
' º Mail : vbpsyke1@mixmail.com
' º Date : 09/05/2011
' º Twitter : http://twitter.com/#!/PsYkE1
' º Dedicated : BlackZer0x
' º Reference : http://goo.gl/RDQhK
' º Recommended Websites :
' http://foro.h-sec.org
' http://www.frogcheat.com.ar
' http://InfrAngeluX.Sytes.Net
'======================================================================
Public Static Function IsInArray&(varArr, varValue, Optional lngStart&, Optional lngEnd&, Optional bolFindFirst As Boolean)
Dim lngLB&, lngUB&, Q&, C&
If IsArray(varArr) Then
lngLB = LBound(varArr)
lngUB = UBound(varArr)
If Not IsMissing(lngStart) Then
If (lngStart > lngLB) And (lngStart < lngUB) Then lngLB = lngStart
End If
If Not IsMissing(lngEnd) Then
If (lngEnd > lngLB) And (lngEnd < lngUB) Then lngUB = lngEnd
End If
If varArr(lngLB) = varValue Then
IsInArray = lngLB
Exit Function
ElseIf varArr(lngUB) = varValue Then
If bolFindFirst Then
Do While (varArr(lngUB) = varArr(lngUB - 1)) And (Q > lngLB)
lngUB = lngUB - 1
Loop
End If
IsInArray = lngUB
Exit Function
End If
If lngUB - lngLB < 2 Then GoTo NotFound
If (varArr(lngLB) > varValue) Or (varArr(lngUB) < varValue) Then GoTo NotFound
C = 0
Do
Q = (lngUB + lngLB) \ 2
If C = Q Then GoTo NotFound
If varArr(Q) > varValue Then
lngUB = Q
ElseIf varArr(Q) < varValue Then
lngLB = Q
C = lngLB
Else
If bolFindFirst Then
Do While (varArr(Q) = varArr(Q - 1)) And (Q > lngLB)
Q = Q - 1
Loop
End If
IsInArray = Q
Exit Function
End If
Loop
End If
Exit Function
NotFound:
IsInArray = -1
End Function
Un ejemplo:
Option Explicit
Private Const strLine$ = "------------------------------"
Private Sub Form_Load()
Dim L&(60), S(), Q&
For Q = 0 To 60
L(Q) = Q * 2
Next Q
Debug.Print strLine$, Time$, strLine$
Debug.Print IsInArray(L, 15) '---> -1
Debug.Print IsInArray(L, 40) '---> 20
Debug.Print IsInArray(L, 85) '---> -1
Debug.Print IsInArray(L, 100) '---> 50
S = Array("abba", "acero", "karcrack", "sereno", "silencio", "tonto", "tonto", "tonto", "tonto", "zalme")
Debug.Print strLine$
Debug.Print IsInArray(S, "zalme") '---> 9
Debug.Print IsInArray(S, "zalme", , 4) '---> -1
Debug.Print IsInArray(S, "mesa") '---> -1
Debug.Print IsInArray(S, "besos") '---> -1
Debug.Print IsInArray(S, "karcrack") '---> 2
Debug.Print IsInArray(S, "karcrack", 3) '---> -1
Debug.Print IsInArray(S, "tonto") '---> 6
Debug.Print IsInArray(S, "tonto", , , True) '---> 5
End Sub
Retorna:
------------------------------ 18:59:54 ------------------------------
-1
20
-1
50
------------------------------
9
-1
-1
-1
2
-1
6
5
Si necesitamos especial velocidad y lo queremos para un tipo de variable en concreto, sólo hay que modificar un par de cosas. ;)
Aquí un ejemplo para buscar en un array Long, comparado con el código de BlackZer0x ( http://goo.gl/RDQhK ) :
Option Explicit
'// Compilado sin la comprobación de límites en los arrays xP
Private Sub Form_Load()
Dim L&(6000), Q&, t As New CTiming, y&
If App.LogMode = 0 Then End
For Q = 0 To 6000
L(Q) = Q * 2
Next Q
Me.AutoRedraw = True
t.Reset
For Q = 1 To 1000
IsInArray L, 15
IsInArray L, 40
IsInArray L, 2001
IsInArray L, 5020
IsInArray L, 12000
Next Q
Me.Print "IsInArray", , t.sElapsed
t.Reset
For Q = 1 To 1000
ExitsInArrayNR 15, L, y
ExitsInArrayNR 40, L, y
ExitsInArrayNR 2001, L, y
ExitsInArrayNR 5020, L, y
ExitsInArrayNR 12000, L, y
Next Q
Me.Print "ExitsInArrayNR", t.sElapsed
End Sub
'// by Psyke1
Public Static Function IsInArray&(lngArr&(), lngValue&, Optional lngStart&, Optional lngEnd&, Optional bolFindFirst As Boolean)
Dim lngLB&, lngUB&, lngItem&, Q&, C&
lngLB = LBound(lngArr)
lngUB = UBound(lngArr)
If Not IsMissing(lngStart) Then
If (lngStart > lngLB) And (lngStart < lngUB) Then lngLB = lngStart
End If
If Not IsMissing(lngEnd) Then
If (lngEnd > lngLB) And (lngEnd < lngUB) Then lngUB = lngEnd
End If
If lngArr(lngLB) = lngValue Then
IsInArray = lngLB
Exit Function
ElseIf lngArr(lngUB) = lngValue Then
If bolFindFirst Then
Do While (lngArr(lngUB) = lngArr(lngUB - 1)) And (Q > lngLB)
lngUB = lngUB - 1
Loop
End If
IsInArray = lngUB
Exit Function
End If
If lngUB - lngLB < 2 Then GoTo NotFound
If (lngArr(lngLB) > lngValue) Or (lngArr(lngUB) < lngValue) Then GoTo NotFound
C = 0
Do
Q = (lngUB + lngLB) \ 2
If C = Q Then GoTo NotFound
If lngArr(Q) > lngValue Then
lngUB = Q
ElseIf lngArr(Q) < lngValue Then
lngLB = Q
C = lngLB
Else
If bolFindFirst Then
Do While (lngArr(Q) = lngArr(Q - 1)) And (Q > lngLB)
Q = Q - 1
Loop
End If
IsInArray = Q
Exit Function
End If
Loop
Exit Function
NotFound:
IsInArray = -1
End Function
'// by BlackZer0x
Public Function ExitsInArrayNR(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb As Long
Dim lng_Ub As Long
lng_lb = LBound(vBuff&())
lng_Ub = UBound(vBuff&())
If Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
Dim t As Long
t = lng_Ub
lng_Ub = lng_lb
lng_lb = t
End If
Do Until ExitsInArrayNR
Select Case vValue
Case vBuff&(lng_lb&)
p& = lng_lb&
ExitsInArrayNR = True
Case vBuff&(lng_Ub&)
p& = lng_Ub&
ExitsInArrayNR = True
Case Else
p = (lng_lb& + lng_Ub&) / 2
If p <> lng_lb& And p& <> lng_Ub& Then
If vBuff&(p&) < vValue& Then
lng_lb = p
ElseIf vBuff&(p&) > vValue& Then
lng_Ub = p
ElseIf vBuff&(p&) = vValue& Then
ExitsInArrayNR = True
End If
Else
Exit Do
End If
End Select
Loop
End Function
Resultado:
(http://infrangelux.sytes.net/FileX/view.php?InfraFile=/Banana-with-3D-glasses.png)
DoEvents! :P
-
Me gusta...! Buen trabajo Psyke...!
-
che, ahi el numero "1,315" es 1315mS o 1,315mS (digo, porq el uso de la coma y del punto varia en muchos lados)
de todas formas, interesante para buscar datos!
saludos