trend.frm

此文件为OPC client VBTend 源代码,在VB开发环境下调试运行

    Picture1.Left = 0
    'Make sure the form is not minimized!
    If MyClientHeight < Picture1.Height + 1 Then
        'do nothing if minimized
    Else
        If MyClientHeight < Picture1.Top + Picture1.Height - tbToolBar.Height Then
            Picture1.Top = MyClientHeight + tbToolBar.Height - Picture1.Height - 1
        End If
    
        'Set ListView1 to the Width and Height of form1
        ListView1.Top = tbToolBar.Height
        ListView1.Width = ScaleWidth
        If Picture1.Top - tbToolBar.Height < 0 Then
            ListView1.Height = 0
        Else
            ListView1.Height = Picture1.Top - tbToolBar.Height
        End If
        Picture1.Width = ScaleWidth
        'Set MSChart1 to the Width and Height of Form1
        MSChart1.Top = Picture1.Top + Picture1.Height
        MSChart1.Width = ScaleWidth
        MSChart1.Height = MyClientHeight - Picture1.Top - Picture1.Height + tbToolBar.Height
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer


    'close all sub forms
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub
Private Sub ListView1_DragDrop(Source As Control, x As Single, Y As Single)
    If Y > 0 Then
        Picture1.Top = Y + tbToolBar.Height         'Move splitter bar.
        Form_Resize
    End If
End Sub




Private Sub MSChart1_DragDrop(Source As Control, x As Single, Y As Single)
    If Y < MSChart1.Height Then
        Picture1.Top = Y - Picture1.Height + MSChart1.Top
        Form_Resize
    End If
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "Open"
            mnuFileOpen_Click
        Case "Connect"
            mnuConnect_Click
        Case "Disconnect"
            mnuDisconnect_Click
    End Select
End Sub

Private Sub mnuConnect_Click()
    On Error GoTo Error
    
    Dim bOPCAutoDLL As Boolean
    bOPCAutoDLL = False
    
    If bConnected = True Then
        Exit Sub
    End If
    
    'connect to server and create a group
    Set InfoSvr = New OPCServer
    bOPCAutoDLL = True
    
    'connest to server dialog
    With ConnectServer
        .Show vbModal
        If .iButtonPressed = 1 Then
            InfoSvr.Connect .sOPCServer, .sServerComputer
            bConnected = True
            mnuConnect.Enabled = False
            mnuDisconnect.Enabled = True
        Else
            Exit Sub
        End If
    End With
        
        
    Set oGroups = InfoSvr.OPCGroups
    
    Set oGroup = oGroups.Add("Group1")
    oGroup.IsActive = True
    oGroup.IsSubscribed = True
    oGroup.UpdateRate = 100
    oGroup.TimeBias = GetTimeBias() 'offset in minutes from GMT to local time
    Set oItems = oGroup.OPCItems
    Exit Sub
    
Error:
    bConnected = False
    mnuConnect.Enabled = True
    mnuDisconnect.Enabled = False
    
    If bOPCAutoDLL = False Then
        MsgBox "OPC Automation DLL not registered."
    Else
        MsgBox InfoSvr.GetErrorString(Err.Number)
    End If
    
End Sub

Private Sub mnuDisconnect_Click()
    
    InfoSvr.Disconnect
    bConnected = False
    mnuDisconnect.Enabled = False
    mnuConnect.Enabled = True
      
End Sub


Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuHelpSearchForHelpOn_Click()
    Dim nRet As Integer


    'if there is no helpfile for this project display a message to the user
    'you can set the HelpFile for your application in the
    'Project Properties dialog
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub

Private Sub mnuHelpContents_Click()
    Dim nRet As Integer


    'if there is no helpfile for this project display a message to the user
    'you can set the HelpFile for your application in the
    'Project Properties dialog
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub



Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    sbStatusBar.Visible = mnuViewStatusBar.Checked
End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    tbToolBar.Visible = mnuViewToolbar.Checked
End Sub


Private Sub mnuFileExit_Click()
    'unload the form
    Unload Me
    
    If bConnected = True Then
        InfoSvr.Disconnect
    End If
    
End Sub


Private Sub mnuFilePageSetup_Click()
    On Error Resume Next
    With dlgCommonDialog
        .DialogTitle = "Page Setup"
        .CancelError = True
        .ShowPrinter
    End With

End Sub

Private Sub mnuFileOpen_Click()
    On Error GoTo Error
    
    If bConnected = True Then
    
        Dim addItemCount As Long
        Dim OPCItemIDs(1) As String
        Dim ItemServerHandles() As Long
        Dim ItemServerErrors() As Long
        Dim RequestedDataTypes As Variant
        Dim AccessPaths As Variant
        Dim ClientHandles(1) As Long
    
        'browser dialog
        With Browser
            .Show vbModal
            If .iButtonPressed = 1 Then
                OPCItemIDs(1) = .sTag
            Else
                Exit Sub
            End If
        End With
    
        'add item
        ClientHandles(1) = 1
        oItems.AddItems 1, OPCItemIDs, ClientHandles, ItemServerHandles, ItemServerErrors, RequestedDataTypes, AccessPaths
        Set oPoint = oItems.GetOPCItem(ItemServerHandles(1))
        oItems.SetActive 1, ItemServerHandles, True, ItemServerErrors
    
        'properties (number of data entries, sync/async read)
        With Options
            .Show vbModal
            If .iButtonPressed = 1 Then
                Dim Values() As Variant
                Dim Qualities As Variant 'array in varinat
                Dim TimeStamps As Variant 'array in varinat
                Dim Errors() As Long
                Dim ServerHandles() As Long
                ReDim ServerHandles(.Samples)
                
                For Index = 1 To .Samples
                    ServerHandles(Index) = ItemServerHandles(1)
                Next Index
        
                If .ReadMode = 0 Then 'sync
                    
                    oGroup.SyncRead OPCCache, .Samples, ServerHandles, Values, Errors, Qualities, TimeStamps
    
                    UpdateViews .Samples, Values, Qualities, TimeStamps, Errors()
                    
                ElseIf .ReadMode = 1 Then 'async
                'no async trend read !

                Else
                    Exit Sub
                End If
            Else
                Return
            End If
        End With

    Else
        MsgBox "You must first connect to an OPC server!"
    End If

    Exit Sub
    
    'Dim sFile As String

    
   
    'ToDo: add code to process the opened file
    
Error:
    bConnected = False
    MsgBox InfoSvr.GetErrorString(Err.Number)

End Sub




Private Sub UpdateViews(NumItems As Long, ItemValues() As Variant, Qualities As Variant, TimeStamps As Variant, Errors() As Long)
    
    ' clear first !
    'ListView1.ListItems = Null
    
    MSChart1.RowCount = NumItems
    MSChart1.ColumnCount = 1
    MSChart1.Column = 1
                
    Dim itmX As ListItem
    
    For Index = 1 To NumItems
        Dim bDataLoss As Boolean
        Dim bAlarm As Boolean
        Dim bNotValid As Boolean
        Dim wQuality As Long
        Dim wPriority As Long
        Dim sPriority As String
                    
        wQuality = Qualities(Index)
                    
        'If wQuality And Hex(4000) Then
        If wQuality And 16384 Then
            bDataLoss = True
        Else
            bDataLoss = False
        End If
            
        'If wQuality And Hex(2000) Then
        If wQuality And 8192 Then
            bAlarm = True
        Else
            bAlarm = False
        End If
            
        'If wQuality And Hex(8000) Then
        If wQuality And 32768 Then
            bNotValid = True
        Else
            bNotValid = False
        End If
                        
        If Not bNotValid Then
        
            'timestamp
            Dim TimeOfValue As Date
            Dim sTimeOfValue As String
            TimeOfValue = TimeStamps(Index) - (oGroup.TimeBias / (24 * 60)) ' adding/subtracting hours (offset is minutes)
            sTimeOfValue = Format(TimeOfValue, "m/d/yy hh:mm:ss") ' overwrite the control panel setting
            
            'graph
            MSChart1.Row = Index
            MSChart1.Data = ItemValues(Index)
            MSChart1.RowLabel = sTimeOfValue
            
            'list
            Set itmX = ListView1.ListItems.Add(, , sTimeOfValue) 'TimeStamp
            itmX.SubItems(1) = CStr(ItemValues(Index)) 'Value
                    
            'wPriority = wQuality AND Hex(0F00) 'retrieve the priority bits
            wPriority = wQuality And 3840 'retrieve the priority bits
            'wPriority = wPriority >>8;
            wPriority = wPriority / 256
                   
            Select Case wPriority
            Case 0
                sPriority = "NONE"
            Case 1
                sPriority = "PDL"
            Case 2
                sPriority = "EMER"
            Case 3
                sPriority = "SMOKE"
            Case 4
                sPriority = "OPER"
            Case 5
                sPriority = "TECOVRD"
            Case 6
                sPriority = "HOST_2"
            Case 7
                sPriority = "HOST_3"
            Case 8
                sPriority = "HOST_4"
            Case 9
                sPriority = "HOST_5"
            Case 10
                sPriority = "HOST_6"
            Case 12 To 15
                sPriority = "NONE"
            Case 11
                sPriority = "UNKNOWN"
            Case Else 'default
                sPriority = "UNKNOWN"
            End Select
                    
            itmX.SubItems(2) = CStr(sPriority) 'Priority
                        
            If bAlarm Then 'Alarm
                itmX.SubItems(3) = "Yes"
            Else
                itmX.SubItems(3) = "No"
            End If
                        
            If bDataLoss Then 'Dataloss
                itmX.SubItems(4) = "Yes"
            Else
                itmX.SubItems(4) = "No"
            End If
                            
        End If
    Next Index

    MSChart1.Footnote = "Found samples: " + CStr(ListView1.ListItems.Count) + " of " + CStr(NumItems)
End Sub