opcform.frm

西门子 通信程序 vb与西门子PLc通讯程序源码

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form opcForm 
   Caption         =   "opcForm"
   ClientHeight    =   7455
   ClientLeft      =   6015
   ClientTop       =   2100
   ClientWidth     =   5730
   LinkTopic       =   "Form1"
   ScaleHeight     =   7455
   ScaleWidth      =   5730
   Begin VB.CommandButton Command5 
      Caption         =   "移出项目"
      Enabled         =   0   'False
      Height          =   345
      Left            =   3630
      TabIndex        =   13
      Top             =   360
      Width           =   885
   End
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Height          =   255
      Left            =   210
      TabIndex        =   12
      Top             =   60
      Width           =   4155
      _ExtentX        =   7329
      _ExtentY        =   450
      _Version        =   393216
      Appearance      =   1
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退   出"
      Height          =   435
      Left            =   3150
      TabIndex        =   11
      Top             =   6930
      Width           =   1185
   End
   Begin VB.CommandButton Command3 
      Caption         =   "读 数 据"
      Enabled         =   0   'False
      Height          =   435
      Left            =   180
      TabIndex        =   10
      Top             =   6930
      Width           =   1185
   End
   Begin VB.CommandButton Command4 
      Caption         =   "写 数 据"
      Enabled         =   0   'False
      Height          =   435
      Left            =   1665
      TabIndex        =   2
      Top             =   6930
      Width           =   1185
   End
   Begin VB.CommandButton Command2 
      Caption         =   "加入项目"
      Height          =   345
      Left            =   2670
      TabIndex        =   1
      Top             =   360
      Width           =   885
   End
   Begin VB.Frame Frame1 
      Caption         =   "监视数据项目数"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   6495
      Left            =   210
      TabIndex        =   0
      Top             =   360
      Width           =   4455
      Begin VB.PictureBox Picture2 
         Height          =   5985
         Left            =   120
         ScaleHeight     =   5925
         ScaleWidth      =   3735
         TabIndex        =   5
         Top             =   360
         Width           =   3795
         Begin VB.PictureBox Picture1 
            Height          =   5895
            Left            =   0
            ScaleHeight     =   5835
            ScaleWidth      =   3645
            TabIndex        =   6
            Top             =   0
            Width           =   3705
            Begin VB.TextBox Text2 
               BeginProperty Font 
                  Name            =   "MS Sans Serif"
                  Size            =   9.75
                  Charset         =   0
                  Weight          =   400
                  Underline       =   0   'False
                  Italic          =   0   'False
                  Strikethrough   =   0   'False
               EndProperty
               Height          =   375
               Index           =   0
               Left            =   690
               TabIndex        =   8
               Text            =   "2,QB0,byte"
               Top             =   60
               Width           =   1935
            End
            Begin VB.TextBox Text1 
               BeginProperty Font 
                  Name            =   "MS Sans Serif"
                  Size            =   9.75
                  Charset         =   0
                  Weight          =   400
                  Underline       =   0   'False
                  Italic          =   0   'False
                  Strikethrough   =   0   'False
               EndProperty
               Height          =   375
               Index           =   0
               Left            =   2670
               TabIndex        =   7
               Text            =   "00000000"
               Top             =   60
               Width           =   975
            End
            Begin VB.Label Label1 
               Alignment       =   2  'Center
               BackColor       =   &H80000009&
               BorderStyle     =   1  'Fixed Single
               Caption         =   "00"
               BeginProperty Font 
                  Name            =   "MS Sans Serif"
                  Size            =   9.75
                  Charset         =   0
                  Weight          =   400
                  Underline       =   0   'False
                  Italic          =   0   'False
                  Strikethrough   =   0   'False
               EndProperty
               Height          =   375
               Index           =   0
               Left            =   60
               TabIndex        =   9
               Top             =   60
               Width           =   585
            End
         End
      End
      Begin VB.VScrollBar VScroll1 
         Height          =   6135
         LargeChange     =   100
         Left            =   3930
         Max             =   1000
         SmallChange     =   10
         TabIndex        =   4
         Top             =   300
         Value           =   10
         Width           =   375
      End
      Begin VB.TextBox Text3 
         Alignment       =   2  'Center
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   1830
         TabIndex        =   3
         Text            =   "99"
         Top             =   0
         Width           =   615
      End
   End
End
Attribute VB_Name = "opcForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Base 1   ' All OPC Automation Arrays start with 1

' ----------------------
' |  OPCServer         |
' |     -------------- |
' |     | OPCGoups   | |
' |     | Collection | |
' -------------|--------
'              |
'       -------|--------------
'       |  OPCGoup           |
'       |     -------------- |
'       |     | OPCItems   | |
'       |     | Collection | |
'       ----------|-----------
'                 |
'                 |  -----------
'                 |--| OPCItem |
'                 |  -----------
'                 |  -----------
'                 |--| OPCItem |
'                 |  -----------

Dim MyOPCServer As OPCServer        ' OPCServer Object
Dim MyGroups As OPCGroups           ' OPCGroups Collection Object
Dim MyGroup As OPCGroup  ' OPCGroup Object
Dim MyItems As OPCItems             ' OPCItems Collection Object
Dim MyItemServerHandles() As Long   ' Server Handles for Items
Dim MyTID As Long                       ' Transaction ID for asynchronous calls



Private Sub Command1_Click()
  End
End Sub

Private Sub Command2_Click()
    On Error Resume Next
    Dim i, N As Integer
    N = Val(Text3.Text) + 1
    Dim ItemObj As OPCItem
    Dim ItemIDs(100) As String
    Dim ItemClientHandles(100) As Long
    Dim Errors() As Long
    Set MyItems = MyGroup.OPCItems  ' 自MyOPCServer取得 OPCItems
  
    For i = 1 To N
      ItemIDs(i) = Text2(i - 1).Text ' 自Text1(i)读ItemId
    Next
    
    Call MyItems.AddItems(N, ItemIDs, ItemClientHandles, MyItemServerHandles, Errors)
      ' 加入项目到Group中
  
    For i = 1 To N
        If Not Errors(i) = 0 Then
            MsgBox "Item " + Str$(i) + " FAILED. Error Code = " + Str$(Errors(i)), vbCritical
            ErrorFlag = True
        End If
    Next
    Command2.Enabled = False
    Command5.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
    For i = 0 To Val(Text3.Text)
       Text2(i).Enabled = False
    Next
        
End Sub





Private Sub Command3_Click()
    If ProgressBar1.Value <> ProgressBar1.Max Then Exit Sub
    '等待上次读、写完成
    Dim i, N As Long
    Dim Values() As Variant
    Dim Errors() As Long         ' 出错数组
    Dim Qualities As Variant   ' Qualities值反馈数组
    Dim TimeStamps As Variant  ' 时间标志数组
    N = Val(Text3.Text) + 1
    ProgressBar1.Value = 10
    Call MyGroup.SyncRead(OPCDevice, N, MyItemServerHandles, Values, Errors, Qualities, TimeStamps)
       ' 同步读数据
    For i = 1 To N '16
       If Qualities(i) = 192 Then '正常
                Text1.Item(i - 1).Text = Values(i) '把值写入Text（i）
                Text1.Item(i - 1).BackColor = &HFFFFFF
            Else   '出错
                Text1.Item(i - 1).BackColor = &H8080FF
       End If
       ProgressBar1.Value = i
    Next
    ProgressBar1 = ProgressBar1.Max '置完成标志
End Sub

Private Sub Command4_Click()
    If ProgressBar1.Value <> ProgressBar1.Max Then Exit Sub
       '等待上次读、写完成
    Dim i, N As Integer
    N = Val(Text3.Text) + 1
    Dim Values(100) As Variant
    Dim Errors() As Long             ' 出错数组
    ProgressBar1.Value = 2
    For i = 1 To N
        Values(i) = Text1(i - 1).Text ' 自Text(i)向 Values(i)赋值
    Next
    ProgressBar1.Value = 20
    ' 同步写数据
    Call MyGroup.SyncWrite(N, MyItemServerHandles, Values, Errors)
    For i = 1 To N  ' 错误检查
       If Not Errors(i) = 0 Then
         MsgBox "Item " + Str$(i) + " FAILED. Error Code = " + Str$(Errors(i)), vbCritical
       End If
       ProgressBar1.Value = i
    Next
    ProgressBar1 = ProgressBar1.Max '置完成标志

End Sub



Private Sub Command5_Click()
    Dim i As Long
    Dim Errors() As Long  '定义返回错误数组
    Call MyItems.Remove(2, MyItemServerHandles, Errors)
    '调移除项目方法
    For i = 1 To 2 ' 检查错误
        If Not Errors(i) = 0 Then MsgBox "Item " + Str$(i) + " FAILED. Error Code = " + Str$(Errors(i)), vbCritical
    Next
    Erase MyItemServerHandles  '清除项目句柄
    ' 以下为设定按键状态
    Command2.Enabled = True
    Command2.Enabled = True
    Command2.Enabled = True
    Command5.Enabled = False
    For i = 0 To Val(Text3.Text)
       Text2(i).Enabled = True
    Next
End Sub

Private Sub Form_Load()
   On Error Resume Next
   Picture1.Height = (Val(Text3.Text) + 1) * Text1(0).Height
   For i% = 1 To Val(Text3.Text + 1)
     ProgressBar1.Value = i%
     Load Text1(i%)     ' 加载Text1
     Set Text1(i%).Container = Picture1
     Text1(i%).Visible = True
     Text1(i%).Left = Text1(0).Left
     Text1(i%).Top = Text1(0).Top + i% * Text1(0).Height
     
     Load Text2(i%)     ' 加载Text2
     Set Text2(i%).Container = Picture1
     Text2(i%).Visible = True
     Text2(i%).Left = Text2(0).Left
     Text2(i%).Top = Text2(0).Top + i% * Text2(0).Height
     Text2(i%).Text = "2,VB" + Trim(Str(i% - 1)) + ",byte"
     
     Load Label1(i%)     ' 加载Label1
     Set Label1(i%).Container = Picture1
     Label1(i%).Visible = True
     Label1(i%).Left = Label1(0).Left
     Label1(i%).Top = Label1(0).Top + i% * Text1(0).Height
     Label1(i%).Caption = Format(i%, "00")
   Next
   Set MyOPCServer = New OPCServer  ' 建立OPC服务器对象
   MyOPCServer.Connect ("S7200.OPCServer") '建立连接
   Set MyGroups = MyOPCServer.OPCGroups
      '自MyOPCServer取得 OPCGroups 集合对象
   MyGroups.DefaultGroupIsActive = 500 ' 设定数据更新时间为 500 ms
   Set MyGroup = MyGroups.Add("Group1") '加入新Group到Groups 集合中
   ProgressBar1.Value = ProgressBar1.Max
End Sub

Private Sub Text3_Change()
  If Val(Text3.Text) > 99 Then Text3.Text = 99
  If Val(Text3.Text) < 2 Then Text3.Text = 2
  Call Form_Load
End Sub

Private Sub VScroll1_Change()
  VScroll1.Max = 1000
  Picture1.Top = -VScroll1.Value * 32
End Sub