frmmain.frm

opc 通讯 册测试通讯OPC使用 客户端/服务端

                            mnuListViewSetInactive.Enabled = False
                            mnuListViewWriteValue.Visible = False
                            mnuListViewWriteValue.Enabled = False
                            mnuListViewDelete.Visible = False
                            mnuListViewDelete.Enabled = False
                        End If
                    Else
                        mnuListViewSetActive.Visible = False
                        mnuListViewSetActive.Enabled = False
                        mnuListViewSetInactive.Visible = False
                        mnuListViewSetInactive.Enabled = False
                        mnuListViewWriteValue.Visible = False
                        mnuListViewWriteValue.Enabled = False
                        mnuListViewDelete.Visible = False
                        mnuListViewDelete.Enabled = False
                    End If
                    frmMain.PopupMenu mnuListView
                    
                End If
            End If
        End If
    End If
End Sub

Private Sub mnuListViewSetActive_Click()
    If Not Module1.SelectedOPCItem Is Nothing Then
        Module1.SelectedOPCItem.SetItemActiveState (True)
    End If
End Sub

Private Sub mnuListViewSetInactive_Click()
    
    If Not Module1.SelectedOPCItem Is Nothing Then
        Module1.SelectedOPCItem.SetItemActiveState (False)
    End If
End Sub

Private Sub mnuListViewWriteValue_Click()
    Load frmWriteItem
    frmWriteItem.Show
    tvTreeView.Enabled = False
End Sub

Private Sub mnuListViewDelete_Click()
    On Error GoTo SkipItemDelete
      
    Dim Result As Boolean
    Dim Error As Long
    Result = Module1.SelectedOPCGroup.RemoveOPCItem(lvListView.SelectedItem.Key, Error)
    If Result = True Then
        Set Module1.SelectedOPCItem = Nothing
        lvListView.ListItems.Remove (lvListView.SelectedItem.Key)
    End If
    
SkipItemDelete:
End Sub

Private Sub mnuListViewNewItem_Click()
    Load frmAddItem
    frmAddItem.Show
    tvTreeView.Enabled = False
End Sub

Private Sub Timer1_Timer()
    On Error GoTo SkipDisplayUpdate
    
    Dim OPCGroupItemsCls As Collection
    If InStr(tvTreeView.SelectedItem.Key, "Group") Then
    
        Dim OPCGroupToUpdate As OPCGroupClass
        Dim OPCItemData As OPCItemClass
        Dim OPCServerGroupsCls As Collection
        
        Set OPCServerGroupsCls = Module1.SelectedOPCServer.GetOPCServerGroupCollection
        Set OPCGroupToUpdate = OPCServerGroupsCls.Item(tvTreeView.SelectedItem.Key)
        Set OPCGroupItemsCls = OPCGroupToUpdate.GetOPCGroupItemsCollection
        If OPCGroupItemsCls.Count = 0 Then
            GoTo SkipDisplayUpdate
        End If
        Dim itmX As ListItem
        Set itmX = lvListView.GetFirstVisible
        If Not itmX Is Nothing Then
            Dim NumLinesDisplayed  As Integer
            NumLinesDisplayed = (lvListView.Height / 214)
            
            Dim I As Integer
            Dim a As Integer
            Dim GroupItemIndex As Integer
            Dim OPCItemToUpdate As OPCItemClass
            Dim Quality As Long
            Dim ItemValue As Variant
            a = itmX.Index
            If LastTopItem <> a Then
                If LastTopItem <> -1 Then
                    Set lvListView.SelectedItem = itmX
                End If
                LastTopItem = a
            End If
                       
            For I = 1 To NumLinesDisplayed
                GroupItemIndex = Val(Mid(itmX.Key, InStr(itmX.Key, " ")))
                Set OPCItemToUpdate = OPCGroupItemsCls.Item(Str(GroupItemIndex))
                
                ItemValue = OPCItemToUpdate.GetItemValue(OPCItemLocal)
                
                If Not IsArray(ItemValue) Then
                    itmX.SubItems(1) = ItemValue
                Else
                    Dim b As Integer
                    itmX.SubItems(1) = "" ' listview item string to start
                    For b = 0 To UBound(ItemValue)
                        itmX.SubItems(1) = itmX.SubItems(1) + Str(ItemValue(b)) + ", "
                    Next b
                End If
                Quality = OPCItemToUpdate.GetItemQuality(OPCItemLocal)
                If Quality And &HC0 Then
                    itmX.SubItems(2) = "Good"
                Else
                    itmX.SubItems(2) = "Bad" + Str(Quality)
                End If
                a = a + 1
                Set itmX = lvListView.ListItems.Item(a)
            Next I
            
      End If
        
    End If
SkipDisplayUpdate:
End Sub

Sub AddSelectedOPCServerMain(OPCServerName As String)
    Dim OPCServer As OPCServerClass
    Set OPCServer = New OPCServerClass
    Dim Result As Boolean
    
    Dim SrvName As String
    SrvName = "Server" + Str(Module1.ServerIndex)
    Result = OPCServer.ConnectOPCServer(OPCServerName, SrvName, Module1.ServerIndex)
    Module1.ServerIndex = Module1.ServerIndex + 1
    If (Result = True) Then
           
        With OPCServers
           .Add OPCServer, SrvName
        End With
    
        Dim nodX As Node    ' Declare Node variable.
        Set nodX = fMainForm.tvTreeView.Nodes.Add(, , SrvName, OPCServerName)
        nodX.EnsureVisible
    
        Set Module1.SelectedOPCServer = OPCServer
        Set Module1.SelectedOPCGroup = Nothing
        Set Module1.SelectedOPCItem = Nothing
        lvListView.ListItems.Clear
    
    End If
    End Sub
    
Sub AddOPCGroupMain(ByVal GroupName As String, ByVal UpdateRate As Long, ByVal DeadBand As Single, ByVal ActiveState As Boolean)
    
    Dim GroupKey As String
    If Module1.SelectedOPCServer.AddOPCGroup(GroupName, UpdateRate, DeadBand, ActiveState, GroupKey) = True Then
        Dim nodX As Node    ' Declare Node variable.
        Set nodX = fMainForm.tvTreeView.Nodes.Add(Module1.SelectedOPCServer.GetOPCServerKey, tvwChild, GroupKey, GroupName) ' + Str(Module1.SelectedOPCServer.GetOPCServerIndex)
        nodX.EnsureVisible
    End If
End Sub

Function AddOPCItemMain(ByVal ItemID As String, ByVal DataTypeSelected As Integer, ByVal ActiveState As Integer)
    
    Dim ItemKey As String
    If Not Module1.SelectedOPCGroup Is Nothing Then
        If Module1.SelectedOPCGroup.AddOPCItem(ItemID, DataTypeSelected, ActiveState, ItemKey) = False Then
            AddOPCItemMain = False
            GoTo ErrorOnAdd
        End If
    End If
    
    Dim itmX As ListItem
    Set itmX = lvListView.ListItems.Add(, ItemKey, ItemID)
    itmX.SubItems(1) = "" 'Initialize to no value
    itmX.SubItems(2) = "Bad" ' Initialize to Bad quality
    AddOPCItemMain = True
ErrorOnAdd:
End Function
    
Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuViewStatusBar_Click()
    If mnuViewStatusBar.Checked Then
        sbStatusBar.Visible = False
        mnuViewStatusBar.Checked = False
    Else
        sbStatusBar.Visible = True
        mnuViewStatusBar.Checked = True
    End If
    SizeControls imgSplitter.Left
End Sub

Private Sub mnuViewUpdateDispaly_Click()
    Load frmItemUpdateInterval
    frmItemUpdateInterval.Show
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If Me.Width < 3000 Then Me.Width = 3000
    SizeControls imgSplitter.Left
End Sub

Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With imgSplitter
        picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    picSplitter.Visible = True
    mbMoving = True
End Sub

Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim sglPos As Single
    If mbMoving Then
        sglPos = X + imgSplitter.Left
        If sglPos < sglSplitLimit Then
            picSplitter.Left = sglSplitLimit
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            picSplitter.Left = Me.Width - sglSplitLimit
        Else
            picSplitter.Left = sglPos
        End If
    End If
End Sub


Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SizeControls picSplitter.Left
    picSplitter.Visible = False
    mbMoving = False
End Sub


Sub SizeControls(X As Single)
    On Error Resume Next
    

    'set the width
    If X < 3500 Then X = 2500
    If X > (Me.Width - 2500) Then X = Me.Width - 2500
    tvTreeView.Width = X
    imgSplitter.Left = X
    lvListView.Left = X + 40
    lvListView.Width = Me.Width - (tvTreeView.Width + 140)
    lblTitle(0).Width = tvTreeView.Width
    lblTitle(1).Left = lvListView.Left + 20
    lblTitle(1).Width = lvListView.Width - 40


        
    tvTreeView.Top = picTitles.Height
    lvListView.Top = tvTreeView.Top
    

    'set the height
    If sbStatusBar.Visible Then
        tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height + sbStatusBar.Height)
    Else
        tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height)
    End If
    

    lvListView.Height = tvTreeView.Height
    imgSplitter.Top = tvTreeView.Top
    imgSplitter.Height = tvTreeView.Height
End Sub


Private Sub TreeView1_DragDrop(Source As Control, X As Single, Y As Single)
    If Source = imgSplitter Then
        SizeControls X
    End If
End Sub

Private Sub mnuFileExit_Click()
    'unload the form
    Unload Me
End Sub