//窗体 程序
Option Explicit
Dim DataFromCom As Single '从串口读过来的实时值
Dim DataFromComLast As Single '上次的串口值 Dim TimeCount As Integer 'Dim strBuff As String Private Sub PicScale(picX As PictureBox) '调整图像框的坐标系 picX.Scale (0, picX.ScaleHeight)-(picX.ScaleWidth, -picX.ScaleHeight) End Sub Private Sub PicMidleLine(picX As PictureBox) '在图像框中画一条中线
picX.Line (0, 0)-(picX.ScaleWidth, 0), vbWhite '画出中线 End Sub Private Sub Combo1_Click()
If MSComm1.PortOpen = True Then '如果串口打开先关闭后再进行其他操作 MSComm1.PortOpen = False End If MSComm1.CommPort = Combo1.ListIndex + 1 '读取com口号 End Sub Private Sub Command1_Click()
On Error GoTo uerror '发现错误跳转到错误处理
If Command1.Caption = "关闭串口" Then MSComm1.PortOpen = False Command1.Caption = "打开串口" '按钮文字改变 Shape1.FillColor = &HFFFFC0 '灯颜色改变 Command2.Caption = "开始测温" Timer1.Enabled = False '关闭定时器 Shape2.FillColor = vbWhite '指示灯 Else MSComm1.PortOpen = True Command1.Caption = "关闭串口" Shape1.FillColor = &HFF End If
Exit Sub uerror:
MsgBox " 无效串口号"
End Sub Private Sub Command2_Click()
If MSComm1.PortOpen = False Then GoTo uerror '发现错误跳转到错误处理 If Command2.Caption = "开始测温" Then
Command2.Caption = "停止测温" Shape2.FillColor = vbGreen Timer1.Enabled = True Else
Command2.Caption = "开始测温" Timer1.Enabled = False Shape2.FillColor = vbWhite
End If Exit Sub uerror:
MsgBox " 串口未打开" End Sub Private Sub Command3_Click()
Unload Form1 End Sub Private Sub Form_Load()
Dim i As Integer PicScale Picture1 '调整图像框的坐标系
PicMidleLine Picture1 '在图像框中画一条中线 Label3.Caption = "使用11.0592M晶振" Timer1.Enabled = False '停止定时器 If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False Else End If For i = 1 To 16
Combo1.AddItem ("com" & CStr(i)) '用for循环在combobox中添加com1到com16 十六个串口 Next Combo1.ListIndex = 0 '运行则combobox中默认为com1
'Combo1.Text = Combo1.List(0) '运行则combobox中默认为com1 MSComm1.CommPort = Combo1.ListIndex + 1
MSComm1.Settings = "9600,n,8,1" Command1.Caption = "打开串口" Shape1.FillColor = &HFFFFC0 End Sub
Private Sub DrawRealLine(picX As PictureBox, TimeCountX As Integer, DataFromComX As Single, DataFromComLastX As Single, coloruser) If TimeCountX - 1 >= 0 Then
picX.Line ((TimeCountX - 1) * 100, DataFromComLastX)-(TimeCountX * 100, DataFromComX), coloruser End If
End Sub
Private Sub Timer1_Timer()
Dim strBuff As String strBuff = strBuff + MSComm1.Input '读入到缓冲区
TimeDelay 500 Label1.Caption = strBuff DataFromCom = Val(strBuff) Label3.Caption = Now TimeCount = TimeCount + 1 '时间轴 加1
DrawRealLine Picture1, TimeCount, DataFromCom * 30, DataFromComLast * 30, &HFFFF& '画出实时的曲线4
If TimeCount > 100 Then Picture1.Cls TimeCount = 0 PicMidleLine Picture1 '在图像框中画一条中线 End If
DataFromComLast = DataFromCom End Sub //添加模块 程序
Declare Function GetTickCount Lib "kernel32" () As Long
Sub TimeDelay(t As Long)
'时间延迟子程序,单位是毫秒(ms) Dim TT& TT = GetTickCount() Do DoEvents Loop Until GetTickCount() - TT >= t End Sub '等待RS字符串返回,或是时间到达 'Comm是通信控件名称 'RS是欲等待的字符 'DT是最长的等待时间 '正常时返回值是所得的完整字符串,不正常时返回值是空字符串 Function WaitRS(Comm As MSComm, RS As String, DT As Long) As String Dim Buf$, TT As Long Buf = "" TT = GetTickCount Do Buf = Buf & Comm.Input Loop Until InStr(1, Buf, RS) > 0 Or GetTickCount - TT >= DT If InStr(1, Buf, RS) > 0 Then WaitRS = Buf Else WaitRS = "" End If End Function |
|