frmparaset.frm

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

         Height          =   255
         Left            =   960
         TabIndex        =   27
         Top             =   360
         Width           =   6615
      End
      Begin VB.Label Label1 
         Caption         =   "下温区："
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   6
         Top             =   1080
         Width           =   735
      End
      Begin VB.Label Label1 
         Caption         =   "上温区："
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   5
         Top             =   720
         Width           =   735
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "速度设置"
      Height          =   1695
      Left            =   120
      TabIndex        =   2
      Top             =   1920
      Width           =   4815
      Begin VB.TextBox txtFj 
         Height          =   375
         Index           =   3
         Left            =   3360
         TabIndex        =   31
         Text            =   "0"
         Top             =   1080
         Width           =   855
      End
      Begin VB.TextBox txtFj 
         Height          =   375
         Index           =   2
         Left            =   3360
         TabIndex        =   30
         Text            =   "0"
         Top             =   480
         Width           =   855
      End
      Begin VB.TextBox txtFj 
         Height          =   375
         Index           =   0
         Left            =   960
         TabIndex        =   28
         Text            =   "0"
         Top             =   480
         Width           =   855
      End
      Begin VB.TextBox txtFj 
         Height          =   375
         Index           =   1
         Left            =   960
         TabIndex        =   29
         Text            =   "0"
         Top             =   1080
         Width           =   855
      End
      Begin VB.Label lbFJR 
         Caption         =   "Hz"
         Height          =   255
         Index           =   3
         Left            =   4320
         TabIndex        =   40
         Top             =   1200
         Width           =   255
      End
      Begin VB.Label lbFJR 
         Caption         =   "Hz"
         Height          =   255
         Index           =   2
         Left            =   4320
         TabIndex        =   39
         Top             =   600
         Width           =   255
      End
      Begin VB.Label lbFJ 
         Caption         =   "风机3"
         Height          =   255
         Index           =   3
         Left            =   2760
         TabIndex        =   38
         Top             =   1200
         Width           =   495
      End
      Begin VB.Label lbFJ 
         Caption         =   "风机2"
         Height          =   255
         Index           =   2
         Left            =   2760
         TabIndex        =   37
         Top             =   600
         Width           =   735
      End
      Begin VB.Label lbFJR 
         Caption         =   "Hz"
         Height          =   255
         Index           =   1
         Left            =   2040
         TabIndex        =   36
         Top             =   1200
         Width           =   375
      End
      Begin VB.Label lbFJR 
         Caption         =   "Cm/Min"
         Height          =   255
         Index           =   0
         Left            =   2040
         TabIndex        =   35
         Top             =   600
         Width           =   615
      End
      Begin VB.Label lbFJ 
         Caption         =   "风机1"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   34
         Top             =   1200
         Width           =   615
      End
      Begin VB.Label lbFJ 
         Caption         =   "运输速度"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   33
         Top             =   600
         Width           =   735
      End
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "取消"
      Height          =   375
      Left            =   6600
      TabIndex        =   1
      Top             =   3840
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Height          =   375
      Left            =   5160
      TabIndex        =   0
      Top             =   3840
      Width           =   1215
   End
End
Attribute VB_Name = "frmParaset"
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 cmdModifyPass_Click()
Call frmMain.mnuModifyPassword_Click
End Sub

Private Sub OpenPrgFile(ByVal filen As String)
    Dim i As Long
    For i = 0 To txtUT.UBound
        txtUT(i).Text = ReadInIFiles("ParaSet", "UT" & CStr(i), "0.0", filen)
    Next
    For i = 0 To txtDT.UBound
        txtDT(i).Text = ReadInIFiles("ParaSet", "DT" & CStr(i), "0.0", filen)
    Next
    For i = 0 To txtFj.UBound
        txtFj(i).Text = ReadInIFiles("ParaSet", "FJ" & CStr(i), "0", filen)
    Next
    txtVersion.Text = ReadInIFiles("ParaSet", "Version", "1234", filen)
End Sub

Private Sub cmdOpen_Click()
  Dim i As Long
CommonDialog1.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog1.Filter = "All Files (*.*)|*.*|Curve Files (*.par)|*.par"
' 指定缺省的过滤器
CommonDialog1.FilterIndex = 2
CommonDialog1.ShowOpen
If CommonDialog1.filename <> "" Then
    Call OpenPrgFile(CommonDialog1.filename)
    sCurrentPrgFile = CommonDialog1.filename
End If
End Sub

Private Sub cmdSaveAs_Click()
Dim i As Long
CommonDialog1.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog1.Filter = "All Files (*.*)|*.*|Curve Files (*.par)|*.par"
' 指定缺省的过滤器
CommonDialog1.FilterIndex = 2

CommonDialog1.ShowSave
If CommonDialog1.filename <> "" Then
    Dim Fs As Object
    Dim a
    Set Fs = CreateObject("Scripting.FileSystemObject")
    If Not Fs.FileExists(CommonDialog1.filename) Then
        Set a = Fs.CreateTextFile(CommonDialog1.filename, True)
        a.Close
    End If
    For i = 0 To txtUT.UBound
        WritePrivateProfileString "ParaSet", "UT" & CStr(i), txtUT(i).Text, CommonDialog1.filename
    Next
    For i = 0 To txtDT.UBound
        WritePrivateProfileString "ParaSet", "DT" & CStr(i), txtDT(i).Text, CommonDialog1.filename
    Next
    For i = 0 To txtFj.UBound
        WritePrivateProfileString "ParaSet", "FJ" & CStr(i), txtFj(i).Text, CommonDialog1.filename
    Next
    WritePrivateProfileString "ParaSet", "Version", txtVersion.Text, CommonDialog1.filename
    
    WritePrivateProfileString "Public", "PrgFile", CommonDialog1.filename, iniFile
    sCurrentPrgFile = CommonDialog1.filename
End If
End Sub

Private Sub Form_Load()

Dim i As Long

bTimeEnd = True
For i = 0 To iCurrentOption + 4
  txtUT(i).Text = frmMain.lbUTSet(i).Caption
  txtDT(i).Text = frmMain.lbDTSet(i).Caption
Next

End Sub
Private Sub Form_Activate()
Dim i As Long
SetDlgBackColor Me
For i = 0 To txtUT.UBound
  txtUT(i).Visible = frmMain.lbUT(i).Visible
  txtDT(i).Visible = frmMain.lbDT(i).Visible
Next
Label1(1).Visible = oOption(iCurrentOption).bOption(22)
Label2.Width = 6615 - (txtUT(1).Left - txtUT(0).Left) * (5 - iCurrentOption)
For i = 1 To 3
 txtFj(i).Visible = oOption(iCurrentOption).bOption(i + 1)
 lbFJ(i).Visible = oOption(iCurrentOption).bOption(i + 1)
 lbFJR(i).Visible = oOption(iCurrentOption).bOption(i + 1)
Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call CancelButton_Click
Cancel = 1
End Sub

Private Sub OKButton_Click()
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
On Error Resume Next
If (Not Ack) Then
 Exit Sub
End If
Timer1.Enabled = False
For i = 0 To 1
    ss = frmMain.PLCCommand(1, 3, DeviceAbsAdd("D309"), txtFj.Count, 0, "")  '+ txtFj.Count
    If ss <> "" Then
      ss = Mid(ss, 8, txtFj.Count * 4)
      For j = 0 To txtFj.UBound
         txtFj(j).Text = Format(Hex2Dec(Mid(ss, 4 * j + 1, 4)) / 10#, "0.0")
      Next
      Exit For
    End If
    TimeDelay 300
Next
bTimeEnd = False

txtVersion.Text = ReadInIFiles("ParaSet", "Version", "1234", iniFile)

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
If (Not Ack) Then
Exit Sub
End If
Timer2.Enabled = False
frmInfo.Show , Me
frmInfo.ProgressBar1.Value = 0

For j = 0 To txtUT.UBound
   If txtUT(j).Tag = "1" Then
    For i = 0 To 1
      ss = frmMain.PLCCommand(1, 6, DeviceAbsAdd("D" & 289 + j), CLng(Val(txtUT(j).Text) * 10), 0, "")
      If ss = "" Then
        TimeDelay 300
      Else
        txtUT(j).Tag = 0
        frmMain.lbUTSet(j).Caption = Val(txtUT(j).Text)
        WritePrivateProfileString "ParaSet", "UT" & CStr(j), txtUT(j).Text, iniFile
        Exit For
      End If
    Next
    If ss = "" Then
         frmMain.sbStatusBar.Panels(1).Text = Time & " D" & 289 + j & "下载失败！"
         Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
    End If
   End If
   frmInfo.ProgressBar1.Value = (j + 1) * 1000 / (txtUT.Count + txtDT.Count + txtFj.Count)
Next
If oOption(iCurrentOption).bOption(22) Then
For j = 0 To txtDT.UBound
   If txtDT(j).Tag = "1" Then
    For i = 0 To 1
      ss = frmMain.PLCCommand(1, 6, DeviceAbsAdd("D" & 299 + j), CLng(Val(txtDT(j).Text) * 10), 0, "")
      If ss = "" Then
        TimeDelay 300
      Else
        txtDT(j).Tag = 0
        frmMain.lbDTSet(j).Caption = Val(txtDT(j).Text)
        WritePrivateProfileString "ParaSet", "DT" & CStr(j), txtDT(j).Text, iniFile
        Exit For
      End If
    Next
    If ss = "" Then
         frmMain.sbStatusBar.Panels(1).Text = Time & " D" & 299 + j & "下载失败！"
         Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
    End If
   End If
   frmInfo.ProgressBar1.Value = (txtUT.Count + j + 1) * 1000 / (txtUT.Count + txtDT.Count + txtFj.Count)
Next
End If
For j = 0 To txtFj.UBound
   If txtFj(j).Tag = "1" Then
    For i = 0 To 1
      ss = frmMain.PLCCommand(1, 6, DeviceAbsAdd("D" & 309 + j), CLng(Val(txtFj(j).Text) * 10), 0, "")
      If ss = "" Then
        TimeDelay 300
      Else
        txtFj(j).Tag = 0
        If j > 0 Then
            frmMain.Speed(j - 1).Caption = Format(Val(txtFj(j).Text), "0.0")
        End If
        WritePrivateProfileString "ParaSet", "FJ" & CStr(j), txtFj(j).Text, iniFile
        Exit For
      End If
    Next
    If ss = "" Then
         frmMain.sbStatusBar.Panels(1).Text = Time & " D" & 309 + j & "下载失败！"
         Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
    End If
   End If
   frmInfo.ProgressBar1.Value = (txtUT.Count + txtDT.Count + j + 1) * 1000 / (txtUT.Count + txtDT.Count + txtFj.Count)
Next

If txtVersion.Tag = "1" Then
   txtVersion.Tag = "0"
   WritePrivateProfileString "ParaSet", "Version", txtVersion.Text, iniFile
End If

GoTo Out
Errhandle:
  frmMain.sbStatusBar.Panels(1).Text = Time & "-参数设置 错误：" & Err.description
  Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
  
  Err.Clear
Out:
OKButton.Enabled = True
frmInfo.Hide
bTimeEnd = False
frmMain.lbType(0).Caption = sCurrentPrgFile
Ack = False
End Sub

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

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

Private Sub txtFj_LostFocus(Index As Integer)
 If Index = 0 Then
   If (Val(txtFj(0).Text) < 30 Or Val(txtFj(0).Text) > 150) Then
      MsgBox "运输速度设置值超限！", vbCritical + vbOKOnly, "警告"
      txtFj(0).Text = 150
   End If
 Else
    If (Val(txtFj(Index).Text) < 20 Or Val(txtFj(Index).Text) > 60) Then
      MsgBox "风机速度设置值超限！", vbCritical + vbOKOnly, "警告"
      txtFj(Index).Text = 60
    End If
 End If
End Sub

Private Sub txtUT_Change(Index As Integer)
If IsNotFirst Then
txtUT(Index).Tag = "1"
End If
End Sub
Private Sub txtUT_LostFocus(Index As Integer)
If Val(txtUT(Index).Text) > sMaxTemp Or Val(txtUT(Index).Text) < 0 Then
   MsgBox "温度设置值超限！", vbCritical + vbOKOnly, "警告"
   txtUT(Index).Text = sMaxTemp
 End If
End Sub
Private Sub txtDT_LostFocus(Index As Integer)
If Val(txtDT(Index).Text) > sMaxTemp Or Val(txtDT(Index).Text) < 0 Then
   MsgBox "温度设置值超限！", vbCritical + vbOKOnly, "警告"
   txtDT(Index).Text = sMaxTemp
 End If
End Sub

Private Sub txtVersion_Change()
If IsNotFirst Then
txtVersion.Tag = "1"
End If
End Sub