form2.frm

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

         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   6
      Left            =   9120
      TabIndex        =   47
      Top             =   8040
      Width           =   750
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   7
      Left            =   10080
      TabIndex        =   46
      Top             =   8160
      Width           =   750
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim qxbj As Boolean              '曲线比较标志位
Dim qxzbx As Integer             '曲线比较x轴坐标
Dim qxzby As Integer             '曲线比较y轴坐标
Dim temp As Integer              '临时数
'Dim n As Integer
Function zbzhx(X As Integer) As Long
zbzhx = X * Picture1.Width \ alltime
End Function

Function zbzhy(Y As Integer) As Long
zbzhy = Picture1.Height * (maxwd - Y) \ maxwd
End Function


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 6
            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 6
Label42(n).Caption = form1.Text1(n).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 6
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 6
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轴,标尺
Form2.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轴,标尺
Form2.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 6
Label42(n).Caption = form1.Text1(n).Text
Next n
Label41.Caption = form1.Text2.Text
End Sub

Private Sub Form_LostFocus()
Form2.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