|
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
|
|
|
|
|
|
|