module3.bas

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

Attribute VB_Name = "hqx"
Type bcqx                            '保存曲线的结构
    max As Integer                   '实测曲线最大温度
    maxwd As Integer                 '设置的最大温度
    alltime As Integer               '设定的采样时间
    runtime As Integer               '运行时间
    time_ge As Integer               '时间/格
    bcdata As String                 '保存曲线的时间
    qx1(0 To 9000) As Integer        '曲线1数据
    qx2(0 To 9000) As Integer        '曲线2数据
    qx3(0 To 9000) As Integer        '曲线3数据
    speed As Integer                 '带速
    sv(12) As Integer                 '设置温度
End Type

'Public p As Printer                 '打印机
Public cqx As bcqx                  '存储文件的文件名
Public saveflag As Boolean          '曲线文件存储标志   0:未存储    1:已存储
Public runtime As Integer           '显示的运行时间
Public alltime As Integer           '采样总时间
Public maxwd As Integer             '最大温度

Public time_qx1 As Integer          '定时器读7018第1口
Public time_qx2 As Integer          '定时器读7018第2口
Public time_qx3 As Integer          '定时器读7018第3口


Public qx1(9000) As Integer          '存储曲线1
Public qx2(9000) As Integer          '存储曲线2
Public qx3(9000) As Integer          '存储曲线3

Public autooff3006 As Boolean          '自动关机标志
Public autooff3507 As Boolean          '自动关机标志

'多媒体定时器
Public flag As Long                   '多媒体定时器id
Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwuser As Long, ByVal uFlags As Long) As Long
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uid As Long) As Long
'mmresult timeSetEvent(1000, 100, cj_hx, mm, time_periodic)
'mmresult timeKillEvent(flag)
Public Function zbzhx(X As Integer) As Integer           '划线x坐标装换
zbzhx = X * Form2.Picture1.Width \ alltime
End Function
Public Function zbzhy(Y As Integer) As Integer           '划线y坐标装换
zbzhy = Form2.Picture1.Height * (maxwd - Y) \ maxwd
End Function
Public Function prinx(X As Integer) As Integer           '打印x坐标装换
prinx = 20 + X / alltime * 176 \ 1
End Function
Public Function priny(Y As Integer) As Integer           '打印y坐标装换
priny = 110 + 160 / maxwd * (maxwd - Y) \ 1
End Function
Public Sub saveqx(filename As String)           '存曲线
Open filename For Binary As #3
    Put #3, , cqx
Close #3
End Sub
Public Sub loadqx(filename As String)           '调曲线
Open filename For Binary As #3
    Get #3, , cqx
Close #3

End Sub


Public Sub cj_hx(uid As Long, umsg As Long, dwuser As Long, dw1 As Long, dw2 As Long)
'uid = flag
'duser = mm
runtime = runtime + 1
Form2.Label7.Caption = runtime

qx1(runtime) = time_qx1
qx2(runtime) = time_qx2
qx3(runtime) = time_qx3

Form2.Label33.Caption = qx1(runtime - 1)
Form2.Label34.Caption = qx2(runtime - 1)
Form2.Label35.Caption = qx3(runtime - 1)


Form2.Picture1.DrawStyle = 0
Form2.Picture1.Line (zbzhx(runtime - 1), zbzhy(qx1(runtime - 1)))-(zbzhx(runtime), zbzhy(qx1(runtime))), RGB(255, 0, 0)   '红
Form2.Picture1.Line (zbzhx(runtime - 1), zbzhy(qx2(runtime - 1)))-(zbzhx(runtime), zbzhy(qx2(runtime))), RGB(0, 0, 255)   '兰
Form2.Picture1.Line (zbzhx(runtime - 1), zbzhy(qx3(runtime - 1)))-(zbzhx(runtime), zbzhy(qx3(runtime))), RGB(0, 255, 0)   '绿


If runtime >= alltime Then
    timeKillEvent (flag)
    Form2.Command1.Enabled = True
    Form2.Command3.Enabled = True
    Form2.Command4.Enabled = True
    Form2.Command5.Enabled = True
    Form2.Command6.Enabled = True
    Form2.Command7.Enabled = True
    Form2.Command8.Enabled = True
    Form2.Command9.Enabled = True
    Form2.Text1.Enabled = True
    Form2.Text2.Enabled = True
'    Form2.Check1.Enabled = True
'    Form2.Check2.Enabled = True
'    Form2.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
Form2.Label25.Caption = max
End If
End Sub

Public Function read7018(addr As Byte, id As Byte) As Integer
Dim aa As Byte
Dim bb As Integer
Dim comm As String
Dim buffer As String
Dim retu As String
Dim t As Integer
form1.MSComm1.PortOpen = True
t = 0
aa = addr
bb = id
comm = "#" + Format(Hex$(aa), "00") + Format(Hex$(bb), "0") + Chr(13)
form1.MSComm1.Output = comm                                          '注意窗口
Do
t = t + 1
buffer = buffer + form1.MSComm1.Input
Loop Until InStr(buffer, vbCr) Or t = 5000

If Mid(buffer, 1, 1) <> ">" Then
    retu = "-1"
    Else
    retu = Mid(buffer, 2, 7)
End If
retu = Replace(retu, "+", 0)
read7018 = Val(retu)
form1.MSComm1.PortOpen = False
End Function



Public Sub printtext(o As Control, X As Integer, Y As Integer, size As Integer, str As String)
    o.Font.size = size
    o.CurrentX = X
    o.CurrentY = Y
    o.Print str
End Sub