Option Explicit
Dim X, Z As Byte
Dim BitStr, BitStr2 As Variant
Dim arry(15)
Private Sub Form_Load()
MSComm1.CommPort = "2"
MSComm1.Settings = "4800,O,8,1"
MSComm1.InputLen = 0
MSComm1.PortOpen = True
End Sub
Private Sub lblBar_Click()
End Sub
Private Sub lblSignal_Click()
End Sub
Private Static Sub MSComm1_OnComm()
Dim Data
Dim strchr As String
Dim strlen, valchr, X, Z, Y As Byte
On Error GoTo fail1
Select Case MSComm1.CommEvent
Case comEvReceive
Dim Buffer As Variant
Buffer = MSComm1.Input
Data = (StrConv(Buffer, vbUnicode))
strlen = Len(Data)
''Text1.SelText = strlen & vbCrLf
For X = 1 To strlen
strchr = Mid$(Data, X, 1)
valchr = Asc(strchr)
Next X
If valchr > 127 Then
Z = 0
arry(Z) = valchr
'''Text1.SelText = Right$("00" + Hex$(arry(0)), 2) & ","
Else
Z = Z + 1
If Z > 14 Then Z = 0
arry(Z) = valchr
'''Text1.SelText = Right$("00" + Hex$(arry(Z)), 2) & ","
End If
End Select
If Z > 3 Then
MSComm1.PortOpen = False
Decode
End If
Exit Sub
fail1:
MSComm1.PortOpen = False
Z = 0
valchr = 0
MSComm1.PortOpen = True
End Sub
Private Sub Decode()
Dim S, X As Byte
Text1.Text = ""
For X = 0 To 4
Text1.SelText = Right$("00" + Hex$(arry(X)), 2) & ","
Label1(X).Caption = Right$("00" + Hex$(arry(X)), 2) & " "
Next X
Label3(0).Caption = arry(0) And &H7
Label3(1).Caption = arry(1) And &H7F
Label3(2).Caption = arry(2) And &H7
Label3(3).Caption = arry(3) And &H7F
Label3(4).Caption = arry(4) And &H7F
'check for bit 6 in arry(2)
If arry(2) And &H40 = 1 Then
Label3(3).Caption = (arry(3) And &H7F) Or &H80
End If
Z = 0
MSComm1.PortOpen = True
End Sub
Static Function Bin2BinStr(PrtVal As Integer)
'converts a 8 bit string value to 8 bits
Dim binmask, p As Integer
BitStr = String(8, "0")
If PrtVal > 127 Then
Mid$(BitStr, 1, 1) = "1"
Else
Mid$(BitStr, 1, 1) = "0"
End If
If PrtVal < 0 Then
Mid$(BitStr, 1, 1) = "1"
End If
binmask = &H40
For p = 2 To 8
If PrtVal And binmask Then
Mid$(BitStr, p, 1) = "1"
End If
binmask = binmask \ 2
Next p
BitStr2 = BitStr
End Function
[I]**broken link removed**[/I]