test.frm

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

                If bufferin(0) = "!" And bufferin(1) = Arrcan(1) And bufferin(2) = Arrcan(2) Then
'                  Label1.Caption = "模块校准使能!"
'                  Label1.ForeColor = vbBlue
                  txtmsg.Text = txtmsg.Text & vbCrLf & "模块" & CStr(i) & "校准使能!" & vbCrLf
                  txtmsg.ForeColor = vbBlue
                  ScrollText txtmsg
                  Command1.Enabled = True
                  Command2.Enabled = True
                End If
            
            Next i
    ElseIf btnencal.Tag = "start" Then
        btnencal.Tag = "stop"
        btnencal.Caption = "校准使能"
            For i = Val(Text7.Text) To Val(Text8.Text) Step 1
            
     '-------------------------------~AAEV[CHK](cr)--------------------------------
     
                  Arrcan(0) = Asc("~")
                  If i <= 15 Then
                     Arrcan(1) = Asc(0)
                     Arrcan(2) = Asc(i)
                  Else
                     Arrcan(1) = Asc(Mid(Hex(i), 1, 1))
                     Arrcan(2) = Asc(Mid(Hex(i), 2, 1))
                  End If
                     Arrcan(3) = Asc("E")
                     Arrcan(4) = Asc(0)
                     Arrcan(5) = &HD
                     Arrcan(6) = &HA
                 ' ret = sio_open(Port)
                  ret = sio_flush(Port, 2)                  '清接收发送缓冲区
                  Buflen = sio_write(Port, Arrcan(0), 7)    '发送读模块命令
                  
                  TimeDelay (100)        '延时 或者等待缓冲区有数据，效果是一样的
                    
                  Buflen = sio_read(Port, bufferin(0), 4)
                  
                
                If bufferin(0) = "!" And bufferin(1) = Arrcan(1) And bufferin(2) = Arrcan(2) Then
'                  Label1.Caption = "模块" & CStr(i) & "校准禁能!"
'                  Label1.ForeColor = vbRed
                  txtmsg.Text = txtmsg.Text & vbCrLf & "模块" & CStr(i) & "校准禁能!" & vbCrLf
                  ScrollText txtmsg
                  txtmsg.ForeColor = vbRed
                  Command1.Enabled = False
                  Command2.Enabled = False
                End If
            
            Next i
    
    If chkAuto = vbChecked Then
      Timer1.Enabled = True
    End If
    ret = sio_close(Port)
        
    End If
End Sub

Private Sub btnopen_Click()
   
   Dim ret As Integer
   If btnopen.Tag = "close" Then
        btnopen.Tag = "open"
        btnopen.Caption = "关闭串口"
        ret = sio_open(Port)
        If ret <> SIO_OK Then
           MsgBox "串口" & Port & "已打开,请检查", vbOKOnly + vbExclamation, "警告"
            btnopen.Tag = "close"
            btnopen.Caption = "打开串口"
            btnopen.Tag = "close"
            ret = sio_close(Port)
        ''---------buttons init--------------------------------
            btnseatch.Enabled = False
            btnchg.Enabled = False
            btnread.Enabled = False
            btnencal.Enabled = False
            Command1.Enabled = False
            Command2.Enabled = False
            chkAuto.Enabled = False
            Exit Sub
        End If
        ret = sio_ioctl(Port, B38400, P_NONE Or BIT_8 Or STOP_1)
   ''---------buttons init-------------------------------
        btnseatch.Enabled = True
        btnchg.Enabled = True
        btnread.Enabled = True
        btnencal.Enabled = True
        chkAuto.Enabled = True
       ' frm.ListView1.ListItems.Clear
   Else
        btnopen.Tag = "close"
        btnopen.Caption = "打开串口"
        btnopen.Tag = "close"
        ret = sio_close(Port)
    ''---------buttons init--------------------------------
        btnseatch.Enabled = False
        btnchg.Enabled = False
        btnread.Enabled = False
        btnencal.Enabled = False
        Command1.Enabled = False
        Command2.Enabled = False
         chkAuto.Enabled = False
        If chkAuto.Value = vbChecked Then
          chkAuto.Value = vbUnchecked
          chkAuto.Enabled = False
        End If
       ' Form_Load
      ' frm.ListView1.ListItems.Clear
   End If

End Sub


Private Sub btnread_Click()
   
   If chkAuto.Value = vbChecked Then
     Timer1.Enabled = False
   End If
    Call Readdata
   If chkAuto.Value = vbChecked Then
     Timer1.Enabled = True
   End If
  
    Frmtxtclr = Frmtxtclr + 1
    If Frmtxtclr >= 50 Then
      txtmsg.Text = ""
      Frmtxtclr = 0
    End If
   
End Sub

Private Sub btnseatch_Click()
    ' On Error Resume Next
     Dim ret As Integer
     Dim i As Integer
     Dim bufferin(5) As Byte      '定义一个暂存读入数据的容器
     Dim Arrcan(5) As Byte
     'Dim Buffer As Variant
     
     If chkAuto = vbChecked Then
       Timer1.Enabled = False
     End If
     If Val(Text1.Text) > 255 Or Val(Text2.Text) > 255 Then
           MsgBox "超出了最大的地址范围,请重新输入地址!", vbOKOnly + vbInformation, "提示"
           Text1.SetFocus
           Exit Sub
     End If
     If Trim(Text1.Text) = "" Or Not IsNumeric(Text1.Text) Or Trim(Text2.Text) = "" Or Not IsNumeric(Text2.Text) Then
       MsgBox "请添入正确的数据!", vbOKOnly + vbInformation, "提示"
       Text1.SetFocus
      Exit Sub
    End If
     ret = sio_open(Port)
     If btnseatch.Tag = "stop" Then
        btnseatch.Tag = "start"
        btnseatch.Caption = "停止搜索"
        
      
       
                For i = Val(Text1.Text) To Val(Text2.Text) Step 1
                     '----------------------用读 ~AA2
'说明: 读主看门狗超时间隔
'语法：~AA2[CHK](cr)
'测检温度模块是否存在,第一个如果是"!"则表示成功,如果是其它则表示无此模块-----------------
                     
                  
                     Arrcan(0) = Asc("~")
                     If i <= 15 Then
                        Arrcan(1) = Asc(0)
                        Arrcan(2) = Asc(i)
                     Else
                        Arrcan(1) = Asc(Mid(Hex(i), 1, 1))
                        Arrcan(2) = Asc(Mid(Hex(i), 2, 1))
                     End If
                     Arrcan(3) = Asc(2)
                     Arrcan(4) = &HD
                     Arrcan(5) = &HA
                     ret = sio_flush(Port, 2)                  '清接收发送缓冲区
                     Buflen = sio_write(Port, Arrcan(0), 6)    '发送读模块命令
                     
                     TimeDelay (100)        '延时 或者等待缓冲区有数据，效果是一样的
                       
                     Buflen = sio_read(Port, bufferin(0), 6)
                     
                     'ArrOK = inbuf
                   
                   If bufferin(0) = Asc("!") Then
                     Label1.Caption = "模块地址为" & Str(i) & "!"
                     Label1.ForeColor = vbBlue
                     ret = sio_close(Port)
                     Exit Sub
                   End If
            
               Next i
'               Label1.Caption = "模块一直没有找到!"
'               Label1.ForeColor = vbRed
'
               txtmsg.Text = txtmsg.Text & vbCrLf & "模块一直没有找到!" & vbCrLf
               txtmsg.ForeColor = vbRed
               ScrollText txtmsg
               ret = sio_close(Port)

        If chkAuto = vbChecked Then
          Timer1.Enabled = True
        End If
         
             
    ElseIf btnseatch.Tag = "start" Then
        btnseatch.Tag = "stop"
        btnseatch.Caption = "搜索地址"
        ret = sio_close(Port)
        Exit Sub
        
    End If
End Sub

Private Sub chkAuto_Click()
   If chkAuto.Value = vbChecked Then
      Timer1.Enabled = True
      btnread.Enabled = False
      Text6.Enabled = False
      Text9.Enabled = False
   Else
      Timer1.Enabled = False
      If btnopen.Tag = "open" Then
        btnread.Enabled = True
      End If
      Imgon.Visible = False
      Imgoff.Visible = False
      Text6.Enabled = True
      Text9.Enabled = True
   End If
   
End Sub

Private Sub Command1_Click() '--------零点校准  $AA1[CHK](cr)
   Dim Arrcan(5) As Byte
   Dim bufferin(3) As Byte
   Dim ret As Integer
   Dim sdata As String
   Dim i As Integer
   If Text8.Text = "" Then
           Text8.Text = Val(Text7.Text)
    End If
    'sdata = Replace(Format(Hex(Text7.Text), "@@"), " ", "0")  '-----先用format函数进行占位运算,然后用Replace函数进行替换运算
    For i = Val(Text7.Text) To Val(Text8.Text)
         sdata = Replace(Format(Hex(i), "@@"), " ", "0")
         Arrcan(0) = Asc("$")
         Arrcan(1) = Asc(Mid(sdata, 1, 1))
         Arrcan(2) = Asc(Mid(sdata, 2, 1))
         Arrcan(3) = Asc("1")
         Arrcan(4) = &HD
         Arrcan(5) = &HA
         ret = sio_open(Port)
         ret = sio_flush(Port, 2)                  '清接收发送缓冲区
         Buflen = sio_write(Port, Arrcan(0), 6)    '发送设置模块命令
         If Buflen < 0 Then
            MsgBox "发送数据失败!", vbOKOnly + vbCritical, "警告"
         End If
         
         TimeDelay (150)
         
         Buflen = sio_read(Port, bufferin(0), 4)
         If Buflen < 0 Then
            MsgBox "接收数据失败!", vbOKOnly + vbCritical, "警告"
        End If
         
         If bufferin(0) = Asc("?") Then
             MsgBox "校准失败!", vbOKOnly + vbCritical, "警告"
         ElseIf bufferin(0) = Asc("!") And bufferin(1) = Arrcan(1) And bufferin(2) = Arrcan(2) Then
              Label1.Caption = "模块" & i & "校准成功!"
              Label1.ForeColor = vbBlue
'              txtmsg.Text = txtmsg.Text & vbCrLf & "模块" & i & "校准成功!" & vbCrLf
'              txtmsg.ForeColor = vbBlue
'              ScrollText txtmsg
              
         End If
    Next i
    ret = sio_close(Port)
End Sub

Private Sub Command2_Click()
   Dim Arrcan(5) As Byte
   Dim bufferin(4) As Byte
   Dim ret As Integer
   Dim sdata As String
   Dim i As Integer
   If Text8.Text = "" Then
           Text8.Text = Val(Text7.Text)
        End If
    'sdata = Replace(Format(Hex(Text7.Text), "@@"), " ", "0")  '-----先用format函数进行占位运算,然后用Replace函数进行替换运算
    For i = Val(Text7.Text) To i = Val(Text8.Text)
         sdata = Replace(Format(Hex(i), "@@"), " ", "0")
         Arrcan(0) = Asc("$")
         Arrcan(1) = Asc(Mid(sdata, 1, 1))
         Arrcan(2) = Asc(Mid(sdata, 2, 1))
         Arrcan(3) = Asc("0")
         Arrcan(4) = &HD
         Arrcan(5) = &HA
         ret = sio_open(Port)
         ret = sio_flush(Port, 2)                  '清接收发送缓冲区
         Buflen = sio_write(Port, Arrcan(0), 6)    '发送设置模块命令
         If Buflen < 0 Then
            MsgBox "模块" & i & "发送数据失败!", vbOKOnly + vbCritical, "警告"
         End If
         
         TimeDelay (150)
         
         Buflen = sio_read(Port, bufferin(0), 4)
         If Buflen < 0 Then
            MsgBox "模块" & i & "接收数据失败!", vbOKOnly + vbCritical, "警告"
            
        End If
         
         If bufferin(0) = Asc("?") Then
             MsgBox "禁能失败!", vbOKOnly + vbCritical, "警告"
         ElseIf bufferin(0) = Asc("!") And bufferin(1) = Arrcan(1) And bufferin(2) = Arrcan(2) Then
              Label1.Caption = "模块" & i & "校准成功!"
              Label1.ForeColor = vbBlue
'            txtmsg.Text = txtmsg.Text & vbCrLf & "模块" & i & "校准成功!" & vbCrLf
'            txtmsg.ForeColor = vbBlue
'            ScrollText txtmsg
         End If
    Next i
    ret = sio_close(Port)
End Sub

Private Sub Form_Initialize()
    InitCommonControls
End Sub

Private Sub Form_Load()
    Dim ret As Long
    
    
    ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
    ret = ret Or WS_EX_LAYERED
    SetWindowLong Me.hWnd, GWL_EXSTYLE, ret
    Alpha = 10
    Timer2.Interval = 50
    
    btnopen.Tag = "close"
    btnopen.Caption = "打开串口"
    Text3.Text = 1
    btnopen.Tag = "close"
    Port = Val(Text3.Text)
   ' ret = sio_close(Port)
''---------buttons init--------------------------------
    btnseatch.Enabled = False
    btnchg.Enabled = False
    btnread.Enabled = False
    btnencal.Enabled = False
    Command1.Enabled = False
    Command2.Enabled = False
    chkAuto.Enabled = False
    Timer1.Enabled = False
    Timer1.Interval = 800
    Text1.Text = 1
    Text3.Text = 1
    Text4.Text = 1
    Text6.Text = 1
    Text7.Text = 1
    
    With frm.ListView1
        .ColumnHeaders.Add 1, , "MOD", 600
        .ColumnHeaders.Add 2, , "CH1", 680
        .ColumnHeaders.Add 3, , "CH2", 680
        .ColumnHeaders.Add 4, , "CH3", 680
        .ColumnHeaders.Add 5, , "CH4", 680
        .ColumnHeaders.Add 6, , "CH5", 680
        .ColumnHeaders.Add 7, , "CH6", 680
        .ColumnHeaders.Add 8, , "CH7", 680
        .ColumnHeaders.Add 9, , "CH8", 680

    End With
    
    
    
    
End Sub

Private Sub Text3_Change()
   Port = Val(Text3.Text)
End Sub

Private Sub Timer1_Timer()
   ' Dim flag As Boolean
    'btnread_Click
    flag = Not flag
    If flag = False Then
      Imgoff.Visible = True
      Imgon.Visible = False
    Else
      Imgon.Visible = True
      Imgoff.Visible = False
    End If
'    If Text9.Text <> "" Then
'      Timer1.Interval = CInt((Val(Text9.Text) - Val(Text6.Text)) * 500)
'    End If
    btnread_Click
End Sub

Private Sub Timer2_Timer()
    Alpha = Alpha + 20
If Alpha > 255 Then
   Timer2.Enabled = False
Exit Sub
End If
    SetLayeredWindowAttributes Me.hWnd, 0, Alpha, LWA_ALPHA
End Sub