Как запустить sub определенное количество раз в секунду до запуска = false?

Question

Я использую визуальный базовый язык, так как вскоре изучу его в колледже, и мне было интересно, как я могу запустить sub определенное количество раз в секунду, я попытался использовать Do Loop во время вызова функции внутри Loop

Do 
    GameLoop() 
Loop Until running = false 

Я также попытался с помощью цикла WHILE, любая помощь будет большой: D

Answer 1

Если получать петлю в сотые секунды является приемлемым, то следующим будет работать.

Dim Start As Variant 
Do 
    Start = Timer 

    GameLoop 

    Do While (Timer - Start < 0.01) 
    DoEvents 
    Loop 
Loop Until running = False 

Если больше точности необходимо затем заменить таймер с: How to get time elapsed in milliseconds

Если GameLoop слишком медленно, то он будет работать на полной скорости; в противном случае он будет работать с желаемыми циклами в секунду.

DoEvents можно было бы удалить, если это не было необходимо, или вам не понравится, что это побочные эффекты события.

Примечания это VB6 код, для VB.Net проверки таймера миллисекунды из: How do you get the current time in milliseconds (long), in VB.Net?

Answer 2

Места другого цикла внутри цикла.

В этом внутреннем цикле вы ждете оставшегося времени, и если вы не останетесь, вы продолжите.

Я использовал API GetTickCount для этого, который использует миллисекунды в качестве входных данных Althought его точность зависит от разрешающей способности тактовой

Option Explicit 

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

Private mblnRun As Boolean 

Private Sub Command1_Click() 
    StartLoop 
End Sub 

Private Sub Command2_Click() 
    StopLoop 
End Sub 

Private Sub StartLoop() 
    Dim lngStart As Long 
    mblnRun = True 
    Do While mblnRun 
    'store start time 
    lngStart = GetTickCount 
    'do your actions 
    DoSomething 
    'wait for the remaining time 
    Do While GetTickCount < lngStart + 2000 
     'wait until 2 seconds are passed since the start of this loop cycle 
     DoEvents 
    Loop 
    Loop 
End Sub 

Private Sub StopLoop() 
    mblnRun = False 
    Caption = "Stopped : " & CStr(Now) 
End Sub 

Private Sub DoSomething() 
    Caption = "Running : " & CStr(Now) 
End Sub 

До тех пор, как mblnRun это True цикл продолжает работать