form1.frm

WinCC 污水处理系统源程序.里面包含了许多VB6制作的功能组件.很有参考意义.

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3885
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9135
   LinkTopic       =   "Form1"
   ScaleHeight     =   3885
   ScaleWidth      =   9135
   StartUpPosition =   3  '窗口缺省
   Begin VB.ListBox List1 
      Height          =   2400
      Left            =   3960
      TabIndex        =   2
      Top             =   240
      Width           =   3375
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   615
      Left            =   3120
      TabIndex        =   1
      Top             =   3120
      Width           =   1095
   End
   Begin VB.ListBox List 
      Height          =   2760
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2775
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim AnOPCServer As OPCServer
Dim AnOPCGroups As OPCGroups
Dim RecvOPCGroup As OPCGroup
Dim SendOPCGroup As OPCGroup
Dim RecvOPCItems As OPCItems
Dim SendOPCItems As OPCItems
Dim ServerHandle() As Long
Dim ServerError() As Long
Dim RecvOPCItemIDs(1 To 2) As String
Dim SendOPCItemIDs(1 To 10) As String
Dim RecvClientHandles(1 To 2) As Long
Dim SendClientHandles(1 To 10) As Long

Private Sub Command1_Click()
Dim RecvVal() As Variant
Dim BeginTime(1 To 5) As String
Dim EndTime(1 To 5) As String
Dim pos1
Dim pos2

RecvOPCGroup.SyncRead OPCCache, 2, ServerHandle, RecvVal, ServerError
List.AddItem RecvVal(1)
List.AddItem RecvVal(2)

BeginTime(1) = Left(RecvVal(1), 2)
BeginTime(1) = "20" + BeginTime(1)

BeginTime(2) = Mid(RecvVal(1), 4, 2)
BeginTime(2) = Str(Val(BeginTime(2)))

pos1 = InStr(1, RecvVal(1), " ")
BeginTime(3) = Mid(RecvVal(1), pos1 - 2, 2)

pos2 = pos1 + 1
If Mid(RecvVal(1), pos2, 2) = "上午" Then
    pos2 = pos1 + 4
    BeginTime(4) = Mid(RecvVal(1), pos2, 2)
ElseIf Mid(RecvVal(1), pos2, 2) = "下午" Then
    pos2 = pos1 + 4
    BeginTime(4) = Str(Val(Mid(RecvVal(1), pos2, 2)) + 12)
End If

pos2 = pos1 + 7
BeginTime(5) = Mid(RecvVal(1), pos2, 2)


EndTime(1) = Left(RecvVal(2), 2)
EndTime(1) = "20" + EndTime(1)

EndTime(2) = Mid(RecvVal(2), 4, 2)
EndTime(2) = Str(Val(EndTime(2)))

pos1 = InStr(1, RecvVal(2), " ")
EndTime(3) = Mid(RecvVal(2), pos1 - 2, 2)

pos2 = pos1 + 1
If Mid(RecvVal(2), pos2, 2) = "上午" Then
    pos2 = pos1 + 4
    EndTime(4) = Mid(RecvVal(2), pos2, 2)
ElseIf Mid(RecvVal(2), pos2, 2) = "下午" Then
    pos2 = pos1 + 4
    EndTime(4) = Str(Val(Mid(RecvVal(2), pos2, 2)) + 12)
End If

pos2 = pos1 + 7
EndTime(5) = Mid(RecvVal(2), pos2, 2)

Dim SendVal(1 To 10) As Variant
For i = 1 To 5
SendVal(i) = Val(BeginTime(i))
SendVal(i + 5) = Val(EndTime(i))
Next i

SendOPCGroup.SyncWrite 10, ServerHandle, SendVal, ServerError

End Sub

Private Sub Form_Load()
Set AnOPCServer = New OPCServer
AnOPCServer.Connect "OPCServer.WinCC"

Set AnOPCGroups = AnOPCServer.OPCGroups
Set RecvOPCGroup = AnOPCGroups.Add("rece")
Set SendOPCGroup = AnOPCGroups.Add("send")

RecvOPCItemIDs(1) = "BeginTime"
RecvOPCItemIDs(2) = "EndTime"

SendOPCItemIDs(1) = "BeginYear"
SendOPCItemIDs(2) = "BeginMonth"
SendOPCItemIDs(3) = "BeginDay"
SendOPCItemIDs(4) = "BeginHour"
SendOPCItemIDs(5) = "BeginMinute"
SendOPCItemIDs(6) = "EndYear"
SendOPCItemIDs(7) = "EndMonth"
SendOPCItemIDs(8) = "EndDay"
SendOPCItemIDs(9) = "EndHour"
SendOPCItemIDs(10) = "EndMinute"

For i = 1 To 2
RecvClientHandles(i) = i
Next i

For i = 1 To 10
SendClientHandles(i) = i + 2
Next i

Set RecvOPCItems = RecvOPCGroup.OPCItems
RecvOPCItems.AddItems 2, RecvOPCItemIDs, RecvClientHandles, ServerHandle, ServerError

Set SendOPCItems = SendOPCGroup.OPCItems
SendOPCItems.AddItems 10, SendOPCItemIDs, SendClientHandles, ServerHandle, ServerError

End Sub