form21.frm

一个网带烧结炉的程序,串口通讯,做工业自动化的可以参考

Private Sub Command1_Click() '检测
Dim i As Integer
If saveflag = False Then
    a = MsgBox("是否存储曲线?", vbOKCancel, "提示:")
        If a = 1 Then
            cqx.max = Val(Label25.Caption)
            cqx.maxwd = maxwd
            cqx.alltime = alltime
            cqx.runtime = runtime
            cqx.time_ge = Label29.Caption
            cqx.bcdata = Label4.Caption
            cqx.speed = Val(Label41.Caption)
            For n = 0 To 5
            cqx.sv(n) = Label42(n).Caption
            Next n
            For i = 0 To 9000
            cqx.qx1(i) = qx1(i)
            cqx.qx2(i) = qx2(i)
            cqx.qx3(i) = qx3(i)
            Next i
            CommonDialog1.DialogTitle = "保存曲线"
            CommonDialog1.CancelError = False
            CommonDialog1.Filter = "曲线文件(*.cur)|*.cur"
            CommonDialog1.ShowSave
            If Len(CommonDialog1.filename) = 0 Then
                Exit Sub
            End If
        saveqx CommonDialog1.filename
        End If
End If
                        '抹掉曲线
For i = 1 To runtime
Picture1.DrawStyle = 0
Picture1.Line (zbzhx(i - 1), zbzhy(qx1(i - 1)))-(zbzhx(i), zbzhy(qx1(i))), RGB(255, 0, 0)   '红
Picture1.Line (zbzhx(i - 1), zbzhy(qx2(i - 1)))-(zbzhx(i), zbzhy(qx2(i))), RGB(0, 0, 255)   '兰
Picture1.Line (zbzhx(i - 1), zbzhy(qx3(i - 1)))-(zbzhx(i), zbzhy(qx3(i))), RGB(0, 255, 0)   '绿
Next i

saveflag = False
runtime = 0
Command1.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
Command6.Enabled = False
Command7.Enabled = False
Command8.Enabled = False
Command9.Enabled = False
Text1.Enabled = False
Text2.Enabled = False
'Check1.Enabled = False
'Check2.Enabled = False
'Check3.Enabled = False
flag = timeSetEvent(1000, 20, AddressOf cj_hx, mm, 1)

Label41.Caption = form1.Text2.Text
For n = 0 To 5
Label42(n).Caption = form1.Text1(n + 7).Text
Next n

End Sub

Private Sub Command2_Click() '停止
Dim max As Integer
'Timer1.Enabled = False
Command1.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
Command7.Enabled = True
Command8.Enabled = True
Command9.Enabled = True
Text1.Enabled = True
Text2.Enabled = True
'Check1.Enabled = True
'Check2.Enabled = True
'Check3.Enabled = True
max = 0                          '求曲线最大值
For i = 0 To runtime
    If qx1(i) > max1 Then
    max1 = qx1(i)
    End If
    If qx2(i) > max2 Then
    max2 = qx2(i)
    End If
    If qx3(i) > max3 Then
    max3 = qx3(i)
    End If
Next i
max = max1
If max < max2 Then
    max = max2
End If
If max < max3 Then
    max = max3
End If
Label25.Caption = max
timeKillEvent (flag)
End Sub

Private Sub Command3_Click() '打开
'Dim i As Long
Dim j As Integer
CommonDialog1.DialogTitle = "打开保存曲线"
CommonDialog1.CancelError = False
CommonDialog1.Filter = "曲线文件(*.cur)|*.cur|所有文件(*.*)|*.*"
CommonDialog1.ShowOpen
If Len(CommonDialog1.filename) = 0 Then
Exit Sub
End If
loadqx CommonDialog1.filename
 Label25.Caption = cqx.max
 maxwd = cqx.maxwd
 Text1 = maxwd
 alltime = cqx.alltime
 Text2 = alltime
 runtime = cqx.runtime
 Label29.Caption = cqx.time_ge
 Label4.Caption = cqx.bcdata
 
Label41.Caption = cqx.speed
For n = 0 To 5
Label42(n).Caption = cqx.sv(n)
Next n

For n = 1 To 8                   '画xy轴,标尺
Label2(n - 1).Caption = str(alltime * n \ 8) + "s"
Label1(n - 1).Caption = str(maxwd * n \ 8) + "℃"
Next n


 For i = 0 To 9000
 qx1(i) = cqx.qx1(i)
 qx2(i) = cqx.qx2(i)
 qx3(i) = cqx.qx3(i)
 Next i
For j = 1 To runtime
Picture1.DrawStyle = 0
Picture1.Line (zbzhx(j - 1), zbzhy(qx1(j - 1)))-(zbzhx(j), zbzhy(qx1(j))), RGB(255, 0, 0)   '红
Picture1.Line (zbzhx(j - 1), zbzhy(qx2(j - 1)))-(zbzhx(j), zbzhy(qx2(j))), RGB(0, 0, 255)   '兰
Picture1.Line (zbzhx(j - 1), zbzhy(qx3(j - 1)))-(zbzhx(j), zbzhy(qx3(j))), RGB(0, 255, 0)   '绿
Next j
End Sub

Private Sub Command4_Click() '存储
saveflag = True
cqx.max = Val(Label25.Caption)
cqx.maxwd = maxwd
cqx.alltime = alltime
cqx.runtime = runtime
cqx.time_ge = Label29.Caption
cqx.bcdata = Label4.Caption

cqx.speed = Val(Label41.Caption)
For n = 0 To 5
cqx.sv(n) = Label42(n).Caption
Next n

For i = 0 To 9000
cqx.qx1(i) = qx1(i)
cqx.qx2(i) = qx2(i)
cqx.qx3(i) = qx3(i)
Next i

CommonDialog1.DialogTitle = "保存曲线"
CommonDialog1.CancelError = False
CommonDialog1.Filter = "曲线文件(*.cur)|*.cur"
CommonDialog1.ShowSave
If Len(CommonDialog1.filename) = 0 Then
Exit Sub
End If
saveqx CommonDialog1.filename
End Sub

Private Sub Command5_Click() '打印
PrintForm
End Sub

Private Sub Command6_Click() '返回
temp = 0
If saveflag = False Then
    a = MsgBox("是否存储曲线?", vbOKCancel, "提示:")
        If a = 1 Then
            cqx.max = Val(Label25.Caption)
            cqx.maxwd = maxwd
            cqx.alltime = alltime
            cqx.runtime = runtime
            cqx.time_ge = Label29.Caption
            cqx.bcdata = Label4.Caption
            cqx.speed = Val(Label41.Caption)
            For n = 0 To 11
            cqx.sv(n) = Label42(n).Caption
            Next n
            For i = 0 To 9000
            cqx.qx1(i) = qx1(i)
            cqx.qx2(i) = qx2(i)
            cqx.qx3(i) = qx3(i)
            Next i
            CommonDialog1.DialogTitle = "保存曲线"
            CommonDialog1.CancelError = False
            CommonDialog1.Filter = "曲线文件(*.cur)|*.cur"
            CommonDialog1.ShowSave
            If Len(CommonDialog1.filename) = 0 Then
                Exit Sub
            End If
        saveqx CommonDialog1.filename
        End If
End If
Timer1.Enabled = False
Unload Me
End Sub

Private Sub Command7_Click() '曲线拉伸
Dim i As Integer               '抹掉曲线
For i = 1 To runtime
Picture1.DrawStyle = 0
Picture1.Line (zbzhx(i - 1), zbzhy(qx1(i - 1)))-(zbzhx(i), zbzhy(qx1(i))), RGB(255, 0, 0)   '红
Picture1.Line (zbzhx(i - 1), zbzhy(qx2(i - 1)))-(zbzhx(i), zbzhy(qx2(i))), RGB(0, 0, 255)   '兰
Picture1.Line (zbzhx(i - 1), zbzhy(qx3(i - 1)))-(zbzhx(i), zbzhy(qx3(i))), RGB(0, 255, 0)   '绿
Next i

If alltime <= 0 Then
alltime = 60
End If
alltime = alltime - 60
If alltime <= 0 Then            '防止下标越界
alltime = 1
End If
For n = 0 To 7
Label2(n).Caption = str(alltime * (n + 1) \ 8) + "s"
Next n
Text2.Text = alltime
Label29.Caption = alltime \ 8

For i = 1 To runtime
Picture1.DrawStyle = 0
Picture1.Line (zbzhx(i - 1), zbzhy(qx1(i - 1)))-(zbzhx(i), zbzhy(qx1(i))), RGB(255, 0, 0)   '红
Picture1.Line (zbzhx(i - 1), zbzhy(qx2(i - 1)))-(zbzhx(i), zbzhy(qx2(i))), RGB(0, 0, 255)   '兰
Picture1.Line (zbzhx(i - 1), zbzhy(qx3(i - 1)))-(zbzhx(i), zbzhy(qx3(i))), RGB(0, 255, 0)   '绿
Next i
End Sub

Private Sub Command8_Click() '曲线压缩
Dim i As Integer
For i = 1 To runtime
Picture1.DrawStyle = 0
Picture1.Line (zbzhx(i - 1), zbzhy(qx1(i - 1)))-(zbzhx(i), zbzhy(qx1(i))), RGB(255, 0, 0)   '红
Picture1.Line (zbzhx(i - 1), zbzhy(qx2(i - 1)))-(zbzhx(i), zbzhy(qx2(i))), RGB(0, 0, 255)   '兰
Picture1.Line (zbzhx(i - 1), zbzhy(qx3(i - 1)))-(zbzhx(i), zbzhy(qx3(i))), RGB(0, 255, 0)   '绿
Next i
If alltime >= 9000 Then
MsgBox ("采样时间不大于9000秒!"), 48
alltime = 9000
End If
alltime = alltime + 60
For n = 0 To 7
Label2(n).Caption = str(alltime * (n + 1) \ 8) + "s"
Next n
Text2.Text = alltime
Label29.Caption = alltime \ 8
For i = 1 To runtime
Picture1.DrawStyle = 0
Picture1.Line (zbzhx(i - 1), zbzhy(qx1(i - 1)))-(zbzhx(i), zbzhy(qx1(i))), RGB(255, 0, 0)   '红
Picture1.Line (zbzhx(i - 1), zbzhy(qx2(i - 1)))-(zbzhx(i), zbzhy(qx2(i))), RGB(0, 0, 255)   '兰
Picture1.Line (zbzhx(i - 1), zbzhy(qx3(i - 1)))-(zbzhx(i), zbzhy(qx3(i))), RGB(0, 255, 0)   '绿
Next i
End Sub

Private Sub Command9_Click() '曲线比较
If temp <> 0 Then
Picture1.DrawStyle = 0
Picture1.Line (temp, 0)-(temp, Picture1.Height), RGB(255, 255, 255)
End If
qxbj = True
If Command9.Caption = "曲线比较" Then
    Command9.Caption = "停止比较"
    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
    Command5.Enabled = False
    Command6.Enabled = False
    qxbj = True
    Else
    Command9.Caption = "曲线比较"
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
    Command5.Enabled = True
    Command6.Enabled = True
    qxbj = False

End If

End Sub

Private Sub Form_Load()
Dim n As Integer

saveflag = True
maxwd = 1000
alltime = 4000
Picture1.Top = 0
Picture1.Left = 0

Label4.Caption = str$(Date)
'bcqx.bcdata = Label4.Caption
Picture1.DrawStyle = 2
For n = 1 To 8                   '画y轴,标尺
Form21.Picture1.Line (0, Picture1.Height * n / 8)-(Picture1.Width, Picture1.Height / 8 * n), QBColor(8)
Label1(n - 1).Top = Picture1.Height * (8 - n) / 8 + Picture1.Top
Label1(n - 1).Left = Picture1.Left + Picture1.Width
Label1(n - 1).Caption = str(maxwd * n \ 8) + "℃"
Next n
For n = 1 To 8                   '画x轴,标尺
Form21.Picture1.Line (Picture1.Width * n / 8, 0)-(Picture1.Width * n / 8, Picture1.Height), QBColor(8)
Label2(n - 1).Top = Picture1.Top + Picture1.Height + 50
Label2(n - 1).Left = Picture1.Width * n / 8 + Picture1.Left - Label2(n - 1).Width \ 2
Label2(n - 1).Caption = str(alltime * n \ 8) + "s"
Next n
Timer1.Enabled = True

For n = 0 To 5

Label42(n).Caption = form1.Text1(n + 7).Text
Next n
Label41.Caption = form1.Text3.Text
End Sub

Private Sub Form_LostFocus()
Form21.Show
End Sub

Private Sub Form_Unload(Cancel As Integer)
timeKillEvent (flag)
runtime = 1
Timer1.Enabled = False
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
qxzbx = X
qxzby = Y
End Sub

Private Sub Picture1_Click()
Dim a As Long
Dim b As Integer             '临时变量_温差

If qxbj = True Then
    Picture1.DrawStyle = 0
    Picture1.Line (qxzbx, 0)-(qxzbx, Picture1.Height), RGB(255, 255, 255)
        If temp <> 0 Then
            Picture1.Line (temp, 0)-(temp, Picture1.Height), RGB(255, 255, 255)
        End If
    temp = qxzbx
    a = qxzbx / Picture1.Width * alltime \ 1
    Label36.Caption = qx1(a)
    Label37.Caption = qx2(a)
    Label38.Caption = qx3(a)
    Label53.Caption = a
    b = Abs(qx1(a) - qx2(a))                '求温差
    If b < Abs(qx1(a) - qx3(a)) Then
        b = Abs(qx1(a) - qx3(a))
    End If
    If b < Abs(qx2(a) - qx3(a)) Then
        b = Abs(qx2(a) - qx3(a))
    End If
    Label28.Caption = b

End If


End Sub


Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim i As Integer
If KeyAscii = 13 Then
    If Text1 <> "" Then
        For i = 1 To runtime
        Picture1.DrawStyle = 0
        Picture1.Line (zbzhx(i - 1), zbzhy(qx1(i - 1)))-(zbzhx(i), zbzhy(qx1(i))), RGB(255, 0, 0)   '红
        Picture1.Line (zbzhx(i - 1), zbzhy(qx2(i - 1)))-(zbzhx(i), zbzhy(qx2(i))), RGB(0, 0, 255)   '兰
        Picture1.Line (zbzhx(i - 1), zbzhy(qx3(i - 1)))-(zbzhx(i), zbzhy(qx3(i))), RGB(0, 255, 0)   '绿
        Next i
            If Val(Text1.Text) > 1200 Then
                MsgBox ("测量温度不大于1200摄氏度"), 48
                Text1.Text = 1200
            End If
            If Val(Text1.Text) = 0 Then