frmpid.frm

基于化工行业造气岗位的自动化监控系统

         BorderColor     =   &H00FF0000&
         DrawMode        =   6  'Mask Pen Not
         X1              =   1440
         X2              =   2880
         Y1              =   2280
         Y2              =   2280
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "作用："
         Height          =   180
         Left            =   1440
         TabIndex        =   18
         Top             =   2715
         Width           =   540
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "阀门："
         Height          =   180
         Left            =   1440
         TabIndex        =   16
         Top             =   2400
         Width           =   540
      End
      Begin VB.Label Label1 
         Caption         =   "自动  给定值"
         Height          =   375
         Index           =   0
         Left            =   1440
         TabIndex        =   9
         Top             =   480
         Width           =   615
      End
      Begin VB.Label Label1 
         Caption         =   "手动  输出值"
         Height          =   375
         Index           =   1
         Left            =   1440
         TabIndex        =   8
         Top             =   1320
         Width           =   615
      End
   End
End
Attribute VB_Name = "frmPID"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*************湖南仪峰公司新模块化DCS组件*************************
    '作者：      彭逢望,隆朋飞
    '编写日期：  2004-6-15
    '最后修改：  2004-9-25
    '修改人：    彭逢望
'*****************************************************************


Private Sub Check1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Check1.Value
    Case 0
        Pid(PID_index).OPEN = False
        WritePrivateProfileString "PID" & PID_index, "OPEN", "False", iniPaths + "PID.ini"
    Case 1
        Pid(PID_index).OPEN = True
        WritePrivateProfileString "PID" & PID_index, "OPEN", "True", iniPaths + "PID.ini"
End Select
    strPIDSYNC = "|" & PID_index & "|" & "OPEN" & "|" & Pid(PID_index).OPEN & "|" & " "
    SynchroMsg strPIDSYNC
End Sub

Private Sub cmdAuto_Click()         '自调设定
    Pid(PID_index).AV = Val(txtAuto.Text)
    Dim i As Long
    i = Adjust(True)
     prgPID.gV = 100 - sldAuto.Value
    WritePrivateProfileString "PID" & PID_index, "AV", CStr(txtAuto.Text), iniPaths + "PID.ini"
    AddWarn "自动=" & CStr(txtAuto.Text)
End Sub

Private Sub cmdEdit_Click()
    lngPopedom = 3
    frmPassword.Show 1
    If mPassword Then
        mPassword = False
        PN(0).Enabled = True
        PN(1).Enabled = True
        cmdKp.Enabled = True
        cmdKi.Enabled = True
        cmdKd.Enabled = True
        txtKp.Enabled = True
        txtKi.Enabled = True
        txtKd.Enabled = True
        Check1.Enabled = True
    Else
        Exit Sub
    End If
End Sub

Private Sub cmdKd_Click()
Dim Channel As Long
    Pid(PID_index).KD = Val(txtKd.Text)
    strPIDCommand = "#0" & Hex(Pid(PID_index).Address) & "Skd" & _
                        Pid(PID_index).Channel & "=" & Pid(PID_index).KD
    strPIDSYNC = "|" & PID_index & "|" & "KD" & "|" & Pid(PID_index).KD & "|" & strPIDCommand
    SynchroMsg strPIDSYNC
    WritePrivateProfileString "PID" & PID_index, "KD", CStr(txtKd.Text), iniPaths + "PID.ini"
    AddWarn "微分=" & CStr(txtKd.Text)
End Sub

Private Sub cmdKi_Click()
    Pid(PID_index).KI = Val(txtKi.Text)
    strPIDCommand = "#0" & Hex(Pid(PID_index).Address) & "Ki" & _
                        Pid(PID_index).Channel & "=" & 10 * Pid(PID_index).KI
    strPIDSYNC = "|" & PID_index & "|" & "KI" & "|" & Pid(PID_index).KI & "|" & strPIDCommand
    SynchroMsg strPIDSYNC
    WritePrivateProfileString "PID" & PID_index, "KI", CStr(txtKi.Text), iniPaths + "PID.ini"
    AddWarn "积分=" & CStr(txtKi.Text)
End Sub

Private Sub cmdKp_Click()
    Pid(PID_index).KP = Val(txtKp.Text)
    strPIDCommand = "#0" & Hex(Pid(PID_index).Address) & "Kp" & _
                        Pid(PID_index).Channel & "=" & 10 * Pid(PID_index).KP
    strPIDSYNC = "|" & PID_index & "|" & "KP" & "|" & Pid(PID_index).KP & "|" & strPIDCommand
    SynchroMsg strPIDSYNC
    WritePrivateProfileString "PID" & PID_index, "KP", CStr(txtKp.Text), iniPaths + "PID.ini"
    AddWarn "比例=" & CStr(txtKp.Text)
End Sub

Private Sub cmdMan_Click()          '手调设定
    If Pid(PID_index).OPEN = True Then
       Pid(PID_index).MV = Val(txtMan.Text)
    Else
       Pid(PID_index).MV = 100 - Val(txtMan.Text)
    End If
    Dim i As Long
    i = Adjust(False)
    WritePrivateProfileString "PID" & PID_index, "MV", CStr(Pid(PID_index).MV), iniPaths + "PID.ini"
End Sub

Private Sub cmdPN_Click()
    If Pid(PID_index).PN = True Then
        Pid(PID_index).PN = False
        cmdPN.Caption = "反调"
        strPIDCommand = "$0" & Hex(Pid(PID_index).Address) & "Kd" & Pid(PID_index).Channel & "=" & 1
        strPIDSYNC = "|" & PID_index & "|" & "PN" & "|" & "False" & "|" & strPIDCommand
        SynchroMsg strPIDSYNC
        WritePrivateProfileString "PID" & PID_index, "PN", "False", iniPaths + "PID.ini"
    Else
        Pid(PID_index).PN = True
        cmdPN.Caption = "正调"
        strPIDCommand = "$0" & Hex(Pid(PID_index).Address) & "Kd" & Pid(PID_index).Channel & "=" & 0
        strPIDSYNC = "|" & PID_index & "|" & "PN" & "|" & "True" & "|" & strPIDCommand
        SynchroMsg strPIDSYNC
        WritePrivateProfileString "PID" & PID_index, "PN", "True", iniPaths + "PID.ini"
    End If
End Sub

Private Sub CmdRec_Click()
    Dim fso, f
    On Error GoTo HandleErr
    If Me.Width > 3060 Then
        Me.Width = 3060
        Exit Sub
    End If
    Me.Width = 6510
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.OpenTextFile(App.Path & "\dat\" & "PID" & PID_index & ".Rec", 1, True)
    Text1 = f.ReadAll
    Exit Sub
HandleErr:
   Err.Clear
   Text1 = ""
End Sub

Private Sub Form_Load()
    Dim lp_hand As Long
    lp_hand = SetParent(Me.hWnd, frmMain.hWnd)
    With Pid(PID_index)
        Me.Caption = " PID－" & Trim(Signal(Pid(PID_index).outID).Name)
        Me.Width = 3060
        sldAuto.Enabled = .AM
        cmdAuto.Enabled = .AM
        sldMan.Enabled = Not .AM
        cmdMan.Enabled = Not .AM
        If .AM Then
            Option1(0).Value = True
            Option1(1).Value = False
        Else
            Option1(1).Value = True
            Option1(0).Value = False
        End If
        If .PN Then
            PN(0).Value = False
            PN(1).Value = True
        Else
            PN(0).Value = True
            PN(1).Value = False
        End If
        If .OPEN Then
            Check1.Value = 1
        Else
            Check1.Value = 0
        End If
        txtAuto.Text = .AV
        If Signal(Pid(PID_index).inID).HighScale - Signal(Pid(PID_index).inID).LowScale <> 0 Then
           sldAuto.Value = (100 - 100 * (Pid(PID_index).AV - Signal(Pid(PID_index).inID).LowScale) / (Signal(Pid(PID_index).inID).HighScale - Signal(Pid(PID_index).inID).LowScale))
        End If
        If Pid(PID_index).OPEN = False Then
           sldMan.Value = Pid(PID_index).MV
        Else
           sldMan.Value = 100 - Pid(PID_index).MV
        End If
        prgPID.gV = 100 - sldAuto.Value
        txtKp.Text = .KP
        txtKi = .KI
    End With
End Sub

Private Sub Option1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Index = 0 Then
        Pid(PID_index).AM = True
        cmdAuto.Enabled = True             '自动
        sldAuto.Enabled = True
        cmdMan.Enabled = False
        sldMan.Enabled = False
        strPIDCommand = "$" & Format(Pid(PID_index).Address, "00") & "AO" & CStr(Pid(PID_index).Channel)
        strPIDSYNC = "|" & PID_index & "|" & "AM" & "|" & "True" & "|" & strPIDCommand
        SynchroMsg strPIDSYNC
        WritePrivateProfileString "PID" & PID_index, "AM", "True", iniPaths + "PID.ini"
        AddWarn "状态=自动"
    Else
        Pid(PID_index).AM = False         '手动
        cmdAuto.Enabled = False
        sldAuto.Enabled = False
        cmdMan.Enabled = True
        sldMan.Enabled = True
        strPIDCommand = "$" & Format(Pid(PID_index).Address, "00") & "MO" & CStr(Pid(PID_index).Channel)
        strPIDSYNC = "|" & PID_index & "|" & "AM" & "|" & "False" & "|" & strPIDCommand
        SynchroMsg strPIDSYNC
        WritePrivateProfileString "PID" & PID_index, "AM", "False", iniPaths + "PID.ini"
        AddWarn "状态=手动"
    End If
    
End Sub

Private Sub PN_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Index
    Case 0
        Pid(PID_index).PN = False
        strPIDCommand = "$0" & Hex(Pid(PID_index).Address) & "Kd" & Pid(PID_index).Channel & "=" & 1
        strPIDSYNC = "|" & PID_index & "|" & "PN" & "|" & "False" & "|" & strPIDCommand
        SynchroMsg strPIDSYNC
        PN(0).Value = True
        PN(1).Value = False
        WritePrivateProfileString "PID" & PID_index, "PN", "False", iniPaths + "PID.ini"
    Case 1
        Pid(PID_index).PN = True
        strPIDCommand = "$0" & Hex(Pid(PID_index).Address) & "Kd" & Pid(PID_index).Channel & "=" & 0
        strPIDSYNC = "|" & PID_index & "|" & "PN" & "|" & "True" & "|" & strPIDCommand
        SynchroMsg strPIDSYNC
        PN(0).Value = False
        PN(1).Value = True
        WritePrivateProfileString "PID" & PID_index, "PN", "True", iniPaths + "PID.ini"
End Select
End Sub

Private Sub sldAuto_Change()
    txtAuto.Text = FormatV((100 - sldAuto.Value) * _
        (Signal(Pid(PID_index).inID).HighScale - Signal(Pid(PID_index).inID).LowScale) / 100)
End Sub

Private Sub sldMan_Change()
    txtMan.Text = Format(100 - sldMan.Value, "0")
End Sub

Private Sub Timer1_Timer()
    If Signal(Pid(PID_index).inID).HighScale - Signal(Pid(PID_index).inID).LowScale <> 0 Then
        prgPID.PV = Format(100 * (Signal(Pid(PID_index).inID).CalValue - _
                        Signal(Pid(PID_index).inID).LowScale) / (Signal(Pid(PID_index).inID).HighScale - Signal(Pid(PID_index).inID).LowScale))
       
        Static blnFlash As Boolean
        If Signal(Pid(PID_index).inID).CalValue > Signal(Pid(PID_index).inID).HighScale _
            Or Signal(Pid(PID_index).inID).CalValue < Signal(Pid(PID_index).inID).LowScale Then
            blnFlash = Not blnFlash
            If blnFlash Then
                prgPID.pColor = RGB(255, 0, 0)
            Else
                prgPID.pColor = RGB(0, 0, 255)
            End If
        End If
    Else
        prgPID.PV = 0
    End If
    If Pid(PID_index).OPEN = False Then
        prgPID.AV = 100 - (Signal(Pid(PID_index).outID).CalValue - Signal(Pid(PID_index).outID).LowScale) / (Signal(Pid(PID_index).outID).HighScale - Signal(Pid(PID_index).outID).LowScale) * 100
    Else
        prgPID.AV = (Signal(Pid(PID_index).outID).CalValue - Signal(Pid(PID_index).outID).LowScale) / (Signal(Pid(PID_index).outID).HighScale - Signal(Pid(PID_index).outID).LowScale) * 100
    End If
    TextOut(0).Text = Signal(Pid(PID_index).outID).CalValue / Signal(Pid(PID_index).outID).HighScale * (Signal(Pid(PID_index).outID).HighValue - Signal(Pid(PID_index).outID).LowValue) + Signal(Pid(PID_index).outID).LowValue
End Sub

Private Sub txtAuto_Change()
    If Not IsNumeric(txtAuto.Text) Then
        MsgBox "输入的数据类型错误", vbOKOnly, "错误提示"
        txtAuto.Text = 0
        Exit Sub
    End If
    If Val(txtAuto.Text) > Signal(Pid(PID_index).inID).HighScale Then
        MsgBox "输入的数据超出范围", vbOKOnly, "错误提示"
        txtAuto.Text = Signal(Pid(PID_index).inID).HighScale
    End If
    If Val(txtAuto.Text) < Signal(Pid(PID_index).inID).LowScale Then
        MsgBox "输入的数据超出范围", vbOKOnly, "错误提示"
        txtAuto.Text = Signal(Pid(PID_index).inID).LowScale
    End If
End Sub

Private Sub txtAuto_DblClick()
    Set ControlLink = txtAuto
    frmDataIn.txtNumber = txtAuto.Text
    frmDataIn.Show
End Sub

Private Sub txtMan_Change()
    If Not IsNumeric(txtMan.Text) Then
        MsgBox "输入的数据类型错误", vbOKOnly, "错误提示"
        txtMan.Text = 0
        Exit Sub
    End If
    If Val(txtAuto.Text) > 100 Then
        MsgBox "输入的数据超出范围", vbOKOnly, "错误提示"
        txtAuto.Text = 100
    End If
    If Val(txtAuto.Text) < 0 Then
        MsgBox "输入的数据超出范围", vbOKOnly, "错误提示"
        txtAuto.Text = 0
    End If
End Sub

Private Sub txtMan_DblClick()
    Set ControlLink = txtMan
    frmDataIn.txtNumber = txtMan.Text
    frmDataIn.Show
End Sub

Private Function Adjust(AutoMan As Boolean) As Long
    Dim GiveValue As Single
    On Error GoTo ErrHandle
    Select Case AutoMan
        Case True
            GiveValue = Format((Signal(Pid(PID_index).outID).HighValue - Signal(Pid(PID_index).outID).LowValue) * (Pid(PID_index).AV - Signal(Pid(PID_index).inID).LowScale) / _
                                (Signal(Pid(PID_index).inID).HighScale - Signal(Pid(PID_index).inID).LowScale) + Signal(Pid(PID_index).outID).LowValue, "0.000")
            strPIDCommand = "#0" & Hex(Pid(PID_index).Address) & "Std" & Pid(PID_index).Channel & "=" & GiveValue
            strPIDSYNC = "|" & PID_index & "|" & "AV" & "|" & Pid(PID_index).AV & "|" & strPIDCommand
            SynchroMsg strPIDSYNC
        Case False
            GiveValue = Format((Signal(Pid(PID_index).outID).HighValue - Signal(Pid(PID_index).outID).LowValue) * Pid(PID_index).MV / 100 + Signal(Pid(PID_index).outID).LowValue, "0.000")
            strPIDCommand = "$0" & Hex(Pid(PID_index).Address) & "MO" & Pid(PID_index).Channel & "=" & GiveValue
            strPIDSYNC = "|" & PID_index & "|" & "MV" & "|" & Pid(PID_index).MV & "|" & strPIDCommand
            SynchroMsg strPIDSYNC
    End Select
    Adjust = 1
    Exit Function
ErrHandle:
    Adjust = 0
    frmMain.Statur.Caption = Format(Time, "hh:mm:ss") & "  PID.Adjust.Err" & Err.Description + Err.Number
    AddAlarm Statur.Caption
    Err.Clear
End Function

Private Sub AddWarn(Description As String)
On Error Resume Next
    Open App.Path & "\dat\" & "PID" & PID_index & ".Rec" For Append As #1
    Print #1, Format(Date, "yyyy-mm-dd") & "#" & Format(Time, "hh:mm:ss") & "  " & Description ' 将报警信息写入文件。
    i = LOF(1)
    Close #1
    If i > 10240 Then
       Kill App.Path & "\dat\" & "PID" & PID_index & ".Rec"
    End If
End Sub