Results 1 to 29 of 29

Thread: VB6 Sleep Function

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Jan 2008
    Posts
    29

    VB6 Sleep Function

    The sleep function for my VB6 doesn't work, it just freezes up the application. Can anyone give me a sleep function that won't freeze up the application?

  2. #2
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 Sleep Function

    How about the API?
    In your delcarations section add this
    Code:
    Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
    To use it
    Code:
     Sleep 1000 ' to sleep for 1 second
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  3. #3

    Thread Starter
    Junior Member
    Join Date
    Jan 2008
    Posts
    29

    Re: VB6 Sleep Function

    Quote Originally Posted by LaVolpe
    How about the API?
    In your delcarations section add this
    Code:
    Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
    To use it
    Code:
     Sleep 1000 ' to sleep for 1 second
    Yeah, I was talking about that code, the only problem I have after that is that it doesn't seem to want to do all the codes after that sleep function

  4. #4
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 Sleep Function

    Then something else is happening. Sleep only pauses your code then the next lines continue on. You may want to be more specific and post some relevant code that we can look at.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  5. #5
    PowerPoster CDRIVE's Avatar
    Join Date
    Jul 2007
    Posts
    2,620

    Re: VB6 Sleep Function

    Quote Originally Posted by Derkel
    The sleep function for my VB6 doesn't work, it just freezes up the application. Can anyone give me a sleep function that won't freeze up the application?
    That's because the Sleep API freezes all events and the next line of code in your app until the Sleep period has expired. By it self I find it nearly useless. My favorite sub incorporates the Sleep API (in 2mS increments) and some additional code to create the Pause sub. Just use Pause (Sec or fraction of a second) where you would use Sleep.
    Code:
    Option Explicit
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    
    ' Credits: (Milk (Sleep+Pause Sub)). (Wayne Spangler (Pause Sub))
    Private Sub Pause(ByVal Delay As Single)
       Delay = Timer + Delay
       If Delay > 86400 Then 'more than number of seconds in a day
          Delay = Delay - 86400
          Do
              DoEvents ' to process events.
              Sleep 1 ' to not eat cpu
          Loop Until Timer < 1
       End If
       Do
           DoEvents ' to process events.
           Sleep 1 ' to not eat cpu
       Loop While Delay > Timer
    End Sub
    <--- Did someone help you? Please rate their post. The little green squares make us feel really smart!
    If topic has been resolved, please pull down the Thread Tools & mark it Resolved.


    Is VB consuming your life, and is that a bad thing??

  6. #6
    Head Hunted anhn's Avatar
    Join Date
    Aug 2007
    Location
    Australia
    Posts
    3,669

    Re: VB6 Sleep Function

    CDRIVE, That looks good to overcome the situation when pass midnight, however that has some minor problems:
    1. As Timer() never reaches 86400, if Delay = 86400 (rare) then only the second Do...Loop runs 1 round: approx only 1 millisecond delay.
      So, instead of If Delay > 86400 Then , that should be If Delay >= 86400 Then
    2. Delay may be greater than multiple of 86400, such as Delay = 259210 (=3*86400+10), then after Delay = Delay - 86400 you still have Delay > 86400.

    Below is my Pause() function, it uses only one Do...Loop.
    As Timer() is only updated every 1/64 sec = 15.625 millisecs, you can give the loop sleep a bit longer before checking Timer() vs TimeOut.
    If higher-resolution timing is required then Timer() is not good enough, perhaps we have to use something else such as QueryPerformanceCounter()
    Code:
    Option Explicit
    
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    
    Public Sub Pause(SecsDelay As Single)
       Dim TimeOut   As Single
       Dim PrevTimer As Single
       
       PrevTimer = Timer
       TimeOut = PrevTimer + SecsDelay
       Do While PrevTimer < TimeOut
          Sleep 4 '-- Timer is only updated every 1/64 sec = 15.625 millisecs.
          DoEvents
          If Timer < PrevTimer Then TimeOut = TimeOut - 86400 '-- pass midnight
          PrevTimer = Timer
       Loop
    End Sub
    • Don't forget to use [CODE]your code here[/CODE] when posting code
    • If your question was answered please use Thread Tools to mark your thread [RESOLVED]
    • Don't forget to RATE helpful posts

    • Baby Steps a guided tour
    • IsDigits() and IsNumber() functions • Wichmann-Hill Random() function • >> and << functions for VB • CopyFileByChunk

  7. #7
    PowerPoster CDRIVE's Avatar
    Join Date
    Jul 2007
    Posts
    2,620

    Re: VB6 Sleep Function

    Quote Originally Posted by LaVolpe
    Then something else is happening. Sleep only pauses your code then the next lines continue on. You may want to be more specific and post some relevant code that we can look at.
    Ah, I thought the TS was referring to what's happening, or not happing, in other events during the Sleep interval.
    <--- Did someone help you? Please rate their post. The little green squares make us feel really smart!
    If topic has been resolved, please pull down the Thread Tools & mark it Resolved.


    Is VB consuming your life, and is that a bad thing??

  8. #8
    PowerPoster CDRIVE's Avatar
    Join Date
    Jul 2007
    Posts
    2,620

    Re: VB6 Sleep Function

    Quote Originally Posted by anhn
    CDRIVE, That looks good to overcome the situation when pass midnight, however that has some minor problems:
    [LIST=1][*]As Timer() never reaches 86400, if Delay = 86400 (rare) then only the second Do...Loop runs 1 round: approx only 1 millisecond delay.
    Anhn, thanks for pointing that out. Even though I can't imagine a delay >86400 it's still worth mentioning.
    <--- Did someone help you? Please rate their post. The little green squares make us feel really smart!
    If topic has been resolved, please pull down the Thread Tools & mark it Resolved.


    Is VB consuming your life, and is that a bad thing??

  9. #9
    New Member
    Join Date
    Apr 2008
    Posts
    6

    Re: VB6 Sleep Function

    Many thanks to LaVolpe for this posting of a sleep function. I needed a way to add a pause to a standard code module and the API call is exactly what the doctor ordered.

  10. #10
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: VB6 Sleep Function

    The problem with DoEvents is that cause the Vb5/6 runtime to run any other event. Vb6 have re-entrance in event subroutine, so a pause in any of these subroutines or subroutines in a "bas" module, that we call from event subroutines, can't guarantee that a pause has a meaning of a pause.
    So we have to break the re-entrance. I use a static variable once:
    Sub That_Event()
    static once as boolean
    if once then exit sub
    once=true
    ' our code here
    once=false
    exit sub

    We can use a public "donothing" as boolean, so if it is true no event subroutine can do anything...until our pause end.

  11. #11
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,268

    Re: VB6 Sleep Function

    Deleted
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  12. #12
    Wall Poster TysonLPrice's Avatar
    Join Date
    Sep 2002
    Location
    Columbus, Ohio
    Posts
    3,854

    Re: VB6 Sleep Function

    Just playing around and saw all the answers. Just throwing this out:

    Code:
    Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
    Private Sub Command1_Click()
        Dim iTestIt As Integer
        iTestIt = 1
        Dim i As Integer
        
        For i = 1 To 10
            Text1.Text = iTestIt
            Text1.Refresh
            Sleep 1000
            iTestIt = iTestIt + 1
        Next i
    
    End Sub
    Please remember next time...elections matter!

  13. #13
    The Idiot
    Join Date
    Dec 2014
    Posts
    2,755

    Re: VB6 Sleep Function

    the vb.timer is quite nice, as it will not freeze the form.
    it all depends what u need it for and what kind of state u want the form to have while "processing" whatever you are doing.

    before working with game-loops, i used the vb.timer.
    its easy to make the timer do "operations", recursively, example:

    Code:
    Dim operation as integer
    Dim funpr1 as integer
    
    Private Sub doOperation(ByVal Op&)
        ' something '
    End Sub
    
    Private Sub function1()
        funpr1 = funpr1 + 1
        doOperation funpr1
        If funpr1 = 10 Then operation = 0
    End Sub
    
    Private Sub Timer1_Timer()
        Select Case operation
            Case 0: ' nothing '
            Case 1: function1
            Case 2: function2
            Case 3: function3
        End Select
    End Sub
    using sleep it will freeze the form and the functions, halting your program.
    better to avoid using sleep if possible.

  14. #14
    Software Carpenter dee-u's Avatar
    Join Date
    Feb 2005
    Location
    Pinas
    Posts
    11,123

    Re: VB6 Sleep Function

    This thread has been started more than a decade ago!
    Regards,


    As a gesture of gratitude please consider rating helpful posts. c",)

    Some stuffs: Mouse Hotkey | Compress file using SQL Server! | WPF - Rounded Combobox | WPF - Notify Icon and Balloon | NetVerser - a WPF chatting system

  15. #15
    Super Moderator Shaggy Hiker's Avatar
    Join Date
    Aug 2002
    Location
    Idaho
    Posts
    39,222

    Re: VB6 Sleep Function

    It started, went dormant for six years, revived for a brief time, went dormant for another five years....see y'all back here again around 2024 or 2025.
    My usual boring signature: Nothing

  16. #16
    Wall Poster TysonLPrice's Avatar
    Join Date
    Sep 2002
    Location
    Columbus, Ohio
    Posts
    3,854

    Re: VB6 Sleep Function

    Quote Originally Posted by dee-u View Post
    This thread has been started more than a decade ago!
    Did you not see the post title...it obviously worked
    Please remember next time...elections matter!

  17. #17
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,298

    Re: VB6 Sleep Function

    Quote Originally Posted by Shaggy Hiker View Post
    It started, went dormant for six years, revived for a brief time, went dormant for another five years....see y'all back here again around 2024 or 2025.
    Someone has to reduce the value they are passing to the Sleep API in this thread to resemble a form of sane communication :-))

    cheers,
    </wqw>

  18. #18
    Super Moderator Shaggy Hiker's Avatar
    Join Date
    Aug 2002
    Location
    Idaho
    Posts
    39,222

    Re: VB6 Sleep Function

    Yeah, that may be it.
    My usual boring signature: Nothing

  19. #19
    Registered User
    Join Date
    May 2024
    Posts
    2

    Re: VB6 Sleep Function

    Quote Originally Posted by Shaggy Hiker View Post
    ...see y'all back here again around 2024 or 2025.
    You're not going to believe this...but I was just looking for how to do this. I had completely forgotten how I added pauses to VB6 code.

  20. #20
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,955

    Re: VB6 Sleep Function

    Accuracy 100 nanoseconds, accurate to 0.0001 millisecond

    Code:
    Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long '???????
    
     Declare Function CreateWaitableTimerW Lib "kernel32.dll" (Optional ByVal lpTimerAttributes As Long, Optional ByVal bManualReset As Long, Optional ByVal lpTimerName As Long) As Long
     Declare Function SetWaitableTimer Lib "kernel32.dll" (ByVal hTimer As Long, ByRef pDueTime As Currency, Optional ByVal lPeriod As Long, Optional ByVal pfnCompletionRoutine As Long, Optional ByVal lpArgToCompletionRoutine As Long, Optional ByVal fResume As Long) As Long
     Declare Function MsgWaitForMultipleObjects Lib "user32.dll" (ByVal nCount As Long, ByRef pHandles As Long, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long
     Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
     Public Const INFINITE As Long = -1&, QS_ALLINPUT As Long = &H4FF&
    
    Sub Puase(ByVal Milliseconds As Currency)
        Dim hTimer As Long
        hTimer = CreateWaitableTimerW
        Call SetWaitableTimer(hTimer, CCur(-Milliseconds))
        Do While MsgWaitForMultipleObjects(1&, hTimer, 0&, INFINITE, QS_ALLINPUT)
            DoEvents
        Loop
         CloseHandle hTimer
    End Sub
    Code:
    Private Sub Form_Load()
     
    timeBeginPeriod 1
    
    End Sub
    
    Private Sub Command1_Click()
    
    Puase 1000
    
    End Sub
    Last edited by xiaoyao; May 26th, 2024 at 05:35 AM.

  21. #21
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,955

    Re: VB6 Sleep Function

    Code:
    while(true)
    
                 {
    #029         if (WaitForSingleObject(hTimer, INFINITE) != WAIT_OBJECT_0)
    #030         {
    #031               OutputDebugString(_T("ERR"));   
    #032               //
    #033               CloseHandle(hTimer);
    #034               return 3;
    #035         }
    #036         else
    #037         {
    #038              
    
                            SetWaitableTimer(hTimer, &liDueTime, 0, NULL, NULL, 0);//Reset the hTimer message to no signal, otherwise the output will continue
    #039               OutputDebugString(_T("timer events"));            
    #040         } 
    #041    }
    #042         //
    #043         CloseHandle(hTimer);
    #044         return 0;
    how to do timer event without SetWaitableTimer(hTimer, &liDueTime, 0, NULL, NULL, 0);?

    like
    Code:
    Ret = SetWaitableTimer(hTimer, CCur(-0.0001),-10000)
    dim id as long
    
           Do
                ' Wait for timer signal or input message
                Select Case MsgWaitForMultipleObjects(1, hTimer, False, INFINITE, QS_ALLINPUT)
                    
                    Case WAIT_OBJECT_0:
                          Debug.Print "time event"
                          id=id+1
                          if id>100 then exit do
                    Case WAIT_OBJECT_0 + 1:
                        
                        DoEvents
                End Select
     
            Loop
    I want the third parameter to specify that an event is generated every 100 nanoseconds, or that a timer event is repeated every 1 second
    But there's something wrong with this code

  22. #22
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,955

    Re: VB6 Sleep Function

    Code:
    Will produce a timer error accumulation, 10 times delay of 1 second, the final error reached about 6 milliseconds
    Cumulative time: 10005.4726 ms
    1, time: 999.5706 milliseconds
    2, time: 1001.004 milliseconds
    3, time: 999.9972 milliseconds
    4, time: 1000.9968 milliseconds
    5, time: 1001.0024 milliseconds
    6, time: 1000.0044 milliseconds
    7, time: 1000.0083 milliseconds
    8, time: 1000.9891 milliseconds
    9, time: 1000.9963 milliseconds
    10, time: 1000.9035 milliseconds
    Code:
    Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
    End Type
    
    Private Const WAIT_ABANDONED& = &H80&
    Private Const WAIT_ABANDONED_0& = &H80&
    Private Const WAIT_FAILED& = -1&
    Private Const WAIT_IO_COMPLETION& = &HC0&
    Private Const WAIT_OBJECT_0& = 0
    Private Const WAIT_OBJECT_1& = 1
    Private Const WAIT_TIMEOUT& = &H102&
    Private Const INFINITE = &HFFFF
    Private Const QS_HOTKEY& = &H80
    Private Const QS_KEY& = &H1
    Private Const QS_MOUSEBUTTON& = &H4
    Private Const QS_MOUSEMOVE& = &H2
    Private Const QS_PAINT& = &H20
    Private Const QS_POSTMESSAGE& = &H8
    Private Const QS_SENDMESSAGE& = &H40
    Private Const QS_TIMER& = &H10
    Private Const ERROR_ALREADY_EXISTS = 183&
    Private Const QS_MOUSE& = (QS_MOUSEMOVE Or QS_MOUSEBUTTON)
    Private Const QS_INPUT& = (QS_MOUSE Or QS_KEY)
    Private Const QS_ALLEVENTS& = (QS_INPUT Or QS_POSTMESSAGE Or QS_TIMER Or QS_PAINT Or QS_HOTKEY)
    Private Const QS_ALLINPUT& = (QS_SENDMESSAGE Or QS_PAINT Or QS_TIMER Or QS_POSTMESSAGE Or QS_MOUSEBUTTON Or QS_MOUSEMOVE Or QS_HOTKEY Or QS_KEY)
    
    Private Const UNITS = 4294967296#
    Private Const MAX_LONG = -2147483648#
    
    Private Declare Function CreateWaitableTimer _
                    Lib "kernel32" _
                    Alias "CreateWaitableTimerA" (ByVal lpSemaphoreAttributes As Long, _
                                                  ByVal bManualReset As Long, _
                                                  ByVal lpName As String) As Long
    Private Declare Function OpenWaitableTimer _
                    Lib "kernel32" _
                    Alias "OpenWaitableTimerA" (ByVal dwDesiredAccess As Long, _
                                                ByVal bInheritHandle As Long, _
                                                ByVal lpName As String) As Long
    Private Declare Function SetWaitableTimer _
                    Lib "kernel32" (ByVal hTimer As Long, _
                                    lpDueTime As FILETIME, _
                                    ByVal lPeriod As Long, _
                                    ByVal pfnCompletionRoutine As Long, _
                                    ByVal lpArgToCompletionRoutine As Long, _
                                    ByVal fResume As Long) As Long
    Private Declare Function CancelWaitableTimer Lib "kernel32" (ByVal hTimer As Long)
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function WaitForSingleObject _
                    Lib "kernel32" (ByVal hHandle As Long, _
                                    ByVal dwMilliseconds As Long) As Long
    Private Declare Function MsgWaitForMultipleObjects _
                    Lib "user32" (ByVal nCount As Long, _
                                  pHandles As Long, _
                                  ByVal fWaitAll As Long, _
                                  ByVal dwMilliseconds As Long, _
                                  ByVal dwWakeMask As Long) As Long
    
    Private mlTimer As Long
    Sub StartTimer4()
        Randomize
        mlTimer = CreateWaitableTimer(0, True, App.EXEName & "Timer" & Format$(Now(), "NNSS") & Int(Rnd * 10000))
         If Err.LastDllError = ERROR_ALREADY_EXISTS Then
         MsgBox "TIMER ERR"
         End If
    End Sub
    Sub CloseTimer4()
    
        On Error Resume Next
    
        If mlTimer <> 0 Then CloseHandle mlTimer
    End Sub
    
    Public Sub WaitCounts(MilliSeconds As Currency, Counts As Long)
        On Error GoTo ErrHandler
        Dim ft          As FILETIME
        Dim lBusy       As Long
        Dim lRet        As Long
        Dim dblDelay    As Double
        Dim dblDelayLow As Double
        
    
        
     
            ft.dwLowDateTime = -1
            ft.dwHighDateTime = -1
            lRet = SetWaitableTimer(mlTimer, ft, 0, 0, 0, 0)
     
        'CDbl
        dblDelay = CCur(MilliSeconds) * 10000#
        
        ft.dwHighDateTime = -CLng(dblDelay / UNITS) - 1
        dblDelayLow = -UNITS * (dblDelay / UNITS - Fix(CStr(dblDelay / UNITS)))
        
        If dblDelayLow < MAX_LONG Then dblDelayLow = UNITS + dblDelayLow
        
        ft.dwLowDateTime = CLng(dblDelayLow)
        Dim ID As Long
        Dim UsedC() As Currency, StartC As Currency
        ReDim UsedC(0 To Counts)
        QueryPerformanceCounter CPUv1
        StartC = CPUv1
        lRet = SetWaitableTimer(mlTimer, ft, 0, 0, 0, False)
        
        Do While True
            lBusy = MsgWaitForMultipleObjects(1, mlTimer, False, INFINITE, QS_ALLINPUT&)
            If lBusy = WAIT_OBJECT_0 Then
                ID = ID + 1
                  QueryPerformanceCounter CPUv2
               
                 UsedC(ID) = CPUv2 
                If ID = Counts Then Exit Do
                 'QueryPerformanceCounter CPUv1
                 CPUv1 = CPUv2
                SetWaitableTimer mlTimer, ft, 0, 0, 0, False
            Else
            DoEvents
            End If
          
        Loop
        
    '    CloseHandle mlTimer
    '    mlTimer = 0
    Dim i As Long
    UsedC(0) = StartC
    
    Debug.Print "All UsedTime?" & (CPUv2 - StartC) / MsCount & "ms"
    For i = 1 To 10
        Debug.Print i & ",Used?" & (UsedC(i) - UsedC(i - 1)) / MsCount & "ms"
    Next
        Exit Sub
        
    ErrHandler:
        Err.Raise Err.Number, Err.Source, "[clsWaitableTimer.Wait]" & Err.Description
    End Sub
    Code:
    Private Sub Form_Load()
    timeBeginPeriod 1
     
    
    StartTimer4
    End Sub
    
    Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    CloseTimer4
    End Sub

  23. #23
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,955

    Re: VB6 Sleep Function

    The timer interval is 1 second, each time the timer is triggered, modify the delay milliseconds, correct the error (such as delay 995 milliseconds, delay 1002 milliseconds), the final 100 times, 1000 times of the timer triggered, (unlimited number of runs) the cumulative error is only about 1 millisecond.

    All UsedTime?20000.0194ms
    1,Used?2000.0174ms
    2,Used?2000.0064ms
    3,Used?2001.0059ms
    4,Used?1998.9939ms
    5,Used?2000.9611ms
    6,Used?1999.9619ms
    7,Used?1999.0738ms
    8,Used?2000.0403ms
    9,Used?1999.9592ms
    10,Used?1999.9995ms

    Code:
    Public Sub WaitCounts(MilliSeconds As Currency, Counts As Long)
        On Error GoTo ErrHandler
        Dim ft          As FILETIME
        Dim lBusy       As Long
        Dim lRet        As Long
        Dim dblDelay    As Double
        Dim dblDelayLow As Double
        
    
        
     
            ft.dwLowDateTime = -1
            ft.dwHighDateTime = -1
            lRet = SetWaitableTimer(mlTimer, ft, 0, 0, 0, 0)
     
        'CDbl
        dblDelay = CCur(MilliSeconds) * 10000#
        ft.dwHighDateTime = -CLng(dblDelay / UNITS) - 1
        dblDelayLow = -UNITS * (dblDelay / UNITS - Fix(CStr(dblDelay / UNITS)))
        If dblDelayLow < MAX_LONG Then dblDelayLow = UNITS + dblDelayLow
        ft.dwLowDateTime = CLng(dblDelayLow)
        
        Dim ID As Long
        Dim UsedC() As Currency, StartC As Currency
        ReDim UsedC(0 To Counts)
        QueryPerformanceCounter CPUv1
        StartC = CPUv1
        UsedC(0) = StartC
        lRet = SetWaitableTimer(mlTimer, ft, 0, 0, 0, False)
        
        Do While True
            lBusy = MsgWaitForMultipleObjects(1, mlTimer, False, INFINITE, QS_ALLINPUT&)
            If lBusy = WAIT_OBJECT_0 Then
                  ID = ID + 1
                  QueryPerformanceCounter CPUv2
                 'Debug.Print ID & ",???" & (CPUv2 - CPUv1) / MsCount & "??"
                 UsedC(ID) = CPUv2
                If ID = Counts Then Exit Do
                 'CPUv1 = CPUv2
                 '==========================
                 QueryPerformanceCounter CPUv1
                 Dim MilliSeconds2 As Currency
                 MilliSeconds2 = (ID + 1) * MilliSeconds - (CPUv1 - StartC) / MsCount
                 dblDelay = CCur(MilliSeconds2) * 10000#
                 ft.dwHighDateTime = -CLng(dblDelay / UNITS) - 1
                 dblDelayLow = -UNITS * (dblDelay / UNITS - Fix(CStr(dblDelay / UNITS)))
                 If dblDelayLow < MAX_LONG Then dblDelayLow = UNITS + dblDelayLow
                 ft.dwLowDateTime = CLng(dblDelayLow)
        '===================
                SetWaitableTimer mlTimer, ft, 0, 0, 0, False
            Else
            DoEvents
            End If
          
        Loop
        
    '    CloseHandle mlTimer
    '    mlTimer = 0
    Dim i As Long
    UsedC(0) = StartC
    Debug.Print "All UsedTime?" & (CPUv2 - StartC) / MsCount & "ms"
    For i = 1 To 10
        Debug.Print i & ",Used?" & (UsedC(i) - UsedC(i - 1)) / MsCount & "ms"
    Next
        Exit Sub
        
    ErrHandler:
        Err.Raise Err.Number, Err.Source, "[clsWaitableTimer.Wait]" & Err.Description
    End Sub

  24. #24
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,298

    Re: VB6 Sleep Function

    Why so much API, why so much complexity for something as trivial as waiting for a few seconds and the result is some mind-bending code. . .

    cheers,
    </wqw>

  25. #25
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,955

    Re: VB6 Sleep Function

    SetWaitableTimer?The precision of this API is about one millisecond. If we want to delay 2 second, we set a delay of 1998 milliseconds.
    How many milliseconds are left to calculate, and then use an endless loop to execute it.
    Equivalent to sleep 1.023ms,You can then get a 100% accurate delay function. The error may be only one microsecond.

    In order to improve the accuracy of the timer, a number of apis are used. In fact, this is only used in accurately controlling the frame rate of the game, and the upper computer of the factory machine is accurate to send instructions, and it is not used with such high precision.
    Last edited by xiaoyao; May 26th, 2024 at 08:19 AM.

  26. #26
    Angel of Code Niya's Avatar
    Join Date
    Nov 2011
    Posts
    8,665

    Re: VB6 Sleep Function

    Quote Originally Posted by Shaggy Hiker View Post
    ....see y'all back here again around 2024 or 2025.
    So you're not only a programmer, you're also a prophet
    Treeview with NodeAdded/NodesRemoved events | BlinkLabel control | Calculate Permutations | Object Enums | ComboBox with centered items | .Net Internals article(not mine) | Wizard Control | Understanding Multi-Threading | Simple file compression | Demon Arena

    Copy/move files using Windows Shell | I'm not wanted

    C++ programmers will dismiss you as a cretinous simpleton for your inability to keep track of pointers chained 6 levels deep and Java programmers will pillory you for buying into the evils of Microsoft. Meanwhile C# programmers will get paid just a little bit more than you for writing exactly the same code and VB6 programmers will continue to whitter on about "footprints". - FunkyDexter

    There's just no reason to use garbage like InputBox. - jmcilhinney

    The threads I start are Niya and Olaf free zones. No arguing about the benefits of VB6 over .NET here please. Happiness must reign. - yereverluvinuncleber

  27. #27
    Super Moderator Shaggy Hiker's Avatar
    Join Date
    Aug 2002
    Location
    Idaho
    Posts
    39,222

    Re: VB6 Sleep Function

    This is a situation where LOL is literally true. I am utterly amazed at the timing of this resurrection.
    My usual boring signature: Nothing

  28. #28
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,955

    Re: VB6 Sleep Function

    Unless our forum has an automatic search function before each new post.
    If the correct answer to your question can be found on the first page of search results, no one will post it.

    Can the forum dock with ai to answer programming questions automatically?
    If we can't find the answer we need in our search results, we will reply automatically. If I think this list is useful, I can click on it to post. Automatically turn the reply made by the robot into a question and answer.

  29. #29
    Registered User
    Join Date
    May 2024
    Posts
    2

    Re: VB6 Sleep Function

    Glad I could provide some amusement.

    Found this post through DDG, as I've been a bit nostalgic for some earlier projects I worked on. Hopefully I can dig up the source code in a couple of months when I visit my family. I wonder if I can understand any of it if I do, as I seem to remember not understanding how some of it worked at the time. I seem to remember writing lots of comments, but I'm not sure that's going to help.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width