Bucle por tiempo

[Dunkansdk]

Hola a todos quería saber como crear un bucle que tarde X tiempo la ejecución, es decir la duración del mismo

var = 0
Do While var < 255
var = var + 1
Loop
por poner un ejemplo estúpido xd ...

Que de llegar de 1 a 255 tarde 1 segundo (1000ms), por ejemplo... la idea sería no utilizar timers y hacer una función xd ,

Si alguien me puede ayudar, muchas gracias .

[ignorantev1.1]

Código (vb) [Seleccionar] Expandir


private declare sub Sleep lib "kernel32.dll"(byval mms as long)

...
for i=0 to 10
      doevents
    sleep(100) '<---- milisegundos
next


[79137913]

HOLA!!!

Yo lo haria con Doevents y GetTickCount para saber cuanto tiempo vas...

El problema de Sleep es que te congela la pc osea No permite ninguna otra ejecucion simultanea, cosa que doevents si permite 

GRACIAS POR LEER!!!

[Dunkansdk]

HOLA!!!

Yo lo haria con Doevents y GetTickCount para saber cuanto tiempo vas...

El problema de Sleep es que te congela la pc osea No permite ninguna otra ejecucion simultanea, cosa que doevents si permite  

GRACIAS POR LEER!!!

Es justamente lo que tenía en mente pero no me salía, un ejemplo por favor? (A)

de todos modos muchas gracias por responder ignorantev1.1 u.u

[ignorantev1.1]

cierto amigo, se me paso lo de "doevents"  

[79137913]

HOLA!!!

Bueno aca lo tenes, ejecutara el codigo una vez por cada intervalo de tiempo.

Te dejo las 2 maneras que se me ocurrieron: (prefiero la primera)

Código (vb) [Seleccionar] Expandir

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Bucle()
   Dim X As Long
   Dim Milisec As Long 'cantidad de milisegundos por bucle
   Dim Vueltas As Long 'cantidad de vueltas
   Dim Time_Start As Long
   Milisec = 1000
   Vueltas = 10
   Time_Start = GetTickCount()
   For X = 1 To Vueltas
       'Codigo a ejecutar si queres que lo haga apenas empieza el bucle sino lee abajo.
       Do While Time_Start - getticount() < Milisec
           DoEvents
       Loop
       Time_Start = Time_Start + Milisec
       'El codigo a ejecutar si queres que lo haga despues del primer intervalo sino lee arriba.
   Next
End Sub

Código (vb) [Seleccionar] Expandir

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Bucle()
   Dim X As Long
   Dim Flag As Boolean ' Si esta en true Ejecuta el codigo
   Dim Milisec As Long 'cantidad de milisegundos por bucle
   Dim Vueltas As Long 'cantidad de vueltas
   Dim Time_Start As Long
   Milisec = 1000
   Vueltas = 10
   Flag = True ' aca si queres que la primera ejecucion sea cuando pase el primer intervalo quita esta linea
   Time_Start = GetTickCount()
   Do While X <= Vueltas
       DoEvents
       If Flag Then
           'El codigo a ejecutar
           Flag = False
       End If
       If (Time_Start - GetTickCount()) >= Milisec Then
           X = X + 1
           Flag = True
           Time_Start = Time_Start + Milisec
       End If
           
   Wend
End Sub

GRACIAS POR LEER!!!

[raul338]

puedes usar el api settimer con un callback (funcion publica en un modulo). O bien usar el gettickcount(o QueryPerformanceCounter si queres complicarla) con doevents. BlackZeroX tiene una alternativa con PostMessage y PeekMessage

[79137913]

HOLA!!!

Nota: El codigo que escribi puede llegar a tener un minimo desfasaje.

GRACIAS POR LEER!!!

[Dunkansdk]

Muchas gracias a todos !!! lo terminé realizando de esta manera  :

Código (vb) [Seleccionar] Expandir

Private Declare Function SetTimer Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long _
    ) As Long

Private Declare Function KillTimer Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal nIDEvent As Long _
    ) As Long

Private Const m_nIDEvent = 1
Private Const m_uElapse = 20
   
Private Sub Tick()
    If var <> 150 Then
        var = var + 1
    End If
End Sub

Public Sub SetMyTimer(Form As Form)
  Dim retval As Long
    retval = SetTimer(Form.hwnd, m_nIDEvent, m_uElapse, AddressOf Tick)
End Sub

Public Sub KillMyTimer(Form As Form)
  Dim retval As Long
    retval = KillTimer(Form.hwnd, m_nIDEvent)
End Sub

[BlackZeroX]

.
Puedes usar Wait()

Código (Vb) [Seleccionar] Expandir



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



Temibles Lunas!¡.