Mensajes

[VBA.]

.
Hay algo mas facil aun, pero si limpias el registro o limpias el cache de los programas (la verdad no se como se le dice), tus configuraciones se eliminaran.

usa:

Código (Vb) [Seleccionar] Expandir



    VBA.GetAllSettings()
    VBA.DeleteSetting()
    VBA.SaveSetting ()
    VBA.GetSetting ()



P.D.: VBA. es optativo, yo solo lo uso para encontrar funciones que no recuerdo (para mas info oprime F2 en tu IDE de VB6).

Temibles Lunas!¡.

[@BlackZer0x]

@BlackZer0xCreo que te equivocas, lo que hago es comprobar si el resultado es un número exacto o no, de esta manera :

Código (vb) [Seleccionar] Expandir



Option Explicit

Function isFibbonacci(ByVal vVal&) As Boolean
Dim dbl_v#(0 To 1)
Dim byt_i                   As Byte
    If Not vVal& And &H80000000 Then
        dbl_v#(1) = 1
        dbl_v#(0) = 0
        Do Until dbl_v#(byt_i) >= vVal&
            dbl_v#(byt_i) = dbl_v#(byt_i) + dbl_v#(byt_i Xor 1)
            byt_i = byt_i Xor 1
        Loop
        If dbl_v#(0) = vVal& Or dbl_v#(1) = vVal& Then
            isFibbonacci = True
        End If
    End If
End Function

Private Sub Form_Load()
Dim lng_i&
   For lng_i& = -214748 To 2
       If IsFibonacciMrFrog(lng_i&) = True Then
           Debug.Print lng_i&,
       End If
       If isFibbonacci(lng_i&) = True Then
           Debug.Print lng_i&
       End If
   Next lng_i&
End Sub

Public Static Function IsFibonacciMrFrog(ByVal lngNumber As Long) As Boolean
Dim dblRaised                                       As Double
Dim dblSum                                          As Double
Dim dblSqr                                          As Double

   dblRaised = lngNumber * lngNumber
   dblSum = dblRaised + dblRaised + dblRaised + dblRaised + dblRaised + &H4
   dblSqr = Sqr(dblSum)
   IsFibonacciMrFrog = (dblSqr - Int(dblSqr) = &H0)
   If IsFibonacciMrFrog Then Exit Function
   dblSum = dblSum - &H8
   dblSqr = Sqr(dblSum)
   IsFibonacciMrFrog = (dblSqr - Int(dblSqr) = &H0)
End Function



Creer no es bueno:
Usa clng() en lugar de int(), ( en vb6: int = 2 bytes, Double = 8 bytes, long = 4 bytes. ¿cual crees que abarca una cantidad mayor? )

los numeros superan a int().

Estos valores los calcule del 0 al 2147483647 (MAXIMO Numero en Long))

Código [Seleccionar] Expandir



0
1
2
3
5
8
13
21
34
55
89
144
233
377
610
987
1597
2584
4181
6765
10946
17711
28657
46368
75025
121393
196418
317811
514229
832040
1346269
2178309
3524578
5702887
9227465
14930352
24157817
39088169
63245986
102334155
165580141
267914296
433494437
701408733
1134903170
1836311903



Dulces lunas!¡.

[@Mr. Frogs]

.
@Mr. Frogs

Tu funcion tiene Horrores de logica básica ( Conversion de un Double a un Integer ).

Aquí la mía (Aplicando algo que dijo seba123neo pero en la forma mas practica posible para el ahorro de memoria) :

Código (Vb) [Seleccionar] Expandir



Option Explicit

Function isFibbonacci(ByVal vVal&) As Boolean
Dim dbl_v#(0 To 1)
Dim byt_i                   As Byte
    If Not vVal& And &H80000000 Then
        dbl_v#(1) = 1
        dbl_v#(0) = 0
        Do Until dbl_v#(byt_i) >= vVal&
            dbl_v#(byt_i) = dbl_v#(byt_i) + dbl_v#(byt_i Xor 1)
            byt_i = byt_i Xor 1
        Loop
        If dbl_v#(0) = vVal& Or dbl_v#(1) = vVal& Then
            isFibbonacci = True
        End If
    End If
End Function

Private Sub Form_Load()
Dim lng_i&
   For lng_i& = -214748 To 2147483647
       If isFibbonacci(lng_i&) = True Then
           Debug.Print lng_i&
       End If
   Next lng_i&
End Sub



Código [Seleccionar] Expandir



0
1
2
3
5
8
13
21
34
55
89
144
233
377
610
987
1597
2584
4181
6765
10946
17711
28657
46368
75025
121393
196418
317811
514229
832040
1346269
2178309
3524578
5702887
9227465
14930352
24157817
39088169
63245986
102334155
165580141
267914296
433494437
701408733
1134903170
1836311903



P.D.: DarkMatrix tu juego aun esta Online, cual es la pagina?

Temibles Lunas!¡.

[Wait()]

.
Puedes usar Wait()

Código (Vb) [Seleccionar] Expandir



do
    msgbox "Hola Mundo"
    Wait segundos, 10, false
loop



Temibles Lunas!¡.

.
Hago la ultima ediciona  mi codigo, ayq ue cuando quite el While Wend no quite algunas cosas.

Código (vb) [Seleccionar] Expandir



'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Código siempre y cuando         //
' // no se eliminen los créditos originales de este código      //
' // No importando que sea modificado/editado o engrandecido    //
' // o achicado, si es en base a este código                    //
' ////////////////////////////////////////////////////////////////
' // http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=17:artgetpatchinfo&catid=2:catprocmanager&Itemid=8
' ////////////////////////////////////////////////////////////////

Option Explicit
Enum GetFileStr
    Extensión = 1
    FileName = 2
    Ruta = 4
End Enum
Public Function GetPatchInfo(ByVal StrRutaFull As String, Optional ByVal Options As GetFileStr = FileName) As String
Dim lng_ptr(1)              As Long
Dim lng_aux                 As Long
    lng_aux = Len(StrRutaFull)
    lng_ptr(0) = InStrRev(StrRutaFull, "\")
    If lng_ptr(0) > 0 Then
        lng_ptr(1) = InStrRev(StrRutaFull, ".")
        If lng_ptr(1) > 0 And Not lng_ptr(0) < lng_ptr(1) Then
            lng_ptr(1) = lng_aux + 1
        End If
        If (Options And Ruta) = Ruta Then
            GetPatchInfo = Mid$(StrRutaFull, 1, lng_ptr(0)) & GetPatchInfo
        End If
        If (Options And FileName) = FileName Then
            If lng_ptr(1) = lng_aux Then
                lng_aux = lng_aux - lng_ptr(0) - 1
            Else
                lng_aux = lng_ptr(1) - lng_ptr(0) - 1
            End If
            GetPatchInfo = GetPatchInfo & Mid$(StrRutaFull, lng_ptr(0) + 1, lng_aux)
        End If
        If (Options And Extensión) = Extensión Then
            GetPatchInfo = GetPatchInfo & Mid$(StrRutaFull, lng_ptr(1), lng_ptr(1))
        End If
    End If
End Function

Public Function Reto_GetPatchInfo$(ByRef StrPath$)
    ' // Esta funcion la agrego para el reto en cuestion...
    Reto_GetPatchInfo = GetPatchInfo(StrPath$, FileName Or Extensión)
End Function



Temibles Lunas!¡.

Supongo que si, has de tener en cuenta que las clases tienen una estructura bastante compleja que el CallByNameEx ha de recorrer cada vez... tal vez podrías hacer algo para restar el tiempo que le cuesta al CBNEx encontrar la funcion...

GetProcAdress()... y las demás APIS que no recuerdo xP.

Dulces Lunas!¡.

[GetPathInfo]

.
Le hice una pequeña modificación a mi función GetPathInfo para que los parametros sean usados con el operador Or.

No será la más rápida pero si la más dinamica  .

Código (vb) [Seleccionar] Expandir



'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Código siempre y cuando         //
' // no se eliminen los créditos originales de este código      //
' // No importando que sea modificado/editado o engrandecido    //
' // o achicado, si es en base a este código                    //
' ////////////////////////////////////////////////////////////////
' // http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=17:artgetpatchinfo&catid=2:catprocmanager&Itemid=8
' ////////////////////////////////////////////////////////////////

Option Explicit
Enum GetFileStr
    Extensión = 1
    FileName = 2
    Ruta = 4
End Enum
Public Function GetPatchInfo(ByVal StrRutaFull As String, Optional ByVal Options As GetFileStr = FileName) As String
Dim lng_ptr(1)              As Long
Dim lng_aux                 As Long
    lng_aux = Len(StrRutaFull)
    lng_ptr(0) = InStrRev(StrRutaFull, "\")
    If lng_ptr(0) > 0 Then
        lng_ptr(1) = InStrRev(StrRutaFull, ".")
        If lng_ptr(1) > 0 And Not lng_ptr(0) < lng_ptr(1) Then
            lng_ptr(1) = lng_aux + 1
        End If
        If (Options And Ruta) = Ruta Then
            GetPatchInfo = Mid$(StrRutaFull, 1, lng_ptr(0)) & GetPatchInfo
        End If
        If (Options And FileName) = FileName Then
            If lng_ptr(1) = lng_aux Then
                lng_aux = lng_aux - lng_ptr(0) - 1
            Else
                lng_aux = lng_ptr(1) - lng_ptr(0) - 1
            End If
            GetPatchInfo = GetPatchInfo & Mid$(StrRutaFull, lng_ptr(0) + 1, lng_aux)
        End If
        If (Options And Extensión) = Extensión Then
            GetPatchInfo = GetPatchInfo & Mid$(StrRutaFull, lng_ptr(1), lng_ptr(1))
        End If
    End If
End Function



Temibles Lunas!¡.

[cFrogContest.cls]

Pd: Me alegra ver que usais mi clase

mmm, no habia casi ninguna publicacion en el hilo q no lo mensionaras...

Quien sea más rápido, gana.
Se testeará con cFrogContest.cls

@ignorantev1.1
http://foro.elhacker.net/programacion_visual_basic/src_cfrogcontestcls_by_mr_frog_copy-t318871.0.html

@Seba123neo
Jajajaj hice la clase precisamente para ahorrarte el trabajo!

P.D.: mi funcion no figuro en la prueba... jaja las limitaciones de una clase que hacen discriminar a otras, pero bueno ni que.

Dulces Lunas!¡.

.

Otra forma...

Código (vb) [Seleccionar] Expandir



Option Explicit

Private Sub Form_Load()
Dim v$()
Dim int_i%
    For int_i% = 0 To GetArgs(InputBox("", "", ""), v$())
        Debug.Print v$(int_i%)
    Next
End Sub

Public Function GetArgs(ByRef cmd$, ByRef Args$()) As Integer
Dim lng_ptr&(2)
Dim lng_str&
Dim lng_i&
Dim byt_asc As Byte
   
    lng_str& = Len(cmd$)
    GetArgs% = -1
   
    For lng_i& = 1 To lng_str&
   
        lng_ptr&(0) = InStr(lng_i&, cmd$, Chr(32), vbBinaryCompare)
        lng_ptr&(1) = InStr(lng_i&, cmd$, Chr(34), vbBinaryCompare)
       
        If Not lng_ptr&(0) + 1 = lng_ptr&(1) Then
            If lng_ptr&(0) < lng_ptr&(1) Or lng_ptr&(1) = 0 And Not lng_ptr&(0) = 0 Then
                lng_i& = lng_ptr&(0) + 1
                byt_asc = 32
            ElseIf lng_ptr&(1) < lng_ptr&(0) Or lng_ptr&(0) = 0 And Not lng_ptr&(1) = 0 Then
                lng_i& = lng_ptr&(1) + 1
                byt_asc = 34
            Else
                Exit For
            End If
           
            lng_ptr(2) = InStr(lng_i&, cmd$, Chr(byt_asc), vbBinaryCompare)
           
            If Not lng_ptr(2) = lng_i& - 1 Then
                GetArgs% = GetArgs% + 1
                ReDim Preserve Args(0 To GetArgs%)
               
                If lng_ptr(2) > lng_i& Then
                    Args$(GetArgs%) = Mid$(cmd$, lng_i&, lng_ptr&(2) - lng_i&)
                    If byt_asc = 32 Then lng_ptr&(2) = lng_ptr&(2) - 1
                    lng_i& = lng_ptr&(2)
                Else
                    Args$(GetArgs%) = Mid$(cmd$, lng_i&)
                    Exit For
                End If
            End If
        End If
    Next
   
End Function



Ducles Lunas!¡.

[@BlackZeroX]

@BlackZeroX

Tu funcion tiene mas vueltas que una calecita 

PD: Aguante el topo yiyo 

1) No tiene tantas vueltas. aun que el resultado es seguro xP ( Puse algunas cadenas Extras y muchas de ellas si las pruebo con las funciones que se publicaron aquí crashean a excepción de las API que en mi forma de ver deberian excluirse del reto pero bueno ).
2) Yeah.

Dulces Lunas!¡.