[RESOLVED] Long Loops freeze my program

[ship]

If a Loop is very long (lasts more than 10 seconds or so) the program just stops responding and I have to use ctrl-alt-delete. Also, while the Loop is running, I can't use my computer until it either finishes or until it stops responding. How do I get my program to not work so hard?

Dim lASDF As Long
 
Private Sub Form_Load()
End Sub
 
Private Sub cmndStart_Click()
 
    lASDF = 0
 
    Do
        lASDF = lASDF + 1
        lblCount.Caption = lASDF
    Loop Until (1 = 2)
 
End Sub

If the Loop condition is 'Until (lASDF = 1000000)' it will take about nine seconds to finish. Looping a million times isn't enough to freeze the program, but during the time it takes I can't do anything on my computer. Not even view my desktop.

[penagate]

You need to manually relinquish some CPU control, otherwise your loop makes continous control requests.

You can either

a) chuck a DoEvents in there,

b) chuck a Sleep() call in there which pauses your thread, or

c) both.

The problem with DoEvents is that while it is quite effective, it can cause a jumble with code jumping about within your app (especially if you have lots of events firing, they will go out of order) and it is pretty resource-intensive itself. So try this:

' In a module, or Private in a class/form/uc
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
' in your loop body
Sleep 10

That should be enough to reduce the CPU load a fair bit. You can play with the pause duration to see which has best effect.

Alternatively, you can also go a rather more hardcore route and do this (A combination of DoEvents, without the mess, and Sleep without the unnecessary pause):

Type Msg
    hWnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As Double
End Type
 
Declare Function GetMessage Lib "user32" Alias "GetMessageW" ( _
    ByRef lpMsg As MSG, _
    ByVal hWnd As Long, _
    ByVal wMsgFilterMin As Long, _
    ByVal wMsgFilterMax As Long _
) As Long
 
Declare Function TranslateMessage Lib "user32" ( _
    ByRef lpMsg As MSG _
) As Long
 
Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageW" ( _
    ByRef lpMsg As MSG _
) As Long
 
' Usage (as a function replacement for DoEvents)
Sub TwiddleThumbs()
Dim mMsg As MSG
    Do While (GetMessage(mMsg, 0&, 0&, &H400)
        TranslateMessage mMsg
        DispatchMessage mMsg
    Loop
End Sub

(I hope that works, I didn't test it)

[ship]

I tried just sleep. Even if sleep is set to 500, the program still freezes. I then tried the program you made and I put my 'lblCount.Caption = lASDF' in there. Not sure if I made a mistake, but I got no error messages (after a few things were changed). BUT it still froze. So I added in sleep 500, and that didn't help either. Here is what I last tried, but it still froze after 10 or so seconds:

Dim lASDF As Long
 
Private Type Msg
    hWnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As Double
End Type
 
Private Declare Function GetMessage Lib "user32" Alias _
    "GetMessageW" ( _
    ByRef lpMsg As Msg, _
    ByVal hWnd As Long, _
    ByVal wMsgFilterMin As Long, _
    ByVal wMsgFilterMax As Long _
) As Long
 
Private Declare Function TranslateMessage Lib "user32" ( _
    ByRef lpMsg As Msg _
) As Long
 
Private Declare Function DispatchMessage Lib "user32" Alias _
    "DispatchMessageW" ( _
    ByRef lpMsg As Msg _
) As Long
 
Private Declare Sub Sleep Lib "kernel32" _
    (ByVal dwMilliseconds As Long)
 
Public Sub cmndStart_Click()
 
Dim mMsg As Msg
 
lASDF = 0
 
    Do While (GetMessage(mMsg, 0&, 0&, &H400))
        TranslateMessage mMsg
        DispatchMessage mMsg
        lASDF = lASDF + 1
        Sleep 500
        lblCount.Caption = lASDF
    Loop
 
End Sub

[ship]

Oops. Realized I made a mistake, and edited my above post to reflect the correction.

It doesn't freeze now. That's good. But 1)my label never reads anything, and 2) if 'Do While (GetMessage(mMsg, 0&, 0&, &H400))' then how do I have the loop stop when a condition of my choosing is met?

[Static]

put in a DoEvents after
lblCount.Caption = lASDF

Do While (GetMessage(mMsg, 0&, 0&, &H400))
        TranslateMessage mMsg
        DispatchMessage mMsg
        lASDF = lASDF + 1
        Sleep 500
        lblCount.Caption = lASDF
        Doevents
    Loop

[Hack]

DoEvents will return control to the OS for whatever the OS needs to do, but Sleep will just stop everything for a specified period of time.

DoEvents would be the way to go.

[ship]

Ok, ty. I'll try that.

[penagate]

The GetMessage loop I provided you is supposed to go inside your main loop. It is a direct replacement for DoEvents, because Doevents can get very messy sometimes.

[vbbit]

sorry, but how do you exit that do loop?

[vbbit]

This loop makes the application stop executing .. what's the proper way to put this loop in a loop?