分享

单片机与vb温度测试程序

 VB.NET小公主 2010-08-16
//窗体 程序
 
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

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多