frmpid.frm

回流焊监控系统-DCS,VB编写,对PLC进行通讯采集和控制,界面直观,操作方便,可以作为同类软件系统提供示范

         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   63
         Top             =   120
         Width           =   6615
      End
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "取消"
      Height          =   375
      Left            =   5160
      TabIndex        =   61
      Top             =   4440
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   600
      TabIndex        =   60
      Top             =   4440
      Width           =   1215
   End
End
Attribute VB_Name = "frmPid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim IsNotFirst As Boolean
Private Sub CancelButton_Click()
 Me.Hide
 frmMain.Enabled = True
End Sub

Private Sub Form_Load()
bTimeEnd = True
OKButton.Enabled = False
End Sub
Private Sub Form_Activate()
Dim i As Long, j As Long
SetDlgBackColor Me
For i = 0 To txtUI.UBound
  txtUI(i).Visible = frmMain.lbUT(i).Visible
  txtUP(i).Visible = frmMain.lbUT(i).Visible
  txtUD(i).Visible = frmMain.lbUT(i).Visible
  txtLI(i).Visible = frmMain.lbDT(i).Visible
  txtLP(i).Visible = frmMain.lbDT(i).Visible
  txtLD(i).Visible = frmMain.lbUT(i).Visible
Next
j = (txtUI(1).Left - txtUI(0).Left) * (5 - iCurrentOption)
Label2(0).Width = 6615 - j
Frame2(0).Width = 7215 - j

Frame2(1).Width = Frame2(0).Width
Picture1.Width = Frame2(0).Width

'Label1(1).Visible = oOption(iCurrentOption).bOption(22)
Frame2(1).Visible = oOption(iCurrentOption).bOption(22)
Me.Width = 7470 - j
CancelButton.Left = 5160 - j
If Not Frame2(1).Visible Then
   CancelButton.Top = Frame2(0).Top + Frame2(0).Height + 140
   OKButton.Top = Frame2(0).Top + Frame2(0).Height + 140
   Me.Height = 5340 - Frame2(1).Height
End If

End Sub
Private Sub Form_Unload(Cancel As Integer)
Call CancelButton_Click
Cancel = 1
End Sub
Private Sub OKButton_Click()
Dim i As Long, j As Long
Dim ss As String
'On Error GoTo Errhandle
If bTimeEnd Then
 Exit Sub
End If
frmMain.sbStatusBar.Panels(1).Text = ""
bTimeEnd = True
OKButton.Enabled = False
Timer2.Enabled = True
End Sub

Private Sub Timer1_Timer()

 Dim ss As String
 Dim j As Long, i As Long

 If (Not Ack) Then
  Exit Sub
 End If
 Timer1.Enabled = False
 For i = 0 To 1
    ss = frmMain.PLCCommand(1, 3, DeviceAbsAdd("D373"), iCurrentOption + 5, 0, "")
    If ss <> "" Then
      ss = Mid(ss, 8, (iCurrentOption + 5) * 4)
      For j = 0 To iCurrentOption + 4
         txtUP(j).Text = Hex2Dec(Mid(ss, 4 * j + 1, 4))
      Next
      Exit For
    Else
     TimeDelay 100
    End If
 Next
 For i = 0 To 1
    ss = frmMain.PLCCommand(1, 3, DeviceAbsAdd("D383"), iCurrentOption + 5, 0, "")
    If ss <> "" Then
      ss = Mid(ss, 8, (iCurrentOption + 5) * 4)
      For j = 0 To iCurrentOption + 4
         txtUI(j).Text = Hex2Dec(Mid(ss, 4 * j + 1, 4))
      Next
      Exit For
    Else
     TimeDelay 100
    End If
Next
For i = 0 To 1
    ss = frmMain.PLCCommand(1, 3, DeviceAbsAdd("D393"), iCurrentOption + 5, 0, "")
    If ss <> "" Then
      ss = Mid(ss, 8, (iCurrentOption + 5) * 4)
      For j = 0 To iCurrentOption + 4
         txtUD(j).Text = Hex2Dec(Mid(ss, 4 * j + 1, 4))
      Next
      Exit For
    Else
     TimeDelay 100
    End If
Next
For i = 0 To 1
    ss = frmMain.PLCCommand(1, 3, DeviceAbsAdd("D403"), iCurrentOption + 5, 0, "")
    If ss <> "" Then
      ss = Mid(ss, 8, (iCurrentOption + 5) * 4)
      For j = 0 To iCurrentOption + 4
         txtLP(j).Text = Hex2Dec(Mid(ss, 4 * j + 1, 4))
      Next
      Exit For
    Else
     TimeDelay 100
    End If
Next
For i = 0 To 1
    ss = frmMain.PLCCommand(1, 3, DeviceAbsAdd("D413"), (iCurrentOption + 5), 0, "")
    If ss <> "" Then
      ss = Mid(ss, 8, (iCurrentOption + 5) * 4)
      For j = 0 To (iCurrentOption + 4)
         txtLI(j).Text = Hex2Dec(Mid(ss, 4 * j + 1, 4))
      Next
      Exit For
    Else
     TimeDelay 100
    End If
Next
For i = 0 To 1
    ss = frmMain.PLCCommand(1, 3, DeviceAbsAdd("D423"), (iCurrentOption + 5), 0, "")
    If ss <> "" Then
      ss = Mid(ss, 8, (iCurrentOption + 5) * 4)
      For j = 0 To (iCurrentOption + 4)
         txtLD(j).Text = Hex2Dec(Mid(ss, 4 * j + 1, 4))
      Next
      Exit For
    Else
     TimeDelay 100
    End If
Next
bTimeEnd = False
OKButton.Enabled = True
IsNotFirst = True
Ack = False
End Sub

Private Sub Timer2_Timer()

Dim i As Long, j As Long
Dim ss As String
On Error GoTo Errhandle
OKButton.Enabled = False

If (Not Ack) Then
  Exit Sub
End If
Timer2.Enabled = False
frmInfo.Show , Me
frmInfo.ProgressBar1.Value = 0

For j = 0 To txtUP.UBound
   If txtUP(j).Tag = "1" Then
    For i = 0 To 1
      ss = frmMain.PLCCommand(1, 6, DeviceAbsAdd("D" & 373 + j), CLng(Val(txtUP(j).Text)), 0, "")
      If ss = "" Then
'        GoTo Out
        TimeDelay 300
      Else
        txtUP(j).Tag = 0
        WritePrivateProfileString "Pid", "UP" & CStr(j), txtUP(j).Text, iniFile
        Exit For
      End If
    Next
    If ss = "" Then
         frmMain.sbStatusBar.Panels(1).Text = Time & " D" & 373 + j & "下载失败！"
         Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
         
    End If
   End If
   frmInfo.ProgressBar1.Value = (j + 1) * 1000 / (txtUP.Count + txtUI.Count + txtUD.Count + txtLP.Count + txtLI.Count + txtLD.Count)
Next
For j = 0 To txtUI.UBound
   If txtUI(j).Tag = "1" Then
    For i = 0 To 1
      ss = frmMain.PLCCommand(1, 6, DeviceAbsAdd("D" & 383 + j), CLng(Val(txtUI(j).Text)), 0, "")
      If ss = "" Then
        TimeDelay 300
      Else
        txtUI(j).Tag = 0
        WritePrivateProfileString "Pid", "UI" & CStr(j), txtUI(j).Text, iniFile
        Exit For
      End If
    Next
    If ss = "" Then
         frmMain.sbStatusBar.Panels(1).Text = Time & " D" & 383 + j & "下载失败！"
         Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
    End If
   End If
   frmInfo.ProgressBar1.Value = (txtUP.Count + j + 1) * 1000 / (txtUP.Count + txtUI.Count + txtUD.Count + txtLP.Count + txtLI.Count + txtLD.Count)
Next
For j = 0 To txtUD.UBound
   If txtUD(j).Tag = "1" Then
    For i = 0 To 1
      ss = frmMain.PLCCommand(1, 6, DeviceAbsAdd("D" & 393 + j), CLng(Val(txtUD(j).Text)), 0, "")
      If ss = "" Then
        TimeDelay 300
      Else
        txtUD(j).Tag = 0
        WritePrivateProfileString "Pid", "UD" & CStr(j), txtUD(j).Text, iniFile
        Exit For
      End If
    Next
    If ss = "" Then
         frmMain.sbStatusBar.Panels(1).Text = Time & " D" & 393 + j & "下载失败！"
         Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
    End If
   End If
   frmInfo.ProgressBar1.Value = (txtUP.Count + txtUI.Count + j + 1) * 1000 / (txtUP.Count + txtUI.Count + txtUD.Count + txtLP.Count + txtLI.Count + txtLD.Count)
Next
For j = 0 To txtLP.UBound
   If txtLP(j).Tag = "1" Then
    For i = 0 To 1
      ss = frmMain.PLCCommand(1, 6, DeviceAbsAdd("D" & 403 + j), CLng(Val(txtLP(j).Text)), 0, "")
      If ss = "" Then
        TimeDelay 300
      Else
        txtLP(j).Tag = 0
        WritePrivateProfileString "Pid", "LP" & CStr(j), txtLP(j).Text, iniFile
        Exit For
      End If
    Next
    If ss = "" Then
         frmMain.sbStatusBar.Panels(1).Text = Time & " D" & 403 + j & "下载失败！"
         Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
    End If
   End If
   frmInfo.ProgressBar1.Value = (txtUP.Count + txtUI.Count + txtUD.Count + j + 1) * 1000 / (txtUP.Count + txtUI.Count + txtUD.Count + txtLP.Count + txtLI.Count + txtLD.Count)
Next
For j = 0 To txtLI.UBound
   If txtLI(j).Tag = "1" Then
    For i = 0 To 1
      ss = frmMain.PLCCommand(1, 6, DeviceAbsAdd("D" & 413 + j), CLng(Val(txtLI(j).Text)), 0, "")
      If ss = "" Then
        TimeDelay 300
      Else
        txtLI(j).Tag = 0
        WritePrivateProfileString "Pid", "LI" & CStr(j), txtLI(j).Text, iniFile
        Exit For
      End If
    Next
    If ss = "" Then
         frmMain.sbStatusBar.Panels(1).Text = Time & " D" & 413 + j & "下载失败！"
         Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
    End If
   End If
   frmInfo.ProgressBar1.Value = (txtUP.Count + txtUI.Count + txtUD.Count + txtLP.Count + j + 1) * 1000 / (txtUP.Count + txtUI.Count + txtUD.Count + txtLP.Count + txtLI.Count + txtLD.Count)
Next
For j = 0 To txtLD.UBound
   If txtLD(j).Tag = "1" Then
    For i = 0 To 1
      ss = frmMain.PLCCommand(1, 6, DeviceAbsAdd("D" & 423 + j), CLng(Val(txtLD(j).Text)), 0, "")
      If ss = "" Then
        TimeDelay 300
      Else
        txtLD(j).Tag = 0
        WritePrivateProfileString "Pid", "LD" & CStr(j), txtLD(j).Text, iniFile
        Exit For
      End If
    Next
    If ss = "" Then
         frmMain.sbStatusBar.Panels(1).Text = Time & " D" & 423 + j & "下载失败！"
         Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
    End If
   End If
   frmInfo.ProgressBar1.Value = (txtUP.Count + txtUI.Count + txtUD.Count + txtLP.Count + txtLI.Count + j + 1) * 1000 / (txtUP.Count + txtUI.Count + txtUD.Count + txtLP.Count + txtLI.Count + txtLD.Count)
Next
GoTo Out
Errhandle:
  frmMain.sbStatusBar.Panels(1).Text = Time & "-PID参数设置 错误：" & Err.description
  Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
  Err.Clear
Out:
OKButton.Enabled = True
frmInfo.Hide
bTimeEnd = False
Ack = False

End Sub

Private Sub txtLD_Change(Index As Integer)
If IsNotFirst Then
txtLD(Index).Tag = "1"
End If
End Sub

Private Sub txtLD_LostFocus(Index As Integer)
If Val(txtLD(Index).Text) > 100 Or Val(txtLD(Index).Text) < 0 Then
   MsgBox "PID设置值超限！", vbCritical + vbOKOnly, "警告"
   txtLD(Index).Text = 100
 End If
End Sub

Private Sub txtLI_Change(Index As Integer)
If IsNotFirst Then
txtLI(Index).Tag = "1"
End If
End Sub

Private Sub txtLI_LostFocus(Index As Integer)
If Val(txtLI(Index).Text) > 100 Or Val(txtLI(Index).Text) < 0 Then
   MsgBox "PID设置值超限！", vbCritical + vbOKOnly, "警告"
   txtLI(Index).Text = 100
 End If
End Sub

Private Sub txtLP_Change(Index As Integer)
If IsNotFirst Then
txtLP(Index).Tag = "1"
End If
End Sub


Private Sub txtLP_LostFocus(Index As Integer)
If Val(txtLP(Index).Text) > 100 Or Val(txtLP(Index).Text) < 0 Then
   MsgBox "PID设置值超限！", vbCritical + vbOKOnly, "警告"
   txtLP(Index).Text = 100
 End If
End Sub

Private Sub txtUD_Change(Index As Integer)
If IsNotFirst Then
txtUD(Index).Tag = "1"
End If
End Sub

Private Sub txtUD_LostFocus(Index As Integer)
If Val(txtUD(Index).Text) > 100 Or Val(txtUD(Index).Text) < 0 Then
   MsgBox "PID设置值超限！", vbCritical + vbOKOnly, "警告"
   txtUD(Index).Text = 100
 End If
End Sub

Private Sub txtUI_Change(Index As Integer)
If IsNotFirst Then
txtUI(Index).Tag = "1"
End If
End Sub

Private Sub txtUI_LostFocus(Index As Integer)
If Val(txtUI(Index).Text) > 100 Or Val(txtUI(Index).Text) < 0 Then
   MsgBox "PID设置值超限！", vbCritical + vbOKOnly, "警告"
   txtUI(Index).Text = 100
 End If
End Sub

Private Sub txtUP_Change(Index As Integer)
If IsNotFirst Then
txtUP(Index).Tag = "1"
End If
End Sub

Private Sub txtUP_LostFocus(Index As Integer)
If Val(txtUP(Index).Text) > 100 Or Val(txtUP(Index).Text) < 0 Then
   MsgBox "PID设置值超限！", vbCritical + vbOKOnly, "警告"
   txtUP(Index).Text = 100
 End If
End Sub