comm.bas

VB上位机温度模块程序,包括对温度模块的校准,和参数设置,用于工业现场,非常实用

Attribute VB_Name = "Comm"
Option Explicit

Public Buflen As Integer        '定义一个存放串口返回数据个数的容器
Dim Cmdbuf(3) As Byte
Public Alldata() As String
Public Alldatadif() As String
Public Port As Integer


Public Sub Readdata()
    On Error Resume Next
         Dim sum As Integer
         Dim sdata As String
         Dim i As Integer, j As Integer
         Dim ret As Integer
         Dim inbuf(0 To 56) As Byte    '定义一个数组用来存储8个通道的温度值
         Dim errtime As Integer
        ' Addr = Val(frm.Text6.Text)
        errtime = 0
           ReDim Alldata(0 To Val(frm.Text9.Text) - Val(frm.Text6.Text), 0 To 7) As String
         ReDim Alldatadif(0 To Val(frm.Text9.Text) - Val(frm.Text6.Text), 0 To 7) As String
        If Val(frm.Text6.Text) > 255 Or Val(frm.Text9.Text) > 255 Then
           MsgBox "超出了最大的地址范围,请重新输入地址!", vbOKOnly + vbInformation, "提示"
           Exit Sub
         End If
          If frm.Text9.Text = "" Then
              frm.Text9.Text = frm.Text6.Text
            End If
         If Trim(frm.Text6.Text) = "" Or Not IsNumeric(frm.Text6.Text) Or Val(frm.Text6.Text) > Val(frm.Text9.Text) Then '
           MsgBox "请添入正确的数据!", vbOKOnly + vbInformation, "提示"
           Exit Sub
         End If
         
'         ReDim Alldata(0 To Val(frm.Text9.Text) - Val(frm.Text6.Text), 0 To 7) As String
'         ReDim Alldatadif(0 To Val(frm.Text9.Text) - Val(frm.Text6.Text), 0 To 7) As String
         
            For i = 0 To Val(frm.Text9.Text) - Val(frm.Text6.Text)
        '-----------------------------------------------------------
Again:            Cmdbuf(0) = Asc("#")
            sdata = Replace(Format(Hex(CInt(frm.Text6.Text) + i), "@@"), " ", "0")
            Cmdbuf(1) = Asc(Mid(sdata, 1, 1))
            Cmdbuf(2) = Asc(Mid(sdata, 2, 1))
            Cmdbuf(3) = &HD
            Cmdbuf(4) = &HA
           
'         ReDim Alldata(0 To Val(frm.Text9.Text) - Val(frm.Text6.Text), 0 To 7) As String
'         ReDim Alldatadif(0 To Val(frm.Text9.Text) - Val(frm.Text6.Text), 0 To 7) As String
      '  For i = 0 To Val(frm.Text9.Text) - Val(frm.Text6.Text)
             ret = sio_open(Port)
             ret = sio_flush(Port, 2)  '清接收发送缓冲区
             Buflen = sio_write(Port, Cmdbuf(0), 5)   '发送读模块命令
             If Buflen < 0 Then
                frm.Label1.Caption = "发送数据失败！"
                frm.Label1.ForeColor = vbRed
             End If
   
             TimeDelay 200
             Buflen = sio_read(Port, inbuf(0), 58)
             
             If Buflen = 58 Then
                If inbuf(0) <> Asc(">") Then
                        errtime = 1 + errtime
                        If errtime <= 3 Then
                            GoTo Again
                        Else
'                          frm.Label1.Caption = "模块" & i + Val(frm.Text6.Text) & "读取数据错误！"
'                          frm.Label1.ForeColor = vbRed
                         frm.txtmsg.Text = frm.txtmsg.Text & vbCrLf & "模块" & (i + Val(frm.Text6.Text)) & "数据错误！" & vbCrLf
                         frm.txtmsg.ForeColor = vbBlue
                         ScrollText frm.txtmsg
                          For j = 0 To 7
                              Alldatadif(i, j) = "*"
                              Alldata(i, j) = "***"
                            Next j
                            'Call dispatch
                          'Exit Sub
                        End If
                 Else
                        
                        frm.Label1.Caption = "读取数据正常！"
                        frm.Label1.ForeColor = vbBlue
'                         txtmsg.Text = txtmsg.Text & vbCrLf & "模块" & (i + Val(frm.Text6.Text)) & "数据正常！" & vbCrLf
'                         txtmsg.ForeColor = vbBlue
'                         ScrollText txtmsg
                            For j = 0 To 7
                              Alldatadif(i, j) = Chr(inbuf(j * 7 + 1))
                              Alldata(i, j) = Chr(inbuf(j * 7 + 2)) & Chr(inbuf(j * 7 + 3)) & Chr(inbuf(j * 7 + 4)) & Chr(inbuf(j * 7 + 5)) & Chr(inbuf(j * 7 + 6)) & Chr(inbuf(j * 7 + 7))
                            Next j
                   
                  End If
             Else
                errtime = errtime + 1
                If errtime <= 3 Then
                   GoTo Again
                Else
'                  frm.Label1.Caption = "模块" & (i + Val(frm.Text6.Text)) & "数据错误！"
'                  frm.Label1.ForeColor = vbRed
                   frm.txtmsg.Text = frm.txtmsg.Text & vbCrLf & "模块" & (i + Val(frm.Text6.Text)) & "数据错误！" & vbCrLf
                   frm.txtmsg.ForeColor = vbRed
                   ScrollText frm.txtmsg
                   For j = 0 To 7
                              Alldatadif(i, j) = "*"
                              Alldata(i, j) = "***"
                    Next j
                    'Call dispatch
                  'Exit Sub
                End If
                
             End If
             'Call dispatch
       Next i
       ret = sio_close(Port)
       Call dispatch
      ' frm.Text9.Text = ""
End Sub
Public Sub dispatch()
    Dim AddLvw As ListItem
    Dim i As Integer
    Dim j As Integer
    frm.ListView1.ListItems.Clear
    For i = 0 To Val(frm.Text9.Text) - Val(frm.Text6.Text)
    
     ' For j = 0 To 7
       Set AddLvw = frm.ListView1.ListItems.Add(, , Val(frm.Text6.Text) + i)
          ' AddLvw.SubItems(0) = Alldatadif(i, 0) & Alldata(i, 0) 'IIf(Mid(Alldata(i, 0), 1, 2) = "00", Format(Alldata(i, 0), "00.00"), Format(Alldata(i, 0), "0000.00"))
           AddLvw.SubItems(1) = Alldatadif(i, 0) & IIf(Mid(Alldata(i, 0), 1, 2) = "00", Format(Alldata(i, 0), "00.00"), Format(Alldata(i, 0), "0000.00"))
           AddLvw.SubItems(2) = Alldatadif(i, 1) & IIf(Mid(Alldata(i, 1), 1, 2) = "00", Format(Alldata(i, 1), "00.00"), Format(Alldata(i, 1), "0000.00"))
           AddLvw.SubItems(3) = Alldatadif(i, 2) & IIf(Mid(Alldata(i, 2), 1, 2) = "00", Format(Alldata(i, 2), "00.00"), Format(Alldata(i, 2), "0000.00"))
           AddLvw.SubItems(4) = Alldatadif(i, 3) & IIf(Mid(Alldata(i, 3), 1, 2) = "00", Format(Alldata(i, 3), "00.00"), Format(Alldata(i, 3), "0000.00"))
           AddLvw.SubItems(5) = Alldatadif(i, 4) & IIf(Mid(Alldata(i, 4), 1, 2) = "00", Format(Alldata(i, 4), "00.00"), Format(Alldata(i, 4), "0000.00"))
           AddLvw.SubItems(6) = Alldatadif(i, 5) & IIf(Mid(Alldata(i, 5), 1, 2) = "00", Format(Alldata(i, 5), "00.00"), Format(Alldata(i, 5), "0000.00"))
           AddLvw.SubItems(7) = Alldatadif(i, 6) & IIf(Mid(Alldata(i, 6), 1, 2) = "00", Format(Alldata(i, 6), "00.00"), Format(Alldata(i, 6), "0000.00"))
           AddLvw.SubItems(8) = Alldatadif(i, 7) & IIf(Mid(Alldata(i, 7), 1, 2) = "00", Format(Alldata(i, 7), "00.00"), Format(Alldata(i, 7), "0000.00"))
           
    ' Next j
   Next i
        
End Sub