Using MsgWaitObject

[Qpido]

My Program

The link above leads to a picture of the program I made.
This program makes the price show up out of an Excel file for transportation costs.

With the help of some on this forum I have gotten this far with the program, and I'm very grateful for that. It's completely working now, but it's not perfected yet.
With some codes I'll explain what my problem is.

Code 1

Private Sub lstPrijs_Click()

Dim strListValue As String, sngPercentage As Single
   strListValue = lstPrijs.List(lstPrijs.ListIndex)
   ' Check for numeric value to avoid run time error
   If IsNumeric(strListValue) Then
      Text1 = ""
      Text1 = strListValue
      lstDiesel.Clear
      lstDiesel.AddItem (strListValue * 1.11)
   End If

Text3 = ""

End Sub

Code 2
Private Sub lstDiesel_Click()

Dim strListValue As String, sngPercentage As Single
   strListValue = lstDiesel.List(lstDiesel.ListIndex)
   ' Check for numeric value to avoid run time error
   If IsNumeric(strListValue) Then
      Text1 = ""
      Text1 = strListValue
    End If
    
If lstDiesel.SelCount = lstDiesel.ListCount Then
lstPrijs.Selected(Index) = 0
End If

Text3 = ""

End Sub

These are 2 codes I'm now using seperately, because if I put them together they won't do anything.
When I click the Transport Info, which makes the Price show up from Excel it takes about a half a second for it to show up. I tried putting the first code in the same Sub as the one with the Postal Code List, because this is the last one that you click before it shows the Price.
I figured that way it would calculate the Diesel Extra Cost automaticly when I click the Postal Code.

This does not work, so I have to wait for the Price to load, then click on the lstPrijs to load the code.

I found this code for using MsgWaitObj,

Option Explicit
'********************************************
'*    (c) 1999-2000 Sergey Merzlikin        *
'********************************************

Private Const STATUS_TIMEOUT = &H102&
Private Const INFINITE = -1& ' Infinite interval
Private Const QS_KEY = &H1&
Private Const QS_MOUSEMOVE = &H2&
Private Const QS_MOUSEBUTTON = &H4&
Private Const QS_POSTMESSAGE = &H8&
Private Const QS_TIMER = &H10&
Private Const QS_PAINT = &H20&
Private Const QS_SENDMESSAGE = &H40&
Private Const QS_HOTKEY = &H80&
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 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 Declare Function GetTickCount Lib "kernel32" () As Long


' The MsgWaitObj function replaces Sleep, 
' WaitForSingleObject, WaitForMultipleObjects functions.
' Unlike these functions, it
' doesn't block thread messages processing.
' Using instead Sleep:
'     MsgWaitObj dwMilliseconds
' Using instead WaitForSingleObject:
'     retval = MsgWaitObj(dwMilliseconds, hObj, 1&)
' Using instead WaitForMultipleObjects:
'     retval = MsgWaitObj(dwMilliseconds, hObj(0&), n),
'     where n - wait objects quantity,
'     hObj() - their handles array.

Public Function MsgWaitObj(Interval As Long, _
            Optional hObj As Long = 0&, _
            Optional nObj As Long = 0&) As Long
Dim T As Long, T1 As Long
If Interval <> INFINITE Then
    T = GetTickCount()
    On Error Resume Next
    T = T + Interval
    ' Overflow prevention
    If Err <> 0& Then
        If T > 0& Then
            T = ((T + &H80000000) _
            + Interval) + &H80000000
        Else
            T = ((T - &H80000000) _
            + Interval) - &H80000000
        End If
    End If
    On Error GoTo 0
    ' T contains now absolute time of the end of interval
Else
    T1 = INFINITE
End If
Do
    If Interval <> INFINITE Then
        T1 = GetTickCount()
        On Error Resume Next
     T1 = T - T1
        ' Overflow prevention
        If Err <> 0& Then
            If T > 0& Then
                T1 = ((T + &H80000000) _
                - (T1 - &H80000000))
            Else
                T1 = ((T - &H80000000) _
                - (T1 + &H80000000))
            End If
        End If
        On Error GoTo 0
        ' T1 contains now the remaining interval part
        If IIf((T1 Xor Interval) > 0&, _
            T1 > Interval, T1 < 0&) Then
            ' Interval expired
            ' during DoEvents
            MsgWaitObj = STATUS_TIMEOUT
            Exit Function
        End If
    End If
    ' Wait for event, interval expiration
    ' or message appearance in thread queue
    MsgWaitObj = MsgWaitForMultipleObjects(nObj, _
            hObj, 0&, T1, QS_ALLINPUT)
    ' Let's message be processed
    DoEvents
    If MsgWaitObj <> nObj Then Exit Function
    ' It was message - continue to wait
Loop
End Function

I put this into a Module and tried integrating it, but I'm not having any luck with it.

Could you guys look into my problem?

Thanks in advance,

Q~

[hkdani]

These are 2 codes I'm now using seperately, because if I put them together they won't do anything.

Looks like you're making it too hard.
Try sticking your second code inside of a timer that's disabled

' after your first code
' set the interval property to about 750
timer1.enabled

Private Sub Timer1_Timer()
'
Dim strListValue As String, sngPercentage As Single
   strListValue = lstDiesel.List(lstDiesel.ListIndex)
   ' Check for numeric value to avoid run time error
   If IsNumeric(strListValue) Then
      Text1 = ""
      Text1 = strListValue
    End If
    
If lstDiesel.SelCount = lstDiesel.ListCount Then
lstPrijs.Selected(Index) = 0
End If

Text3 = ""
'
timer1.enabled = false

End Sub

[Qpido]

I tried the approach you gave me, but it doesn't seem to work.
I actually want to put it in the step (click) before code 1, so it loads code 1 and 2 in following order. I want to click "lstPost" and then have code 1, which has to copy info from Box1 to Box2, then has to load code 2, which copies Box2 to Text1.

So I tried putting the timer enable code in lstPost_Click, but it doesn't work unless I click Box1, which is weird because there is no code in Box1.

Sub lstPostcode_Click()

lstPrijs.Clear
lstTijdsduur.Clear
lstVertrek.Clear
lstOpmerkingen.Clear
lstDiesel.Clear

'SubBelgië
If lstLanden = "België" Then
Call BelgPo
End If

End Sub

ub BelgPo()

Dim xl As Object
Dim xlsheet As Object
Dim xlwbook As Object

'BelgiëPost
If lstLanden = "België" Then
lstVertrek.AddItem ("Dagelijks")
End If

If lstPostcode = "66-69" Then
lstTijdsduur.AddItem ("48 uur")
End If
If lstPostcode = "10-39" Or lstPostcode = "90-99" Or lstPostcode = "40-65" Or lstPostcode = "70-89" Then
lstTijdsduur.AddItem ("24 uur")
End If

If lstGewicht = "t/m 50kg" Then
If lstPostcode = "10-39" Or lstPostcode = "90-99" Then
Me.lstPrijs.AddItem FOTRICWB("f:\Verzend\Bosman2.xls", "Belg", "h5")
End If
If lstPostcode = "40-65" Or lstPostcode = "70-89" Then
Me.lstPrijs.AddItem FOTRICWB("f:\Verzend\Bosman2.xls", "Belg", "m5")
End If
If lstPostcode = "66-69" Then
Me.lstPrijs.AddItem FOTRICWB("f:\Verzend\Bosman2.xls", "Belg", "r5")
End If
End If

Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()

Dim strListValue As String, strListValue2 As String
   strListValue = lstPrijs.List(lstPrijs.ListIndex)
   ' Check for numeric value to avoid run time error
   If IsNumeric(strListValue) Then
      lstDiesel.Clear
      lstDiesel.AddItem (strListValue * 1.11)
   End If

   strListValue2 = lstDiesel.List(lstDiesel.ListIndex)
   ' Check for numeric value to avoid run time error
   If IsNumeric(strListValue2) Then
      Text1 = ""
      Text1 = strListValue2
    End If
    
Text3 = ""

Timer1.Enabled = False

End Sub

Hope to hear from you,

Q~

[hkdani]

Just a few general suggestions.

Sometimes VB6 has problems dealing with threads outside of its own code.

For instance, suppose you have code to access a database within a sub procedure. You have about 20 lines of code in that sub. At line 15 you access the database. The database is accessed; but you find that the following 5 lines in that sub routine were never executed.

Strange, but it is a documented problem with VB6 when accesing databases in the middle of a subroutine. The solution might be to end the sub at the end of the call to the database (line 15) and then make another sub routine to handle the next five lines.

So, try breaking up your code into smaller blocks. You have three calls to an excel spread sheet in the same subroutine. I guess that's what you have. FORTWICB, I'm guessing, is probably some function you have that returns a string.
I wouldn't stick all these in the same subroutine.

And I'm not too sure about your code for your conditional statements:

if lstPostcode = .....

You should break in the middle of your code while its running and see in the debug window if you can actually retrieve a value with the code the way you have it written.

--------------------------------------------------
Immediate
debug.print lstPostcode

[SCBWV]

Since it seems the Excel data is populating a text box control, why not use the Change event for the text box to trigger your code?

[Qpido]

I actually only took one piece out of the code, it has about 23 pieces like the one above. In the same sub.
I have a total of 5100 lines, but I'm too unfamiliar with programming to use a different way.

I uploaded the text file with code:
http://www.fileden.com/files/2007/5/25/1112111/Code.txt

I'm not sure how I should cut them from each other.

Happy new year, and thanks again for all your help.

Q~

[Qpido]

I've been able to complete the project, I changed the lstPrijs and lstDiesel to txtPrijs and txtDiesel and there was no delay or problem anymore.

So thanks!

Q~