101 lines
3.6 KiB
VB.net
101 lines
3.6 KiB
VB.net
Module scaleMoudule
|
|
|
|
Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Integer
|
|
|
|
Public rxMessage As String
|
|
Public pasingdata As String
|
|
Public Const RetryCnt As Integer = 3
|
|
Dim WaitGo As String
|
|
|
|
Public Function MeasureScale(timeout As Long) As String
|
|
Dim StartTick, CurrTick As Long
|
|
Dim tmpVal As String
|
|
Dim tmpRxMessage As String = ""
|
|
Dim CmdRet As String = ""
|
|
Dim MeasureVal As Double
|
|
|
|
For cnt = 1 To RetryCnt
|
|
|
|
weightForm.cmdSerialPort.DiscardInBuffer()
|
|
weightForm.cmdSerialPort.DiscardOutBuffer()
|
|
|
|
rxMessage = ""
|
|
StartTick = GetTickCount
|
|
weightForm.cmdSerialPort.Write(Chr(&H5))
|
|
While (CurrTick - StartTick <= timeout)
|
|
CurrTick = GetTickCount
|
|
|
|
CmdRet = ReceiveByteSerial()
|
|
|
|
Select Case CmdRet
|
|
Case "START"
|
|
StartTick = GetTickCount
|
|
rxMessage = ""
|
|
weightForm.cmdSerialPort.Write(Chr(&H11))
|
|
|
|
Case "COMPLETE"
|
|
CmdRet = "FAIL"
|
|
If Len(rxMessage) = 15 Then
|
|
WaitGo = Mid(rxMessage, 3, 1)
|
|
tmpVal = Mid(rxMessage, 5, 6)
|
|
For i = 1 To Len(tmpVal)
|
|
If Mid(tmpVal, 1, 1) = Chr(&H20) Then
|
|
tmpVal = Mid(tmpVal, 2, Len(tmpVal) - 1)
|
|
End If
|
|
Next
|
|
Return WaitGo & tmpVal.ToString
|
|
ElseIf Len(rxMessage) = 16 Then
|
|
WaitGo = Mid(rxMessage, 3, 1)
|
|
tmpVal = Mid(rxMessage, 5, 7)
|
|
For i = 1 To Len(tmpVal)
|
|
If Mid(tmpVal, 1, 1) = Chr(&H20) Then
|
|
tmpVal = Mid(tmpVal, 2, Len(tmpVal) - 1)
|
|
End If
|
|
Next
|
|
MeasureVal = Val(tmpVal) / 10
|
|
Return WaitGo & MeasureVal.ToString
|
|
Else
|
|
Exit While
|
|
End If
|
|
End Select
|
|
CmdRet = "TIMEOUT"
|
|
End While
|
|
Next
|
|
|
|
Return CmdRet
|
|
End Function
|
|
Public Function ReceiveByteSerial() As String
|
|
Dim n As Integer = weightForm.cmdSerialPort.BytesToRead
|
|
Dim comBuffer As Byte()
|
|
|
|
Try
|
|
|
|
comBuffer = New Byte(n - 1) {}
|
|
weightForm.cmdSerialPort.Read(comBuffer, 0, n)
|
|
|
|
For cnt = 0 To comBuffer.Length - 1
|
|
rxMessage = rxMessage & Chr(comBuffer(cnt))
|
|
Next
|
|
|
|
If Mid(rxMessage, 1, 1) = ChrW(6) Then
|
|
Return "START"
|
|
ElseIf Len(rxMessage) > 14 Then
|
|
If Mid(rxMessage, InStr(rxMessage, ChrW(1)), 2) = ChrW(1) & ChrW(2) Then
|
|
rxMessage = Mid(rxMessage, InStr(rxMessage, ChrW(1)), (Len(rxMessage)))
|
|
|
|
If Mid(rxMessage, InStr(rxMessage, ChrW(3)), 2) = ChrW(3) & ChrW(4) Then
|
|
rxMessage = Mid(rxMessage, 1, InStr(rxMessage, ChrW(4)))
|
|
|
|
Return "COMPLETE"
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
Return "FAIL"
|
|
Catch ex As Exception
|
|
MsgBox("DataReceived," & ex.Message)
|
|
Return False
|
|
End Try
|
|
End Function
|
|
End Module
|