frmadjust.frm

来自「回流焊监控系统-DCS,VB编写,对PLC进行通讯采集和控制,界面直观,操作方便」· FRM 代码 · 共 516 行

FRM
516 行
字号 
VERSION 5.00
Begin VB.Form frmAdjust 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "调节宽度"
   ClientHeight    =   2820
   ClientLeft      =   6780
   ClientTop       =   4290
   ClientWidth     =   3255
   Icon            =   "frmAdjust.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2820
   ScaleWidth      =   3255
   ShowInTaskbar   =   0   'False
   Begin VB.Timer Timer5 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   840
      Top             =   0
   End
   Begin VB.Timer Timer4 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   360
      Top             =   0
   End
   Begin VB.Timer Timer3 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   0
      Top             =   840
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   0
      Top             =   0
   End
   Begin VB.Timer Timer1 
      Interval        =   500
      Left            =   120
      Top             =   2160
   End
   Begin VB.CommandButton cmdZero 
      BackColor       =   &H80000000&
      Caption         =   "回原点"
      Height          =   375
      Left            =   1800
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   1200
      Width           =   1215
   End
   Begin VB.CommandButton cmdStart 
      BackColor       =   &H8000000B&
      Caption         =   "自动调宽"
      Height          =   375
      Left            =   240
      MaskColor       =   &H000000FF&
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   1200
      Width           =   1215
   End
   Begin VB.TextBox txtWidth 
      BackColor       =   &H80000000&
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   1
      Left            =   1440
      TabIndex        =   9
      Text            =   "0.00"
      Top             =   720
      Width           =   1335
   End
   Begin VB.TextBox txtWidth 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   0
      Left            =   1440
      TabIndex        =   0
      Text            =   "0.00"
      Top             =   240
      Width           =   1335
   End
   Begin VB.CommandButton CancelButton 
      BackColor       =   &H8000000A&
      Caption         =   "调 宽"
      Height          =   375
      Left            =   1800
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   1800
      Width           =   1215
   End
   Begin VB.CommandButton cmdStop 
      BackColor       =   &H8000000A&
      Caption         =   "调 窄"
      Height          =   375
      Left            =   240
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   1800
      Width           =   1215
   End
   Begin VB.Label Label4 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "注意：在调宽之前请保证导轨上         无扳且输送停止"
      Height          =   495
      Left            =   240
      TabIndex        =   10
      Top             =   2280
      Width           =   2775
   End
   Begin VB.Label Label3 
      Caption         =   "mm"
      Height          =   255
      Left            =   2880
      TabIndex        =   8
      Top             =   840
      Width           =   495
   End
   Begin VB.Label Label2 
      Caption         =   "mm"
      Height          =   255
      Left            =   2880
      TabIndex        =   7
      Top             =   360
      Width           =   495
   End
   Begin VB.Label Label1 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "当前宽度："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   1
      Left            =   240
      TabIndex        =   6
      Top             =   720
      Width           =   1215
   End
   Begin VB.Label Label1 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "设置宽度："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   0
      Left            =   240
      TabIndex        =   4
      Top             =   240
      Width           =   1215
   End
End
Attribute VB_Name = "frmAdjust"
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()
If bTimeEnd Then
 Exit Sub
End If
frmMain.sbStatusBar.Panels(1).Text = ""
bTimeEnd = True
CancelButton.Enabled = False
Timer5.Enabled = True
End Sub

Private Sub cmdStart_Click()

If bTimeEnd Then
 Exit Sub
End If
frmMain.sbStatusBar.Panels(1).Text = ""
bTimeEnd = True
cmdStart.Enabled = False
Timer2.Enabled = True
End Sub

Private Sub cmdStop_Click()
If bTimeEnd Then
 Exit Sub
End If
frmMain.sbStatusBar.Panels(1).Text = ""
bTimeEnd = True
cmdStop.Enabled = False
Timer4.Enabled = True
End Sub
Private Sub Form_Activate()
SetDlgBackColor Me
bAdjustVisible = True
End Sub
Private Sub cmdZero_Click()
If bTimeEnd Then
 Exit Sub
End If
frmMain.sbStatusBar.Panels(1).Text = ""
bTimeEnd = True
cmdZero.Enabled = False
'frmInfo.Show , Me
'frmInfo.ProgressBar1.Value = 200
bTimeEnd = True
Timer3.Enabled = True

End Sub

Private Sub Form_Load()
bTimeEnd = True
cmdStart.Enabled = False
cmdStop.Enabled = False
cmdZero.Enabled = False
CancelButton.Enabled = False
txtWidth(0).Text = ReadInIFiles("Adjust", "Width", "0.00", iniFile)
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Call CancelButton_Click
 Me.Hide
 frmMain.Enabled = True
 bAdjustVisible = False
Cancel = 1

End Sub


Private Sub Timer1_Timer()
 Static b As Boolean
 
 txtWidth(1).Text = Format(iCurrentWidth / 10#, "0.00")
 Dim ss As String
 Dim j As Long, i As Long
 If Not b Then
     If (Not Ack) Then
        Exit Sub
     End If
     Timer1.Enabled = False
     b = True
     For i = 0 To 1
        ss = frmMain.PLCCommand(1, 1, DeviceAbsAdd("M18"), 24, 0, "")
        If ss <> "" Then
            ss = Hex2Bin(Mid(ss, 8, 2))
            CancelButton.Tag = Mid(ss, 5, 1)
            cmdStop.Tag = Mid(ss, 6, 1)
            cmdZero.Tag = Mid(ss, 7, 1)
            cmdStart.Tag = Mid(ss, 8, 1)
            
            If CancelButton.Tag = "1" Then
              CancelButton.BackColor = &HFF00&
            Else
               CancelButton.BackColor = &H8000000F
            End If
            If cmdStop.Tag = "1" Then
              cmdStop.BackColor = &HFF00&
            Else
               cmdStop.BackColor = &H8000000F
            End If
            If cmdZero.Tag = "1" Then
              cmdZero.BackColor = &HFF00&
            Else
               cmdZero.BackColor = &H8000000F
            End If
            If cmdStart.Tag = "1" Then
              cmdStart.BackColor = &HFF00&
            Else
               cmdStart.BackColor = &H8000000F
            End If
            Exit For
        End If
        TimeDelay 300
        Ack = False
    Next
    cmdStart.Enabled = True
    cmdStop.Enabled = True
    cmdZero.Enabled = True
    CancelButton.Enabled = True
    bTimeEnd = False
    Timer1.Enabled = True
    If ss = "" Then
         frmMain.sbStatusBar.Panels(1).Text = Time & " D2" & "读失败！"
         Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
    End If
End If
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
For i = 0 To 1
  ss = frmMain.PLCCommand(1, 6, DeviceAbsAdd("D503"), Val(txtWidth(0).Text) * 10, 0, "")
  If ss = "" Then
    Delay 0.3
  Else
    WritePrivateProfileString "Adjust", "Width", txtWidth(0).Text, iniFile
    Exit For
  End If
Next
If ss = "" Then
     frmMain.sbStatusBar.Panels(1).Text = Time & " D503" & "下载失败！"
     Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
End If
If cmdStart.Tag = "1" Then
  j = 0
Else
  j = Hex2Dec("FF00")
End If
For i = 0 To 1
  ss = frmMain.PLCCommand(1, 5, DeviceAbsAdd("M18"), j, 0, "")
  If ss = "" Then
    Delay 1.5
  Else
    If j = 0 Then
      cmdStart.Tag = "0"
      cmdStart.BackColor = &H8000000F
    Else
      cmdStart.Tag = "1"
      cmdStart.BackColor = &HFF00&
    End If
    Exit For
  End If
Next
If ss = "" Then
     frmMain.sbStatusBar.Panels(1).Text = Time & " M18" & "下载失败！"
     Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
End If
GoTo Out
Errhandle:
  frmMain.sbStatusBar.Panels(1).Text = Time & "-调节宽度 自动调宽 错误：" & Err.description
  Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
  Err.Clear
Out:
bTimeEnd = False
cmdStart.Enabled = True
Ack = False
End Sub

Private Sub Timer3_Timer()
Dim i As Long, j As Long
Dim ss As String
On Error GoTo Errhandle
If (Not Ack) Then
Exit Sub
End If
Timer3.Enabled = False
If cmdZero.Tag = "1" Then
  j = 0
Else
  j = Hex2Dec("FF00")
End If
For i = 0 To 1

  ss = frmMain.PLCCommand(1, 5, DeviceAbsAdd("M19"), j, 0, "")
  If ss = "" Then
    TimeDelay 300
  Else
    If j = 0 Then
      cmdZero.Tag = "0"
      cmdZero.BackColor = &H8000000F
    Else
      cmdZero.Tag = "1"
      cmdZero.BackColor = &HFF00&
    End If
    Exit For
  End If
Next
If ss = "" Then
     frmMain.sbStatusBar.Panels(1).Text = Time & " M19" & "下载失败！"
     Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
End If
GoTo Out
Errhandle:
  frmMain.sbStatusBar.Panels(1).Text = Time & "-调节宽度 回原点 错误：" & Err.description
  Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
  Err.Clear
Out:
bTimeEnd = False
cmdZero.Enabled = True
bTimeEnd = False
Ack = False
End Sub

Private Sub Timer4_Timer()
Dim i As Long, j As Long
Dim ss As String
On Error GoTo Errhandle
If (Not Ack) Then
Exit Sub
End If
Timer4.Enabled = False
If cmdStop.Tag = "1" Then
  j = 0
Else
  j = Hex2Dec("FF00")
End If
For i = 0 To 1
  ss = frmMain.PLCCommand(1, 5, DeviceAbsAdd("M20"), j, 0, "")
  If ss = "" Then
    TimeDelay 300
  Else
    If j = 0 Then
      cmdStop.Tag = "0"
      cmdStop.BackColor = &H8000000F
    Else
      cmdStop.Tag = "1"
      cmdStop.BackColor = &HFF00&
    End If
    Exit For
  End If
Next
If ss = "" Then
     frmMain.sbStatusBar.Panels(1).Text = Time & " M20" & "下载失败！"
     Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
End If
GoTo Out
Errhandle:
  frmMain.sbStatusBar.Panels(1).Text = Time & "-调节宽度 调窄 错误：" & Err.description
  Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
  Err.Clear
Out:
bTimeEnd = False
cmdStop.Enabled = True
Ack = False
End Sub

Private Sub Timer5_Timer()
Dim i As Long, j As Long
Dim ss As String
On Error GoTo Errhandle
If Not Ack Then
   Exit Sub
End If
Timer5.Enabled = False
If CancelButton.Tag = "1" Then
  j = 0
Else
  j = Hex2Dec("FF00")
End If
For i = 0 To 1
  ss = frmMain.PLCCommand(1, 5, DeviceAbsAdd("M21"), j, 0, "")
  If ss = "" Then
    TimeDelay 300
  Else
    If j = 0 Then
      CancelButton.Tag = "0"
      CancelButton.BackColor = &H8000000F
    Else
      CancelButton.Tag = "1"
      CancelButton.BackColor = &HFF00&
    End If
    Exit For
  End If
Next
If ss = "" Then
     frmMain.sbStatusBar.Panels(1).Text = Time & " M21" & "下载失败！"
     Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
End If
GoTo Out
Errhandle:
  frmMain.sbStatusBar.Panels(1).Text = Time & "-调节宽度 调宽  错误：" & Err.description
  Call frmMain.AddErrorLog(frmMain.sbStatusBar.Panels(1).Text)
  Err.Clear
Out:
bTimeEnd = False
CancelButton.Enabled = True
End Sub

Private Sub txtWidth_LostFocus(Index As Integer)
 If Index = 0 Then
    If Val(txtWidth(0).Text) > 400 Then
      MsgBox "最大温度超限！"
    End If
 End If
End Sub

frmadjust.frm - 源码说明

本页面展示了「回流焊监控系统-DCS,VB编写,对PLC进行通讯采集和控制,界面直观,操作方便,可以作为同类软件系统提供示范」中的 frmadjust.frm 源码文件，采用 FRM 编程语言编写，共 516 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫下载站收录了大量与DCS相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?