frmmain.frm

上位机程序

Private Sub cmdOpenCOM_Click()
  '判断端口号码是否落在1--16之间
  If cmbCOM.ListIndex >= 0 And cmbCOM.ListIndex <= 16 Then
    MSComm1.CommPort = cmbCOM.ListIndex + 1
    Shpled.FillColor = &HC000&
  Else
    MsgBox "指定通信端口时发生错误！", vbCritical + vbOKOnly, "系统信息"
    Exit Sub
  End If
  '激活错误检测机制
  On Error GoTo comErr
  MSComm1.Settings = "9600,n,8,1"  '设定通信参数
  MSComm1.PortOpen = True          '打开通信端口
 
  cmdOpenCOM.Enabled = False       '将此按钮设为禁用状态
  cmdStart.Enabled = True          '激活【开始检测】按钮
  lblMsg.Caption = "请点击【开始检测】按钮执行检测工作"
  Exit Sub
comErr:
  MsgBox "打开通信端口时发生错误！请确定通信端口存在且正常。", vbCritical + vbOKOnly, "系统信息"
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'单击【开始检测】按钮后激活此事件
'将定时器激活或关闭，并显示对应的文字在按钮上，以指示用户操作
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdStart_Click()
  Timer1.Enabled = Not Timer1.Enabled
  If Timer1.Enabled Then
    cmdStart.Caption = "停止检测"
    lblMsg.Caption = "系统正在进行检测中"
  Else
    cmdStart.Caption = "开始检测"
    lblMsg.Caption = "系统已停止检测"
  End If
End Sub

Private Sub Command1_Click()
Dim num As Integer
'Dim outaddr(0) As Byte
'Dim outcode(0) As Byte
Dim outdata(0) As Byte
'Dim Data As Integer
'Dim Data1 As Integer
'Dim Data3 As Integer
'Dim i As Integer
'Dim sentnum(0 To 1) As Integer
'Dim outdata(0 To 1) As Byte
 

Data1 = Val(Text1.Text)
'Data11 = Val(Mid(Text1.Text, 3, 4))
'Data111 = Data11 + 200
'Data1 = (Data / 10) * 16
'Data2 = Data % 10
'Data3 = Data1 + Data2
'outaddr(0) = CByte(0) '地址
'outcode(0) = CByte(Data111) '命令字
outdata(0) = CByte(Data1) '数据

'MSComm1.OutBufferCount = 0
'MSComm1.Output = outaddr() '动态数组

MSComm1.OutBufferCount = 0
MSComm1.Output = outdata() '动态数组

'MSComm1.OutBufferCount = 0
'MSComm1.Output = outcode() '动态数组
'sentnum(0) = Val(Text1.Text)
'sentnum(1) = Val(Text2.Text)

'outdata(0) = CByte(sentnum(0))
'outdata(1) = CByte(sentnum(1))
MSComm1.OutBufferCount = 0 '发送缓冲区清空
'MSComm1.Output = outdata() '动态数组
Text4.SetFocus
End Sub

Private Sub Command2_Click()
 Dim num As Integer
'Dim outaddr(0) As Byte
'Dim outcode(0) As Byte
Dim outdata(0) As Byte
'Dim Data2 As Integer

Dim Data3 As Single
'Dim i As Integer
'Dim sentnum(0 To 1) As Integer
'Dim outdata(0 To 1) As Byte

Data2 = Val(Text2.Text)
Data3 = Data2 + 100
'Data21 = Val(Mid(Text2.Text, 3, 4))
'Data22 = Data21 + 210
'Data1 = (Data / 10) * 16
'Data2 = Data % 10
'Data3 = Data1 + Data2
'outaddr(0) = CByte(0) '地址
'outcode(0) = CByte(Data22) '命令字
outdata(0) = CByte(Data3) '数据

'MSComm1.OutBufferCount = 0
'MSComm1.Output = outaddr() '动态数组

MSComm1.OutBufferCount = 0
MSComm1.Output = outdata() '动态数组
'MSComm1.OutBufferCount = 0
'MSComm1.Output = outcode() '动态数组

'sentnum(0) = Val(Text1.Text)
'sentnum(1) = Val(Text2.Text)

'outdata(0) = CByte(sentnum(0))
'outdata(1) = CByte(sentnum(1))
MSComm1.OutBufferCount = 0 '发送缓冲区清空
'MSComm1.Output = outdata() '动态数组
 Text3.SetFocus
End Sub

Private Sub Command3_Click()
pic_count = pic_count + 1
SavePicture picVoltage.Image, "d:\" & Str(Date) & "Picture_" & Trim(Str(pic_count)) & ".jpg"  ' 保存图片
MsgBox "数据及曲线保存于D:\...中"

End Sub

Private Sub Command4_Click()
NowX = 1
picVoltage.Cls '清除图形
 picVoltage.PSet (0, ValueStr)  '设定起点
End Sub

Private Sub Command5_Click()
Dim num As Integer
'Dim outaddr(0) As Byte
'Dim outcode(0) As Byte
Dim outdata(0) As Byte
'Dim Data2 As Integer


'Dim i As Integer
'Dim sentnum(0 To 1) As Integer
'Dim outdata(0 To 1) As Byte

Data5 = Val(Text3.Text)
Data51 = Data5 + 210
'outaddr(0) = CByte(0) '地址
'outcode(0) = CByte(Data22) '命令字
outdata(0) = CByte(Data51) '数据

'MSComm1.OutBufferCount = 0
'MSComm1.Output = outaddr() '动态数组

MSComm1.OutBufferCount = 0
MSComm1.Output = outdata() '动态数组
'MSComm1.OutBufferCount = 0
'MSComm1.Output = outcode() '动态数组

'sentnum(0) = Val(Text1.Text)
'sentnum(1) = Val(Text2.Text)

'outdata(0) = CByte(sentnum(0))
'outdata(1) = CByte(sentnum(1))
MSComm1.OutBufferCount = 0 '发送缓冲区清空
'MSComm1.Output = outdata() '动态数组
Text1.SetFocus
End Sub

Private Sub Command6_Click()
Dim num As Integer
'Dim outaddr(0) As Byte
'Dim outcode(0) As Byte
Dim outdata(0) As Byte
'Dim Data2 As Integer


'Dim i As Integer
'Dim sentnum(0 To 1) As Integer
'Dim outdata(0 To 1) As Byte

Data6 = Val(Text4.Text)
Data61 = Data6 + 200
'outaddr(0) = CByte(0) '地址
'outcode(0) = CByte(Data22) '命令字
outdata(0) = CByte(Data61) '数据

'MSComm1.OutBufferCount = 0
'MSComm1.Output = outaddr() '动态数组

MSComm1.OutBufferCount = 0
MSComm1.Output = outdata() '动态数组
'MSComm1.OutBufferCount = 0
'MSComm1.Output = outcode() '动态数组

'sentnum(0) = Val(Text1.Text)
'sentnum(1) = Val(Text2.Text)

'outdata(0) = CByte(sentnum(0))
'outdata(1) = CByte(sentnum(1))
MSComm1.OutBufferCount = 0 '发送缓冲区清空
'MSComm1.Output = outdata() '动态数组
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'窗体的Load事件
'输入图形暂时设为灰色，表示无状态信息进入
'将通讯端口号码及站号填入Combo控件；并默认二者的选项是第一个
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
  Dim i%
  MaxPlotNo = 100
  cmbCOM.Clear
  cmbCOM.AddItem "COM1"
  cmbCOM.AddItem "COM2"
   cmbCOM.AddItem "COM3(USB)"
  cmbCOM.AddItem "COM4(USB)"
  cmbCOM.AddItem "COM5"
  cmbCOM.AddItem "COM6"
   cmbCOM.AddItem "COM7"
  cmbCOM.AddItem "COM8"
 '  cmbCOM.AddItem "COM9"
 ' cmbCOM.AddItem "COM10"
  ' cmbCOM.AddItem "COM11"
  'cmbCOM.AddItem "COM12"
  ' cmbCOM.AddItem "COM12"
  'cmbCOM.AddItem "COM14"
  ' cmbCOM.AddItem "COM15"
  'cmbCOM.AddItem "COM16"
  cmbCOM.ListIndex = 0
  cmdStart.Enabled = False
  '以下设定绘图范围，(Xmin,YMax)-(XMax,YMin)
  picVoltage.Scale (0, 100)-(MaxPlotNo, 0)
  picVoltage.DrawWidth = 2.5 '使用三个像素宽度的画笔
  h = Shp1.Height   '温度计初始高度
  tp = Shp1.Top
   h1 = Shape2.Height   '温度计初始高度
  tp1 = Shape2.Top
  
   pic_count = 0
End Sub

Private Sub Text1_Change()
Dim message
If Text1.Text = "" Then
Text1.Text = 0
End If
'If Text1.Text < 0 Or Text1.Text > 99 Then
'message = MsgBox("数据超出范围，请重新输入", 64, "提示")
'Text1.Text = 0
'End If
If Len(Text1.Text) > 1 Then
        Command1.SetFocus
        End If
End Sub



Private Sub Text2_Change()
Dim message
If Text2.Text = "" Then
Text2.Text = 0
End If
'If Text2.Text < 0 Or Text2.Text > 99 Then
'message = MsgBox("数据超出范围，请重新输入", 64, "提示")
'Text2.Text = 0
'End If

If Len(Text2.Text) > 1 Then
        Command2.SetFocus
End If
End Sub

Private Sub Text3_Change()
Dim message
If Text3.Text = "" Then
Text3.Text = 0
End If
If Len(Text3.Text) > 0 Then
        Command5.SetFocus
End If
End Sub

Private Sub Text4_Change()
Dim message
If Text4.Text = "" Then
Text4.Text = 0
End If
If Len(Text4.Text) > 0 Then
        Command6.SetFocus
End If
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'定时器的Timer事件引发后，就不断地执行其中的程序。
'将模拟读值命令送出，再取得返回字符串并判断。
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Timer1_Timer()

    Dim Buf$, ValueStr As Single, ValueStr1 As Single, ValueStr2 As Single, Pos1%
 Buf$ = Buf$ + MSComm1.Input
 TimeDelay 960
  ValueStr = Val(Mid(Buf, Pos1 + 1, 7)) '分离出正号以后的数值
  ValueStr1 = Val(Mid(Buf, Pos1 + 8, 12)) '分离出正号以后的数值
  ValueStr2 = Val(Mid(Buf, Pos1 + 14, 18)) '分离出正号以后的数值
  ValueStr3 = Val(Mid(Buf, Pos1 + 20, 22)) '分离出正号以后的数值 gaowen
  ValueStr4 = Val(Mid(Buf, Pos1 + 23, 25)) '分离出正号以后的数值 diwen
  lblValue.Caption = Format(ValueStr, "000.00") & "℃"  '显示在画面上
  Shp1.Height = (ValueStr / 130) * h + 0.15 * h '模拟温度计水银柱
     Shp1.Top = tp + (h - Shp1.Height)
     Shape2.Height = 0.65 * h1    'h1 - 0.15 * h1 模拟温度计水银柱
      Shape2.Top = tp1 + (h1 - Shape2.Height)
       Label1(29).Visible = False
           Label1(30).Visible = False
            
     If ValueStr3 > 0 Then
      Shape2.Height = 0.85 * h1    'h1 - 0.15 * h1 模拟温度计水银柱
      Shape2.Top = tp1 + (h1 - Shape2.Height)
       Label1(29).Visible = True
           Label1(30).Visible = False
            
      End If
      
      If ValueStr4 > 0 Then
      Shape2.Height = 0.15 * h1  'h1 - 0.85 * h1 模拟温度计水银柱
      Shape2.Top = tp1 + (h1 - Shape2.Height)
       Label1(29).Visible = False
           Label1(30).Visible = True
 
      End If
      
     
    ' ValueStr1 = Val(Mid(Buf1, Pos2 + 1, 3)) '分离出正号以后的数值
    ' ValueStr2 = Val(Mid(Buf2, Pos3 + 1, 3)) '分离出正号以后的数值
     Label4.Caption = Format(ValueStr1, "00.00") & "℃" '显示设置的高温数据
     Label5.Caption = Format(ValueStr2, "00.00") & "℃" '显示设置的低温数据
  If NowX = 0 Then
    picVoltage.Cls '清除图形
    picVoltage.PSet (0, ValueStr)  '设定起点
  Else
    '以下判断现在的读值是否大于前一次的读值，若是，则以红色绘线
    '若否，则以蓝色绘线
    If ValueStr > PreValue + 0.01 Then
      picVoltage.Line -(NowX, ValueStr), RGB(255, 0, 0) '由上一次的位置画至此点
    ElseIf ValueStr < PreValue + 0.01 Then
      picVoltage.Line -(NowX, ValueStr), RGB(0, 0, 255) '由上一次的位置画至此点
    '  ElseIf ValueStr = PreValue Then
   ' picVoltage.Line -(NowX, ValueStr), RGB(0, 255, 0) '由上一次的位置画至此点
    End If
  End If
  
  PreValue = ValueStr
  NowX = NowX + 1 '位置加1
  If NowX > MaxPlotNo Then NowX = 0  '超过范围则数值归零
   Label3.Caption = "当前时间：" & Date & "   " & Time
   If (ValueStr > ValueStr2 And ValueStr < ValueStr1) Then '温度正常
           Shp1.BackColor = &HFF0000      '变回蓝色
           Shp1.FillColor = &HFF0000
           Shape9.FillColor = &HFF0000
           Shape9.BorderColor = &HFF0000
           Label1(23).Visible = False
           Label1(24).Visible = False
          ' MMControl1.Command = "close"
        
           
    ElseIf (ValueStr <= ValueStr2 And ValueStr < ValueStr1) Then '温度低于下限
           Shp1.BackColor = &HFFFF&                '变回黄色
           Shp1.FillColor = &HFFFF&
           Shape9.FillColor = &HFFFF&
           Shape9.BorderColor = &HFFFF&
           Label1(23).Visible = True
           Label1(24).Visible = False
          
           
    Else                                                 '温度高于上限
            Shp1.BackColor = &HFF&                       '变回红色
           Shp1.FillColor = &HFF&
           Shape9.FillColor = &HFF&
           Shape9.BorderColor = &HFF&
           Label1(23).Visible = False
           Label1(24).Visible = True
          ' MMControl1.Command = "close"
          
    End If
   
'End Select
End Sub