| |
|
91
|
Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero dado es un numero de la suerte
|
en: 15 Agosto 2010, 07:48 am
|
Yo olvidé de agregar un If a mi code, luego pruebo como dice BlackZeroX , por ahora serà así
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
Private Declare Sub RtlMoveMemory Lib "Kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal length As Long)
Private Declare Function GetTickCount Lib "Kernel32" () As Long
Private Sub Form_Load()
Dim x As Long
Dim s As String
Dim t1 As Long
Dim t2 As Long
If App.LogMode = 0 Then End
Me.AutoRedraw = True
'Dessa
Me.Print "Dessa"
t1 = GetTickCount
For x = 5000 To 7000
If IsLucky(x) Then
s = s & x & " "
End If
Next
t2 = GetTickCount
Me.Print t2 - t1 & vbNewLine
MsgBox s
s = ""
'*PsYkE1*
Me.Print "PsYkE1"
t1 = GetTickCount
For x = 5000 To 7000
If Check_Lucky_Number3(x) Then
s = s & x & " "
End If
Next
t2 = GetTickCount
Me.Print t2 - t1 & vbNewLine
MsgBox s
'LeandroA
Me.Print "LeandroA"
t1 = GetTickCount
For x = 5000 To 7000
If IsLuckyNumber(x) Then
s = s & x & " "
End If
Next
t2 = GetTickCount
Me.Print t2 - t1
MsgBox s
End Sub
'Dessa
Function IsLucky(lngNum As Long) As Boolean
Dim x As Long, cont As Long, contStep As Long, Indice As Long, numLuck() As Long
If lngNum < 1 Then Exit Function
If lngNum Mod 2 = 0 Then Exit Function
If lngNum = 1 Or lngNum = 3 Then IsLucky = True: Exit Function
If lngNum = 5 Then Exit Function
For x = 1 To lngNum Step 2
ReDim Preserve numLuck(contStep)
numLuck(contStep) = x
contStep = contStep + 1
Next
contStep = 0: cont = 0: Indice = 1
While numLuck(Indice) <= UBound(numLuck)
If numLuck(UBound(numLuck)) <> lngNum Then Exit Function
x = -1
While x < UBound(numLuck)
x = x + 1
If cont = numLuck(Indice) - 1 Then
cont = 0
Else
numLuck(contStep) = numLuck(x)
cont = cont + 1
contStep = contStep + 1
End If
Wend
If contStep = numLuck(Indice + 1) Then
ReDim Preserve numLuck(contStep - 2)
Else
ReDim Preserve numLuck(contStep - 1)
End If
cont = 0
contStep = 0
Indice = Indice + 1
Wend
For x = 0 To UBound(numLuck)
If numLuck(x) = lngNum Then
IsLucky = True
Exit For
End If
Next
End Function
'-PsYkE1
Public Function Check_Lucky_Number3(ByVal lNumber As Long) As Boolean
Dim lTempArray() As Long
Dim NextElim As Long
Dim lArrayUBound As Long
Dim m As Long
Dim x As Long
If lNumber = 1 Or lNumber = 3 Then
GoTo IsLucky
ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then
m = 1
For x = 1 To lNumber Step 2
ReDim Preserve lTempArray(m)
lTempArray(m) = x
m = m + 1
Next
NextElim = 3: m = 2
Do
x = NextElim
Do While x <= UBound(lTempArray)
lArrayUBound = UBound(lTempArray)
If Not x = lArrayUBound Then
RtlMoveMemory VarPtr(lTempArray(x)), VarPtr(lTempArray(x + 1)), (lArrayUBound - x) * 4
ReDim Preserve lTempArray(lArrayUBound - 1)
Else
Exit Function
End If
x = x + (NextElim - 1)
Loop
m = m + 1
NextElim = lTempArray(m)
Loop While Not NextElim > lArrayUBound
IsLucky: Check_Lucky_Number3 = True
End If
End Function
'LeandroA
Private Function IsLuckyNumber(ByVal Num As Long) As Boolean
Dim lCount As Long, lPos As Long, i As Long
Dim Arr() As Long
If Num < 1 Then Exit Function
If Num Mod 2 = 0 Then Exit Function
ReDim Preserve Arr(CLng(Num / 2) + (Num Mod 2))
For lPos = 1 To Num Step 2
i = i + 1
Arr(i) = lPos
Next
lCount = 1
Do While UBound(Arr) > lCount
lCount = lCount + 1
lPos = Arr(lCount)
Do
If lPos > UBound(Arr) Then Exit Do
If lPos < UBound(Arr) Then CopyMemory Arr(lPos), Arr(lPos + 1), 4 * (UBound(Arr) - lPos)
ReDim Preserve Arr(UBound(Arr) - 1)
lPos = lPos + Arr(lCount) - 1
Loop
If Arr(UBound(Arr)) <> Num Then Exit Function
Loop
IsLuckyNumber = True
End Function
|
|
|
|
|
92
|
Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero dado es un numero de la suerte
|
en: 14 Agosto 2010, 22:28 pm
|
Pude mejorar en parte a mi primera version, bueno, algo es algo... Tambien me queda pendiente la sugerencia de Psyke.
Option Explicit
Private Declare Function GetTickCount Lib "Kernel32" () As Long
Private Sub Form_Load()
If App.LogMode = 0 Then
MsgBox "Ejecutar Compilado"
End ' perdon por el end
End If
Dim t1 As Long
Dim t2 As Long
Me.AutoRedraw = True
t1 = GetTickCount
Me.Print IsLucky(45235) & " IsLucky"
t2 = GetTickCount
Me.Print t2 - t1
End Sub
Function IsLucky(lngNum As Long) As Boolean
Dim x As Long, cont As Long, contStep As Long, Indice As Long, numLuck() As Long
If lngNum < 1 Then Exit Function
If lngNum Mod 2 = 0 Then Exit Function
If lngNum = 1 Or lngNum = 3 Then IsLucky = True: Exit Function
If lngNum = 5 Then Exit Function
For x = 1 To lngNum Step 2
ReDim Preserve numLuck(contStep)
numLuck(contStep) = x
contStep = contStep + 1
Next
contStep = 0: cont = 0: Indice = 1
While numLuck(Indice) <= UBound(numLuck)
If numLuck(UBound(numLuck)) <> lngNum Then Exit Function
x = -1
While x < UBound(numLuck)
x = x + 1
If cont = numLuck(Indice) - 1 Then
cont = 0
Else
numLuck(contStep) = numLuck(x)
cont = cont + 1
contStep = contStep + 1
End If
Wend
If contStep = numLuck(Indice + 1) Then
ReDim Preserve numLuck(contStep - 2)
Else
ReDim Preserve numLuck(contStep - 1)
End If
cont = 0
contStep = 0
Indice = Indice + 1
Wend
For x = 0 To UBound(numLuck)
If numLuck(x) = lngNum Then
IsLucky = True
Exit For
End If
Next
End Function
|
|
|
|
|
93
|
Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero dado es un numero de la suerte
|
en: 14 Agosto 2010, 01:27 am
|
Si Pyske1 , te entendí pero probé 45235 (compilado), con gettickcount y las dos van parejas... por supuesto que tendría que ser mas rapida con tu sugerencia (sin el último For). intentaré mejorar con RtlMoveMemory  En fín, si alguien quiere hacerme el favor de revisarlo para números arriba del 37 se los agradeceré.
Tokes, el 45 lo da como true y no lo es, tambien entre 1 y 200 hay 8 numeros mas que no son Lucky, saludos |
|
|
|
|
95
|
Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero dado es un numero de la suerte
|
en: 13 Agosto 2010, 06:10 am
|
Bueno, como se dijo, no me impota el tiempo, me conformo con que funcione... espero ...porque la verdad es que me costó un huevo (el izquierdo).  , lo dicho con que funcione está bien para mí.
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Sub Form_Load()
Dim t1 As Long
Dim t2 As Long
t1 = GetTickCount
Me.AutoRedraw = True
Me.Print IsLucky(45235)
t2 = GetTickCount
Me.Print t2 - t1
End Sub
Function IsLucky(lngNum As Long) As Boolean
Dim x As Long, cont As Long, contStep As Long, Indice As Long, numLuck() As String
If lngNum < 1 Then Exit Function
If lngNum Mod 2 = 0 Then Exit Function
If lngNum = 1 Or lngNum = 3 Then IsLucky = True: Exit Function
If lngNum = 5 Then Exit Function
For x = 1 To lngNum Step 2
ReDim Preserve numLuck(contStep)
numLuck(contStep) = x
contStep = contStep + 1
Next
contStep = 0: cont = 0: Indice = 1
While numLuck(Indice) <= UBound(numLuck)
For x = 0 To UBound(numLuck)
If cont = numLuck(Indice) - 1 Then
cont = 0
Else
numLuck(contStep) = numLuck(x)
cont = cont + 1
contStep = contStep + 1
End If
Next
If contStep = numLuck(Indice + 1) Then
ReDim Preserve numLuck(contStep - 2)
Else
ReDim Preserve numLuck(contStep - 1)
End If
cont = 0
contStep = 0
Indice = Indice + 1
Wend
For x = 0 To UBound(numLuck)
If numLuck(x) = lngNum Then
IsLucky = True
Exit For
End If
Next
End Function
|
|
|
|
|
96
|
Programación / Programación Visual Basic / Re: [Ayuda] Necesito saber como resolver este problema
|
en: 10 Agosto 2010, 06:37 am
|
Bueno paso a aclararle las dudas a los que les interesó, es formar un una contraseña sabiendo que es un número de 4 dígitos formado por las cifras del año 2010 por lo cual queda sobreentendido que como bien dijeron algunos no podrá empezar con "0012" o "0021" o similares sino con "1 o 2" para que tenga 4 dígitos, ya que a "01" se considera su parte entera como "1"
Si, lo aclaró nuevamente, pero para el caso es lo mismo, un ejercicio para determinar un passwod tendria que tener un resultado solo , no ? |
|
|
|
|
97
|
Programación / Programación Visual Basic / Re: [Ayuda] Necesito saber como resolver este problema
|
en: 10 Agosto 2010, 06:02 am
|
Para mi hay 2 resultados
Private Sub Form_Load()
Dim x As Variant
Dim m As Double
Dim i As Byte
Dim suma As Byte
For x = 1000 To 2000
If InStr(1, x, "0") > 0 Or InStr(1, x, "1") > 0 Or InStr(1, x, "2") > 0 Then
m = x Mod 11
If m = 0 Then
suma = 0
For i = 1 To Len(x)
suma = suma + Mid(x, i, 1)
Next
If suma = 2 Then MsgBox x
End If
End If
Next
End Sub
|
|
|
|
|
|
| |
|
Mostrar Mensajes