frmmain.frm

此文件为VB开发环境下的OPC client DynPlot 源代码

    bConnected = False
    bPointValid = False
    Index = 1
    
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    
    ListView1.ColumnHeaders.Add , , "Time", ListView1.Width / 5
    ListView1.ColumnHeaders.Add , , "Value", ListView1.Width / 5 ', lvwColumnCenter

    
    MSChart1.RowCount = 0
    MSChart1.ColumnCount = 1
    MSChart1.Column = 1
    'MSChart1.Row = 1
    'MSChart1.RowLabel = ""
    
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 Form_Resize()
    Dim MyClientHeight As Single
    MyClientHeight = ScaleHeight - sbStatusBar.Height - tbToolBar.Height

    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 mnuConnect_Click()
    On Error GoTo Error
    
    If bConnected = True Then
        Exit Sub
    End If
    
    Dim bOPCAutoDLL As Boolean
    bOPCAutoDLL = False
    
    '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
        
    If bConnected = True Then
        Set oGroups = InfoSvr.OPCGroups
        Set oGroup = oGroups.Add("Group1")
        oGroup.IsActive = True
        oGroup.IsSubscribed = True
        oGroup.UpdateRate = 100
        oGroup.TimeBias = GetTimeBias() 'offset from GMT to local time in minutes
        Set oItems = oGroup.OPCItems
    Else
        MsgBox "Could not create a group."
    End If
    
    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()

    fMainForm.Caption = "IsVBDynPlot"
    bPointValid = False
        
    InfoSvr.Disconnect
    bConnected = False
    mnuDisconnect.Enabled = False
    mnuConnect.Enabled = True
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 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 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 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 mnuFileExit_Click()
    'unload the form
    Unload Me
    
    If bConnected = True Then
        bPointValid = False
        InfoSvr.Disconnect
    End If

End Sub

Private Sub mnuFileClose_Click()
    On Error GoTo Error
    
    If bConnected = True And bPointValid = True Then
        Dim ItemServerErrors() As Long
        Dim ServerHandles(1) As Long
        
        ServerHandles(1) = oPoint.ServerHandle
        
        bPointValid = False
        
        oItems.Remove 1, ServerHandles, ItemServerErrors
        
        'clear the views
        ListView1.ListItems.Clear
        MSChart1.RowCount = 1
        
        fMainForm.Caption = "IsVBDynPlot"
        
    Else
        MsgBox "Not to an OPC server connected or Item not valid."
    End If
    
    Exit Sub
    
Error:
    MsgBox InfoSvr.GetErrorString(Err.Number)
    bPointValid = False
    
End Sub

Private Sub mnuFileOpen_Click()
    On Error GoTo Error

    If bConnected = True Then
        'ToDo: add code to process the opened file
        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
    
        fMainForm.Caption = "IsVBDynPlot - " + oPoint.ItemID
        bPointValid = True
    
    Else
        MsgBox "You must first connect to an OPC server!"
    End If
    
    Exit Sub

Error:
    MsgBox InfoSvr.GetErrorString(Err.Number)
    
End Sub

Private Sub Timer1_Timer()
    
    If bPointValid 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(1)
            
        ServerHandles(1) = oPoint.ServerHandle
                    
        oGroup.SyncRead OPCCache, 1, ServerHandles, Values, Errors, Qualities, TimeStamps
        
        UpdateViews 1, Values, Qualities, TimeStamps, Errors
        
    End If

End Sub

Private Sub UpdateViews(NumItems As Long, ItemValues() As Variant, Qualities As Variant, TimeStamps As Variant, Errors() As Long)
               
    'timestamp
    Dim TimeOfValue As Date
    Dim sTimeOfValue As String
    TimeOfValue = TimeStamps(Index) - (oGroup.TimeBias / (24 * 60)) ' adding/subtracting hours
    sTimeOfValue = Format(TimeOfValue, "m/d/yy hh:mm:ss") ' overwrite the control panel setting
            
    'graph
    Dim maxRow As Integer
    maxRow = 50
    If MSChart1.RowCount >= maxRow Then
        'shift all the rows left
        Dim ir As Integer
        Dim TempValue As String
        Dim TempLabel As String
        For ir = 2 To maxRow
            MSChart1.Row = ir
            TempValue = MSChart1.Data
            TempLabel = MSChart1.RowLabel
            MSChart1.Row = ir - 1
            MSChart1.Data = TempValue
            MSChart1.RowLabel = TempLabel
        Next ir
        MSChart1.Row = maxRow
        MSChart1.Data = ItemValues(1)
    Else
        MSChart1.RowCount = MSChart1.RowCount + 1
        MSChart1.Row = MSChart1.RowCount
        MSChart1.Data = ItemValues(1)
        MSChart1.RowLabel = sTimeOfValue
    End If
            
    'list
    Dim itmX As ListItem
    If ListView1.ListItems.Count >= 2 * maxRow Then
        ListView1.ListItems.Remove (1)
    End If
        
    Set itmX = ListView1.ListItems.Add(, , sTimeOfValue) 'TimeStamp
    itmX.SubItems(1) = CStr(ItemValues(Index)) 'Value
                                   
    itmX.EnsureVisible
    
End Sub