Adit Cookbook Pages

eMbedded VB

Microsoft eMbedded VB is a development tool for the Pocket PC and HPC family of operating systems.

DoEvents - eMbedded VB has no DoEvents function and this can cause problems when you need to write routines that loop around waiting for things to do - rather than being triggered into action by a tap with the user’s stylus.

The first solution is based upon a code snippet from Richard Whitaker that I found on another web site.

It goes like this:

Declarations:
-----------------------------------
Declare Function PeekMessage lib "coredll.dll" Alias "PeekMessageW" _
 (ByVal Msg As String, ByVal hWnd As Long, ByVal wMsgFilterMin As Integer,
 ByVal wMsgFilterMax As Integer, ByVal wRemoveMsg As Integer) As Boolean

Declare Function TranslateMessage Lib "coredll.dll" (ByVal Msg As String)
As Boolean

Declare Function DispatchMessage Lib "coredll.dll" Alias "DispatchMessageW"
(ByVal Msg As String) As Boolean
-----------------------------------

Code:
-----------------------------------
Dim Msg As String

Private Sub Form_Load()
 Msg = String(18, Chr(0))             
End Sub

Private Sub CEDoEvents()
  Dim PM_REMOVE As Integer
  PM_REMOVE = 1
  If PeekMessage(Msg, 0, 0, 0, PM_REMOVE) Then
     TranslateMessage (Msg)
     DispatchMessage (Msg)
  End If
End Sub
 

My Variation makes a small change to the CEDoEvents() subroutine and looks like this:

Public Sub DoEvents2()
   Dim PM_REMOVE As Integer
   PM_REMOVE = 1
   Do Until Not PeekMessage(Msg, 0, 0, 0, PM_REMOVE)
       TranslateMessage (Msg)
       DispatchMessage (Msg)
   Loop
End Sub

and I think the current live version (you will want to impose your own coding style) looks something like this:

Function CeDoEvents()

Dim Msg

On Error Resume Next

Msg = String(18, Chr(0))

Do

If PeekMessage(Msg, 0, 0, 0, 1) Then

TranslateMessage Msg
DispatchMessage Msg

Else

Exit Do

End If

Loop

Sleep

I also added the following declaration to my code

Public Declare Sub Sleep Lib "coredll" (ByVal dwMilliseconds As Long)

which gave me a Sleep function to use just about anywhere. It puts the current thread to sleep for the specified duration in milliseconds. Or if you pass it a duration of zero (0) it does something more interesting - it allows any other thread with an equal (or presumably greater) priority to execute.

The judicious use of the DoEvents2() subroutine and the system call to Sleep() filled in all of the missing gaps for managing a continuous process. Well nearly...

The code was an elapsed timer and the key subroutine looked like this:

Private Sub RunTimer()
   Dim NowTime As Long, WorkSecs As Long
   TimerRunning = True
   Do While TimerRunning
       NowTime = GetTickCount
       WorkSecs = (NowTime - EStartTime) / tickspersec
       WorkSecs = Int(WorkSecs)
       If WorkSecs > ElapsedSecs Then
           ElapsedSecs = WorkSecs
           PPCT1.setDisplay
       End If
       Sleep 0
       DoEvents2
   Loop
End Sub
 

The problem was that even though we used the events that notified us of the app terminating to set TimeRunning to False and the fact that the App.End method was used to finish things off - it looked as though this little bit of code just went on running. We had to implement a two stage termination - the user clicked a button to stop the timer and then clicked the now re-captioned button to terminate the process. In the mean time the RunTimer() function had time to come to hit the End Sub line and stop.

Oh yes, GetTickCount is a useful system call and the declaration goes like this
Public Declare Function GetTickCount Lib "coredll" () As Long
tickspersec was a constant - currently set at 1000