VB6: How to abort a procedure that's taking too long

Dear Experts,

I am using a subroutine to shrink and antialias images. It works well in general, but on very large images it takes too long and in Windows Vista, this has caused freezing of the system.

I would like recommendations on the best way to abort a subroutine if it is taking longer than a specified number of seconds (I have experimented with using a timer and DoEvents command but so far I'm not satisfied).

Also, if anyone can recommend a very fast method of resizing with antialiasing, it would be very helpful.

Thank you!
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Well, fundimentally speaking, once VB starts a subroutine, the only way to get the application to do anything other than run the subroutine to completion is to insert DoEvents.

But that's just the 1st part of the problem.  That's how to allow windows to respond to messages such as minimize the window, move the window, or process a timer event.

What you need in addition to DoEvents is an event that sets a flag that the subroutine tests for and aborts the subroutine when the flag is set.

As an example, here's the code I use within a Form that has a subroutine that needs to be terminated if the user clicks on an abort button.  The main keys are:
1. Flags to allow attempts to close the form to react like the abort button was clicked instead.
2. AbortProcess function that includes 'DoEvents' and returns the current Abort status
3. Abort Command Button that simply sets the Abort Flag (after user confirms abort)
4. Periodically calling the AbortProcess function during the long subroutine.

Option Explicit
Private m_Abort As Boolean  'Flag that Abort Button has been Clicked and Confirmed
'How should the X System Button be Treated
Private Enum enumXButton
    X_NA        'Has No Effect
    X_ABORT     'Like an Abort Button
    X_CLOSE     'Like a Cancel Button
End Enum
Dim m_X As enumXButton
'Has the Abort Button been Clicked (and confirmed)?
Public Function AbortProcess() As Boolean
    AbortProcess = m_Abort
End Function
Private Sub cmdAbort_Click()
    Dim Reply As VbMsgBoxResult
    Reply = MsgBox("Abort Process?", vbQuestion + vbYesNo + vbDefaultButton2)
    If Reply = vbYes Then
        m_Abort = True
    End If
End Sub
Private Sub Form_Load()
    m_X = X_CLOSE
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Select Case m_X
        Case X_NA:      Cancel = 1
        Case X_ABORT:   Call cmdAbort_Click
                        Cancel = 1
        Case X_CLOSE:   'NOP - Allow Shutdown
    End Select
End Sub
'Now to code the really long subroutine
Private Sub SomeReallyLongProcess()
    'Initialize the Abort Flags
    m_Abort = False
    m_X = X_ABORT   'Makes any attempt to close the form react as if the Abort Button was clicked
    'Other intitilizing code...
    'The processing loop 
    Dim Index as Long
    For Index = 1 to 100000
        'Test for Abort - This single command can be sprinkled through out the processing loop
        if AbortProcess then Goto CloseAndExitSub
        'The rest of your processing logic goes here...
    Next I
    m_X = X_CLOSE    'Reset how form reacts to a Close Command
    'Other common clean up code here...
End Sub

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Additional though!

If all you are interested in doing is abort the subroutine if it runs too long, at the start of the subroutine, simply record the current system Date/Time.  Periodically, test how much time has elapsed, and abort the subroutine if too much time has passed.  (Note, I might have the order of the two dates in DateDiff backwards).
Private Sub SomeLongProcess()
    Dim StartTime as Date
    StartTime = Now
    Dim I as Long
    For I = 1 to 100000
        'Abort if Process has run longer than 10 seconds
        if DateDiff("s",StartTime,Now) > 10 Then Goto CloseAndExitSub
        'The rest of the process here
    Next I
    'Cleanup code
End Sub

Open in new window

You don't need to use DoEvents - and you probably shouldn't, as you can easily check your message queue directly.  Certain messages are buffered in the process' message queue, and you simply access that to see what's waiting - like a critical key press.

I've attached a small routine from one of my old projects that sets a Global called Abort to true if the Esc key is hit/released.

Public Function AbortCheck() As Boolean
    Dim Msg As Msg
    ' The improvement over using GetAsyncKeyState [IsKeyDown below] is that the check for the Esc key in
    ' GetAsyncKeyState will only work if the key is down when we call the function. By using the message
    ' queue, it doesn't matter when the key is pressed.
    If Not Screen.ActiveForm Is Nothing Then
        ' If we've a WM_KEYUP message in our queue: go and remove it.  NOTE - we ignore anything else.
        Do While PeekMessage(Msg, Screen.ActiveForm.hWnd, WM_KEYUP, WM_KEYUP, PM_REMOVE)
            ' If the virtual keycode of the WM_KEYUP is VK_ESCAPE.
            If Msg.wParam = VK_ESCAPE Then
                ' Flush the message queue of all keyboard messages.
                Do While PeekMessage(Msg, Screen.ActiveForm.hWnd, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)
                    ' Nothing.
                Abort = True
                AbortCheck = Abort
            End If
    End If
End Function

Open in new window

Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

I'm curious as to why you say that you probably shouldn't use DoEvents?

From what I see, it looks like your AbortCheck() is sort of like a special purpose DoEvents.  But rather than allowing the events to happen, it just ignores them as it looks for a specific event.  If so, that would seem to make an application look stuck because it looks like it's not responding to events (like Minimize the Window, Move the Window, refresh the window if something has been drawn on top of it).  But with DoEvents, the application will continue to be responsive to windows messages, allow for the testing of an abort condition, and continue processing the subroutine.
>>I'm curious as to why you say that you probably shouldn't use DoEvents?

Simply because one cannot 'filter' what messages will be flushed, and sent to your app whenever it's called - this may lead to all manner of state changes that can really 'hurt'.

Yes, polling the message queue is like a filtering DoEvents - just what's needed!

>>If so, that would seem to make an application look stuck because it looks like it's not responding to events (like Minimize the Window, Move the Window, refresh the window if something has been drawn on top of it)

Not at all, in that I've used the same technique to allow moving/resizing/re-painting - all with absolute 'control', and without calling DoEvents.
ttobin333Author Commented:
Thanks guys, both methods will be very useful in my toolbox!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.