form1.frm

基于MSCOMM的炉温控制系统上位机程序

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub Label10_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub Label5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub Minghao_XP_form1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub Minghao_XP_form1_Unload()

End Sub

Private Sub MSComm1_OnComm()
Dim ValueTime As Double
Dim val(4)  As Integer

Static Count As Integer
Select Case MSComm1.CommEvent
   Case comEvReceive
     MSComm1.InputMode = comInputModeBinary
     MSComm1.InputLen = 0
     buffer = MSComm1.Input
     For i = LBound(buffer) To UBound(buffer)
      If buffer(i) <> "" Then
         temp(Count) = CInt(buffer(i))
         Count = Count + 1
         If Count = 3 Then
            Count = 0
            Value = Filter '滤波
            Value1 = Value * 20 / 51 '转换为温度
            Temper = Format(Value1, "00.0") '显示温度
            Label11.Caption = Temper
            PIDvalue = PIDprocess(CDbl(Label12.Caption), CDbl(Temper)) '计算PID的值
            Text3.Text = PIDvalue
            If PIDvalue >= 0 Then '当温度低于设定值时
                ValueTime = (Text1.Text) / 255 * PIDvalue '算出时间
                TimeValue = FormatNumber(ValueTime, 1) '格式化时间如：3.2
                Text2.Text = CStr(TimeValue) '显示时间
                Str(0) = CByte(Asc("h")) '发送加热信号
                MSComm1.Output = Str
                Str(0) = 1
                MSComm1.Output = Str
                StartHost = True
                'Timer2.Enabled = True ''开始计时，
                
            ElseIf PIDvalue < 0 Then
                PIDvalue = Abs(PIDvalue)
                 ValueTime = (Text1.Text) / 255 * PIDvalue '算出时间
                TimeValue = FormatNumber(ValueTime, 1) '格式化时间如：3.2
                Text2.Text = CStr(TimeValue) '显示时间
                Str(0) = CByte(Asc("c")) '发送信号
                MSComm1.Output = Str
                Str(0) = 1
                MSComm1.Output = Str
                StartHost = True
                'Timer2.Enabled = True ''开始计时，
                
            End If
            Call WriteDatabase
            Trend1.AddXY 0, Time - Tim, Temper
            StatusBar1.Panels(2).Text = "最大值:" & Format$(Trend1.StatMax(0), "00.0") & " 最小值:" & Format$(Trend1.StatMin(0), "00.0") _
            & " " & "平均值:" & Format$(Trend1.StatAvg(0), "00.0")
            
            Trend1.Refresh
         End If
      End If
     Next
End Select
 
End Sub

Private Sub reportdata_Click()

End Sub

Private Sub reportdata_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

End Sub

Private Sub Slider1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub Slider1_Scroll()
Text1.Text = Slider1.Value

Trend1.XMax = Trend1.XMin + 1 / 24 / 6 * CInt(Text1.Text) * 5 / 60
Trend1.XStart = Trend1.XMin
Trend1.XEnd = Trend1.XMin + 1 / 24 / 6 * CInt(Text1.Text) * 5 / 60
Trend1.XSpan = 1 / 24 / 6 * CInt(Text1.Text) * 5 / 60
End Sub

Private Sub StatusBar1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub Text1_Change()
Set db = Workspaces(0).OpenDatabase(App.Path + "/control.mdb")
Set td = db.TableDefs("control")
Set Rs = td.OpenRecordset
Rs.Edit
Rs.Fields(3).Value = Slider1.Value
Rs.Update
Rs.Close
End Sub

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub Timer1_Timer()
Static Count As Integer
Static Count1 As Integer
If First = True Then '开机时第一次的发送值
   First = False
   For i = 1 To 6
         Str(0) = CByte(Asc("s"))
         MSComm1.Output = Str
   Next
End If
Count = Count + 1 'count每秒加1
   If Count = CInt(Text1.Text) * 10 Then ' 当周期到时发送检测温度信号
       Count = 0
       
       For i = 1 To 6
         Str(0) = CByte(Asc("s"))
         MSComm1.Output = Str
      Next
   End If
If StartHost = True Then
   Count1 = Count1 + 1
   If TimeValue = 0 Then TimeValue = TimeValue + 0.1
   If Count1 = TimeValue * 10 Then  'the time of the stoping host is start
      StartHost = False 'send the sign of the stoping host
      Str(0) = CByte(Asc("p"))
      MSComm1.Output = Str
      Str(0) = CByte(1)
      MSComm1.Output = Str
      Count1 = 0
   End If
End If

End Sub
Public Function Filter() As Integer
Dim i As Integer
Dim j As Integer
Dim t As Integer
For j = 0 To 1
  For i = 0 To 1 - j
     If temp(i) > temp(i + 1) Then
         t = temp(i)
         temp(i) = temp(i + 1)
         temp(i + 1) = t
     End If
  Next
Next
Filter = temp(1)
End Function
Public Function PIDprocess(Yn As Double, Wn As Double) As Double
Dim Pn As Double
Dim Kp, Ki, Kd As Double
Static E_0, E_1, E_2 As Double
Static Pp, Pi, Pd, Pi_1 As Double
Static Pn_1 As Double
Kp = CDbl(Label6(0).Caption)
Ki = CDbl(Label6(1).Caption)
Kd = CDbl(Label6(2).Caption)
E_0 = Yn - Wn
Pn = Pn_1 + Kp * ((E_0 - E_1) + Ki * E_0 + Kd * (E_0 - 2 * E_1 + E_2))
E_2 = E_1
E_1 = E_0
If Pn > 255 Then Pn = 255
If Pn < 0 Then Pn = 0
Pn_1 = Pn
PIDprocess = Pn

End Function
Public Function PIDprocess1(Yn As Double, Wn As Double) As Double
Dim Pn As Double
Dim Kp, Ki, Kd As Double
Static E_0, E_1, E_2 As Double
Static Pp, Pi, Pd, Pi_1 As Double
Static Pn_1 As Double
Kp = CDbl(Label6(0).Caption)
Ki = CDbl(Label6(1).Caption)
Kd = CDbl(Label6(2).Caption)
E_0 = Yn - Wn
Pn = Kp * ((E_0 - E_1) + Ki * E_0 + Kd * (E_0 - 2 * E_1 + E_2))
E_2 = E_1
E_1 = E_0
If Pn > 255 Then Pn = 255
If Pn < -255 Then Pn = -255
PIDprocess1 = Pn

End Function

Private Sub Timer2_Timer()
Static Count2 As Integer
Count2 = Count2 + 1
If Count2 = (TimeValue - 0.1) * 10 Then '发送停止信号
 If MSComm1.PortOpen = False Then Exit Sub
   Timer2.Enabled = False
   Count2 = 0
   Str(0) = CByte(Asc("p"))
   MSComm1.Output = Str
   Str(0) = CByte(1)
   MSComm1.Output = Str
End If

End Sub

Private Sub Timer3_Timer()
Dim val(3) As Integer
Dim valTemp(3) As Integer
Dim valTemper As String
Dim SoundString As String
Label15.Caption = Format(s, "00")
Label13.Caption = Format(m, "00")
Label7.Caption = Format(H, "00")
s = s + 1
'SoundTime = SoundTime + 1
'If SoundTime = 20 Then
'  SoundTime = 0
'   If SoundTip.Value = Checked Then
'       valTemper = CInt(Label11.Caption * 10)
'       val(0) = CInt(valTemper \ 100)
'       val(1) = CInt(Round((valTemper - val(0) * 100) \ 10))
'       val(2) = CInt(valTemper - val(0) * 100 - val(1) * 10)
'       valTemp(0) = CStr(val(0) + 55)
'       valTemp(1) = CStr(val(1) + 55)
'       valTemp(2) = CStr(val(2) + 55)
'
'       SoundString = "19" & "," & valTemp(0) & "," & "50" & "," & valTemp(1) & "," & "54" & "," & valTemp(2) & "," & "39"
'       IcMisSound1.PlaySnd SoundString
'   End If
'End If
If s = 59 Then
   s = 0
   m = m + 1
   If m = 59 Then
      m = 0
      H = H + 1
      If H = 23 Then
         H = 0
      End If
   End If
End If

   
End Sub

Public Sub WriteDatabase()

Set db = Workspaces(0).OpenDatabase(App.Path + "/control.mdb")
Set td = db.TableDefs("TempValue")
Set Rs = td.OpenRecordset
Rs.AddNew
Rs(0).Value = GroupNum
Rs(1).Value = Num
Rs(2).Value = Temper
Rs(3).Value = Format(Time, "H:mm:ss")
Rs.Update
Rs.Close
Num = Num + 1
End Sub

Public Sub WriteChart()

End Sub
Public Sub WritePos()
StatusBar1.Panels(3).Text = "坐标值 X:" & p.X & " " & "Y:" & p.Y
End Sub

Private Sub Trend1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub xpcmdbutton1_Click()
CheckComm
If Timer1.Enabled = True Then
   Timer3.Enabled = False
   Timer1.Enabled = False
   Slider1.Enabled = True
   Label9.Visible = True
   Slider1.Visible = True
   Text1.Visible = True
   Label16.Visible = False
   Text2.Visible = False
   Text3.Visible = False
ElseIf Timer1.Enabled = False Then
   Timer3.Enabled = True
   Timer1.Enabled = True
   Slider1.Enabled = False
   Label9.Visible = False
   Slider1.Visible = False
   Text1.Visible = False
   Label16.Visible = True
   Text2.Visible = True
   Text3.Visible = True
End If
End Sub

Private Sub xpcmdbutton2_Click()
Form3.Show
End Sub

Private Sub xpcmdbutton2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub xpcmdbutton3_Click()
On Error GoTo error1
Trend1.PrintPic 2, 100, 100
error1: Exit Sub
End Sub

Private Sub xpcmdbutton3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub xpcmdbutton4_Click()
Form2.Show
End Sub

Private Sub xpcmdbutton4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub xpcmdbutton5_Click()
Form5.Show
End Sub

Private Sub xpcmdbutton5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub xpcmdbutton6_Click()
Flag = MsgBox("将清空数据库内的全部数据", vbQuestion & vbYesNo, "清空数据库")
If Flag = vbYes Then
   ClearDatabase = True
   Set db = Workspaces(0).OpenDatabase(App.Path + "/control.mdb")
   Set td = db.TableDefs("TempValue")
   Set Rs = td.OpenRecordset
   If td.RecordCount <> 0 Then
     For i = 0 To td.RecordCount - 1
        If Rs.EOF = True Then
           Exit For
        End If
        Rs.Delete
        Rs.MoveNext
      Next
      
   End If
  Rs.AddNew
  For i = 0 To 3
    Rs.Fields(i).Value = 0
  Next
  Rs.Update
  Rs.Close
ElseIf Flag = vbNo Then
  Exit Sub
End If
Set db = Workspaces(0).OpenDatabase(App.Path + "/control.mdb")
   Set td = db.TableDefs("control")
   Set Rs = td.OpenRecordset
   Rs.Edit
   Rs.Fields(4).Value = 0
   Rs.Update
   Rs.Close
End Sub

Private Sub xpcmdbutton6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub xpcmdbutton7_Click()
s = 0
H = 0
m = 0
Tim = Time
Trend1.ClearBuf
Trend1.ClearTrack (0)

End Sub

Private Sub xpcmdbutton7_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetCursorPos(p)
Call WritePos
End Sub

Private Sub xphelp1_Click()
Call ShellAbout(hWnd, "温度控制系统", "版本信息框" & vbCrLf & "上帝与你同在！阿弥陀佛！", 0)
End Sub

Private Sub xptopbuttons1_Click()
Unload Me
End Sub

Private Sub xptopbuttons2_Click()
Me.WindowState = 1
End Sub