用VB6.0实现温度曲线实时显示功能

Dim px(49) As Single, py(49) As Currency '二维数组
Dim col As Integer
Dim pl As Integer
Public P As Currency

Private Sub Command1_Click() '开/关定时器
Cls

Picture1.Scale (-10, 70)-(110, -5)
For i = 70 To 0 Step -10
Picture1.Line (-10, i)-(-8, i)

Picture1.Print i
Next i
For j = 0 To 110 Step 10
Picture1.Line (j, -5)-(j, -1)

Picture1.Print j / 10
Next j
If Timer1.Enabled = True Then
Command1.Caption = "暂停"
Timer1.Enabled = False
Else
  Command1.Caption = "开始"
  Timer1.Enabled = True
  End If
End Sub

Private Sub Command2_Click() '退出
End
End Sub


Private Sub Command7_Click()
If Timer2.Enabled = True Then
Command7.Caption = "暂停"
Timer2.Enabled = False
Else
  Command7.Caption = "开始"
  Timer2.Enabled = True
  End If
End Sub


Private Sub Form_Load()

MSComm1.CommPort = 1
MSComm1.Settings = "9600,N,8,1"
MSComm1.InputMode = comInputModeBinary
MSComm1.InputLen = 0
MSComm1.InBufferCount = 0
MSComm1.OutBufferCount = 0
Text1.Text = " "
Text2.Text = " "
MSComm1.RThreshold = 1
MSComm1.SThreshold = 0
If MSComm1.PortOpen = False Then
   MSComm1.PortOpen = True
End If
Timer1.Enabled = False
Picture2.Scale (0, 70)-(110, 0) '自定义坐标系

For i = 0 To 2
  Text4(i).Enabled = False
Next i
CmdSave.Enabled = False

End Sub



Private Sub MSComm1_OnComm()
Dim indata As Variant
Dim arr() As Byte
Dim str As String
Dim i As Integer
Dim rev_num As Integer
Dim j As Integer
Dim B As String
Dim hex1 As String
Dim tmp As String
Dim result As Currency
Dim k As Integer
Dim m As Integer
Select Case MSComm1.CommEvent
Case comEvReceive
indata = MSComm1.Input
arr() = indata
rev_num = UBound(arr)
ReDim lnum(0 To rev_num) As Integer
For i = 0 To rev_num
lnum(i) = arr(i)

str = str & Hex(lnum(i)) & Chr(32)
Next i
Text2.Text = Text2.Text + str

hex1 = Mid(Text2.Text, 11, 5) '转化成十进制
For j = 1 To Len(hex1)
   Select Case Mid(hex1, j, 1)
        Case "0": B = B & "0000"
        Case "1": B = B & "0001"
        Case "2": B = B & "0010"
        Case "3": B = B & "0011"
        Case "4": B = B & "0100"
        Case "5": B = B & "0101"
        Case "6": B = B & "0110"
        Case "7": B = B & "0111"
        Case "8": B = B & "1000"
        Case "9": B = B & "1001"
        Case "A": B = B & "1010"
        Case "B": B = B & "1011"
        Case "C": B = B & "1100"
        Case "D": B = B & "1101"
        Case "E": B = B & "1110"
        Case "F": B = B & "1111"
   End Select
    Next j
    k = Len(B)
For m = k To 1 Step -1
    tmp = Mid(B, m, 1)
    If tmp = "1" Then result = result + 2 ^ (k - m - 4)
Next m
  
Text3.Text = result
P = result
MSComm1.InBufferCount = 0
End Select
End Sub



Private Sub Timer1_Timer()
Dim y As Currency
Picture2.Cls

Dim number As Variant
Dim outbyte(4) As Byte
Dim i As Integer
Text2.Text = " "
Text2.SetFocus
For i = 0 To 4
outbyte(i) = Val("&H" & Mid(Text1.Text, i * 3 + 1, 3))
Next i
MSComm1.Output = outbyte
MSComm1.OutBufferCount = 0
    '画图程序
If col < 12 Then

For i = col To col
    x = 10 * i
    y = P
    px(i) = x  ' 当前点坐标
    py(i) = y
Next i
     col = col + 1
    pl = pl + 1
    '以上调试合格
    ElseIf col < 49 Then '12<col<24
   
    For i = col To col
       py(col) = P
       Next i
       For t = 0 To col
       px(t) = 110 - 10 * (col - t)
       Next t
       col = col + 1
    Else
   
       For t = 0 To 48
       py(t) = py(t + 1)
       px(t) = 120 - 10 * (col - t)
       Next t
      
       py(48) = P
    End If

If pl >= 2 Then
   
    Picture2.PSet (px(0), py(0))
      For i = 1 To col
        Picture2.Line -(px(i - 1), py(i - 1)), QBColor(2)
      Next i
   
End If
   
End Sub

Private Sub CmdAdd_Click()     '添加记录
Adodc1.Recordset.AddNew
For i = 0 To 2
   Text4(i).Enabled = True
   Text4(i).Text = ""
Next i
Text4(0).SetFocus
CmdAdd.Enabled = False
CmdDelete.Enabled = False
CmdModify.Enabled = False
CmdSave.Enabled = True
End Sub
Private Sub CmdModify_Click()     '修改记录
If Adodc1.Recordset.RecordCount <> 0 Then
   For i = 0 To 2
     Text4(i).Enabled = True
   Next i
   CmdSave.Enabled = True
   CmdAdd.Enabled = False
   CmdModify.Enabled = False
   CmdDelete.Enabled = False
Else
   MsgBox ("没有要修改的数据!")
End If
End Sub
Private Sub CmdDelete_Click()     '删除记录
Dim myval As String
myval = MsgBox("是否要删除该记录？", vbYesNo)
If myval = vbYes Then
  Adodc1.Recordset.Delete
  Adodc1.Recordset.MoveNext
  If Adodc1.Recordset.EOF = True Then Adodc1.Recordset.MoveLast
    For i = 0 To 2
        Text4(i).Enabled = False
    Next i
End If
End Sub
Private Sub CmdSave_Click()
If Text4(0).Text = "" Then
   MsgBox "编号不允许为空！"
   Exit Sub
End If
If Text4(1).Text = "" Then
   MsgBox "时间不允许为空！"
   Exit Sub
End If
If Text4(2).Text = "" Then
   MsgBox "温度不允许为空！"
   Exit Sub
End If

Adodc1.Recordset.Update     '更新记录
'设置控件不可用
For i = 0 To 2
     Text1(i).Enabled = False
Next i
CmdSave.Enabled = False
CmdAdd.Enabled = True
CmdModify.Enabled = True
CmdDelete.Enabled = True
End Sub
Private Sub CmdExit_Click()
  Unload Me
End Sub

Private Sub Timer2_Timer()
Adodc1.Recordset.AddNew
Text4(0).Text = "01"
Text4(1).Text = Now
Text4(2).Text = P
Adodc1.Recordset.Update
CmdAdd.Enabled = False
CmdDelete.Enabled = False
CmdModify.Enabled = False
CmdSave.Enabled = True
End Sub