PC机串口温度采集系统

PC机串口温度采集系统

Option Explicit
Dim inputsignal As String
Dim cc As String
Dim x1 As String, x2 As String, x3 As String, x4 As String, x5 As String
Dim comset_temp As String
Dim datatemp(1000) As Single
Dim rx_count As Integer
Const zleft As Single = -10
Const ztop As Single = 50
Const zright As Single = 100
Const zbottom As Single = -10

Private Sub Combo1_click()
Combo1.ForeColor = RGB(255, 0, 0)
Combo1.BackColor = RGB(12, 0, 0)
Call comm_set

End Sub

Private Sub Combo2_click()
Combo2.ForeColor = RGB(255, 0, 0)
Combo2.BackColor = RGB(12, 0, 0)
Call comm_set
End Sub

Private Sub Combo3_click()
Combo3.ForeColor = RGB(255, 0, 0)
Combo3.BackColor = RGB(12, 0, 0)
Call comm_set
End Sub

Private Sub Combo4_click()
Combo4.ForeColor = RGB(255, 0, 0)
Combo4.BackColor = RGB(12, 0, 0)
Call comm_set
End Sub

Private Sub Combo5_click()
Combo5.ForeColor = RGB(255, 0, 0)
Combo5.BackColor = RGB(12, 0, 0)
Call comm_set

End Sub

 

Private Sub Command1_Click()
MSComm1.PortOpen = True
End Sub

Private Sub Command2_Click()
MSComm1.PortOpen = False
End Sub

Private Sub Form_Load()
Combo1.AddItem "COM1"
Combo1.AddItem "COM2"
Combo1.AddItem "COM3"
Combo1.AddItem "COM4"
'波特率
Combo2.AddItem "300"
Combo2.AddItem "600"
Combo2.AddItem "1200"
Combo2.AddItem "2400"
Combo2.AddItem "4800"
Combo2.AddItem "9600"
Combo2.AddItem "19200"
Combo2.AddItem "38400"
Combo2.AddItem "43000"
Combo2.AddItem "115200"
'校验位
Combo3.AddItem "N"
Combo3.AddItem "E"
Combo3.AddItem "O"
'数据位
Combo4.AddItem "9"
Combo4.AddItem "8"
Combo4.AddItem "7"
Combo4.AddItem "6"
'停止位
Combo5.AddItem "1"
Combo5.AddItem "2"

Combo1.Text = "COM1"
Combo2.Text = "9600"
Combo3.Text = "N"
Combo4.Text = "8"
Combo5.Text = "1"
x1 = Combo1.Text
x2 = Combo2.Text
x3 = Combo3.Text
x4 = Combo4.Text
x5 = Combo5.Text
rx_count = 0
Timer1.Enabled = True
Timer1.Interval = 300
Call comm_set
Call zuobiaoxi
Call tabinit
End Sub

Public Sub comm_set()
    x1 = Combo1.Text
    x2 = Combo2.Text
    x3 = Combo3.Text
    x4 = Combo4.Text
    x5 = Combo5.Text
    MSComm1.InputLen = 0            '表示一次读取所有数据
    MSComm1.InBufferSize = 512
    MSComm1.InBufferCount = 0
    MSComm1.OutBufferSize = 512
    MSComm1.OutBufferCount = 0
    MSComm1.RThreshold = 1          '每接收一个字符触发一次oncomm事件
    MSComm1.SThreshold = 1

    MSComm1.CommPort = Val(Right(x1, 1))
    comset_temp = x2 & "," & x3 & "," & x4 & "," & x5
    MSComm1.Settings = (comset_temp)
End Sub

Private Sub mscomm1_oncomm()
Select Case MSComm1.CommEvent
    Case comEvReceive
        inputsignal = MSComm1.Input
        Text2.Text = Format$(inputsignal, "00.0") & "  C"
        datatemp(rx_count) = Val(Trim(inputsignal))
       
        If rx_count >= 100 Then
            rx_count = 0
            Call renew
        End If
        If rx_count >= 2 Then
            Call draw(rx_count)
            Call draw_tab
   
        End If
        rx_count = rx_count + 1
    Case comEvSend
End Select
End Sub
'绘制曲线
Private Sub draw(rx_count)
Dim i As Integer
Dim x1, y1, x2, y2
'Picture1.Cls
'Call zuobiaoxi
Picture1.ScaleMode = 3
Picture1.BackColor = vbGreen
Call zuobiaoxi
Picture1.CurrentX = 0: Picture1.CurrentY = 0: Picture1.Print 0
Picture1.DrawWidth = 1
    For i = 1 To rx_count - 1
    x1 = (i - 1): y1 = datatemp(i - 1)
    x2 = i: y2 = datatemp(i)
    Picture1.Line (x1, y1)-(x2, y2), vbRed
    Next i
End Sub

'**********************************绘制坐标系
Private Sub zuobiaoxi()
Dim i
Picture1.ScaleMode = 3
Picture1.BackColor = vbGreen
Picture1.ForeColor = vbBlack
Picture1.DrawWidth = 2
Picture1.Scale (zleft, ztop)-(zright, zbottom)
Picture1.CurrentX = 0: Picture1.CurrentY = 0: Picture1.Print 0
Picture1.Line (zleft, 0)-(zright, 0)  '画X轴
Picture1.CurrentX = 0.95 * (zright): Picture1.CurrentY = 5: Picture1.Print "x"
Picture1.Line (0, ztop)-(0, zbottom)  '画Y轴
Picture1.CurrentX = 1: Picture1.CurrentY = 0.95 * ztop: Picture1.Print "y"
'画x轴上面的刻度
For i = zleft To zright Step 10
Picture1.CurrentY = 0
Picture1.CurrentX = i
Picture1.PSet (i, 0.02)
Picture1.Print i
Next i
'画y轴上面的刻度
For i = zbottom To ztop Step 10
Picture1.CurrentX = 0
Picture1.CurrentY = i
Picture1.PSet (0.8, i)
Picture1.Print i
Next i
End Sub
'刷新图片显示区
Private Sub renew()
Dim i
Picture1.Cls
Call zuobiaoxi
For i = 0 To rx_count
    datatemp(rx_count) = 0
Next i
rx_count = 0

'清空表格显示的数据
Grid.Col = 1
For i = 1 To 100
Grid.Row = i
Grid.Text = ""
Next i
End Sub
Public Sub tabinit()
Dim i
Grid.Cols = 2   '设置列数
Grid.Rows = 200 + 1  '设置行数
Grid.ColWidth(0) = 700  '设置第0行宽度
Grid.ColWidth(1) = 950  '设置第1行宽度

'初始化序号
Grid.Col = 0
For i = 1 To 100
Grid.Row = i
Grid.Text = "  " + Str$(i)
Next i

'设置表格的标题
Grid.Row = 0
Grid.Col = 0: Grid.Text = "  序号"
Grid.Col = 1: Grid.Text = "  温度"
Grid.TopRow = 1 '从第一行
Grid.LeftCol = 1    '第一列开始
End Sub

Public Sub draw_tab()
Grid.Col = 1
Grid.Row = rx_count - 1
Grid.Text = Format$(datatemp(rx_count), "00.0") & " C"
End Sub

文件:	PC机串口温度采集系统.rar
大小:	8KB
下载:	下载