It is illegal to call out while inside message filter

[maryam_80]

با سلام

من یک برنامه با vb6 نوشته بودم و به نظر می رسید که بدون مشکل دارد کار می کند ولی کاربر سیستم به من خبر داد که به طور تصادفی هر دفعه در یک قسمت از برنامه خطای زیر را می بیند(حتی وقتی روی یک button که رنگ background را عوض می کند کلیک کند ،این خطا را می بیند)



Runtime error 80010005
Automation error
it is illegal to call out while inside message filter


تنها قسمتی که من به آن شک دارم این هست که من روی فرمم یک timer دارم که در event آن دارم از پورت سریال اطلاعاتی را به صورت زیر می خوانم .


Private Sub Timer1_Timer()
On Error GoTo errhandle
Dim InputValues As String
Dim OutPutValues As String
Dim wValueLine() As String
Dim WeightByK() As String
Dim KeepMinNet, KeepMaxNet, KeepRegNet As Double

InputValues = MSComm1.Input 'reading From Serial Port
InputValues = Replace(Trim(InputValues), Chr(2), "")
InputValues = Replace(Trim(InputValues), Chr(32), "")
wValueLine = Split(Trim(InputValues), vbCrLf) 'Split Enter from Input

Dim Count As Integer
Count = 0
Do While Count < UBound(wValueLine)
If Trim(wValueLine(Count)) <> "" Then
OutPutValues = Trim(wValueLine(Count))
Exit Do
End If
Count = Count + 1
Loop

If OutPutValues = "" Or IsNull(OutPutValues) Or ((Mid(OutPutValues, 1, 1) < Chr(48)) Or (Mid(OutPutValues, 1, 1) > Chr(57))) Or (InStr(OutPutValues, "L") > 0) Then
'If OutPutValues = "" Or IsNull(OutPutValues) Or (InStr(OutPutValues, "L") > 0) Then
Lbl_weight.Caption = Val(OutPutValues) & "K"
Exit Sub
End If

If (InStr(OutPutValues, "M") = 0) Then
If InStr(OutPutValues, "G") > 0 Then
WeightByK = Split(OutPutValues, "G")
End If
If InStr(OutPutValues, "N") > 0 Then
WeightByK = Split(OutPutValues, "N")
End If
If isArrayEmpty(WeightByK) = True Then
Exit Sub
End If
If (Mid(Trim(WeightByK(0)), 1, Len(WeightByK(0)) - 1) <> "") Then
FinalWeight = Split(WeightByK(0), "K") 'Final Weight which is fixed
If Len(FinalWeight(0)) < 4 Or Len(WeightByK(0)) < 5 Then
Exit Sub
End If

KeepMinNet = CDbl(NetWeight) * (1 - (CDbl(MinNetWeight / 100)))
If CDbl(FinalWeight(0)) < CDbl(KeepMinNet) Then
MinShape.FillColor = vbRed
MaxShape.FillColor = vbButtonFace
RegShape.FillColor = vbButtonFace
End If
KeepMaxNet = CDbl(NetWeight) * (1 + (CDbl(MaxNetWeight / 100)))
If CDbl(FinalWeight(0)) > CDbl(KeepMaxNet) Then
MaxShape.FillColor = vbBlue
MinShape.FillColor = vbButtonFace
RegShape.FillColor = vbButtonFace
End If
If CDbl(FinalWeight(0)) = CDbl(NetWeight) Then
RegShape.FillColor = vbGreen
MinShape.FillColor = vbButtonFace
MaxShape.FillColor = vbButtonFace
End If

If CDbl(FinalWeight(0)) >= KeepMinNet And CDbl(FinalWeight(0)) <= KeepMaxNet Then
RegShape.FillColor = vbGreen
MinShape.FillColor = vbButtonFace
MaxShape.FillColor = vbButtonFace
End If
If ((CDbl(NetWeight) * (1 - (CDbl(MinNetWeight / 100)))) <= CDbl(FinalWeight(0))) And ((CDbl(NetWeight) * (1 + (CDbl(MaxNetWeight / 100)))) >= CDbl(FinalWeight(0))) Then

If WeightFixed = True Then
Exit Sub
Else
ADDBoxweightToTblweight 'Save Current Weight in table
' If FindError = True Then
' FindError = False
' Exit Sub
' End If
Weight.Lbl_weight.Caption = WeightByK(0)
Statusshape.FillColor = vbRed
WeightFixed = True
If Printed = True Then
Call PrintWeightInLabels(True, WeightByK(0))
End If
End If
End If
End If
Else
If InStr(OutPutValues, "GM") > 0 Then
WeightByK = Split(OutPutValues, "GM")
End If
If InStr(OutPutValues, "NM") > 0 Then
WeightByK = Split(OutPutValues, "NM")
End If

If (Mid(Trim(WeightByK(0)), 1, Len(WeightByK(0)) - 1) <> "") And Len(WeightByK(0)) >= 5 Then
CurrentWeight = WeightByK(0)
Weight.Lbl_weight.Caption = CurrentWeight
Statusshape.FillColor = vbButtonFace
WeightFixed = False
End If
MinShape.FillColor = vbButtonFace
MaxShape.FillColor = vbButtonFace
RegShape.FillColor = vbButtonFace
End If
MSComm1.InBufferCount = 0
Exit Sub
errhandle:
'MsgBox "It is a wrong label.Please choose the correct one", , "Warning"
Select Case Err.Number
Case 8018:
MsgBox ("Port is close")
Case Else
MsgBox (Err.Description & Err.Number)
End Select


Exit Sub
End Sub




آیا کسی این خطا را قبلا دیده و یا نظری درباره آن ندارد