frmmain.frm

opc的使用软件

    
    lvListView.ColumnHeaders.Add 1, "Name", "Name", 1500
    lvListView.ColumnHeaders.Add 2, "DataType", "DataType", 1000
    lvListView.ColumnHeaders.Add 3, "Value", "Value", 2200
    lvListView.ColumnHeaders.Add 4, "TimeStamp", "TimeStamp", 1900
    lvListView.ColumnHeaders.Add 5, "Quality", "Quality", 1900

    lvListView.Icons = lvwbImageList
    lvListView.SmallIcons = lvwsImageList
    
    mbReturn = KOC_Init()
    
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Disconnect
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
    'SaveSetting App.Title, "Settings", "ViewMode", lvListView.View
    
    KOC_Uninit
End Sub


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

Sub SizeControls(X As Single)
    On Error Resume Next
    
    If X < 1500 Then X = 1500
    If X > (Me.Width - 1500) Then X = Me.Width - 1500
    lvListView.Left = 10
    lvListView.Width = Me.Width - 200
    lblTitle(1).Left = lvListView.Left + 20
    lblTitle(1).Width = lvListView.Width - 40

    lvListView.Top = picTitles.Height 'tvTreeView.Top
    
    If sbStatusBar.Visible Then
        lvListView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height + sbStatusBar.Height)
    Else
        lvListView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height)
    End If
    
End Sub

Private Sub lvListView_ItemClick(ByVal Item As MSComctlLib.listItem)
    Set mListItem = Item
End Sub

Private Sub mnuAddItem_Click()
    If gConnectionHandle = -1 Then Exit Sub
    If gGroupHandle = -1 Then Exit Sub

    dlgAddItem.Show vbModal, Me
    If dlgAddItem.mbReturn = False Then Exit Sub
    
    Dim br As Boolean
    Dim itemHandle As Long
    Dim buf(100) As Byte
    StringToByte dlgAddItem.mstrName, buf
    itemHandle = KOC_AddItem(gConnectionHandle, gGroupHandle, buf(0))
    If itemHandle = -1 Then
        MsgBox "Add item failed"
        Exit Sub
    End If
    
    Dim strKey As String
    strKey = "k" & Str(itemHandle)
    g_ItemCol.Add dlgAddItem.mstrName, itemHandle, strKey
    
    
    lvListView.ListItems.Add 1, strKey, dlgAddItem.mstrName, 1, 1
End Sub

Private Sub mnuConnect_Click()
    If gConnectionHandle <> -1 Then
        MsgBox "Disconnect first!"
        Exit Sub
    End If

    ServerDlg.Show vbModal, Me
    If ServerDlg.mbReturn = False Then Exit Sub
    If Len(ServerDlg.mstrServerName) < 1 Then Exit Sub
    
    StringToByte ServerDlg.mstrMachineName, mMachineName
    StringToByte ServerDlg.mstrServerName, mServerName
    
    gConnectionHandle = KOC_Connect(mMachineName(0), mServerName(0), ServerDlg.mbVer2)
    If gConnectionHandle = -1 Then
        MsgBox "Connection failed!"
        Exit Sub
    End If
    
    mbReturn = KOC_SetShutdownProc(gConnectionHandle, AddressOf KOC_ServerShutdownProc)
    mbReturn = KOC_SetDataChangeProc(gConnectionHandle, AddressOf KOC_DataChangeProc)
    
    'add opc group
    Dim strName As String
    Dim buf(100) As Byte
    strName = "Group1"
    StringToByte strName, buf
    
    Dim bActive As Boolean
    bActive = True
    
    Dim Rate, TimeBias, LCID As Long
    Rate = 100
    TimeBias = 0
    LCID = 0
    
    Dim DeadBand As Single
    DeadBand = 0
    
    
    gGroupHandle = KOC_AddGroup(gConnectionHandle, buf(0), bActive, Rate, TimeBias, DeadBand, LCID)
    If gGroupHandle = -1 Then
        MsgBox "Add Group failed!"
        Disconnect
        Exit Sub
    End If
    
    mnuConnect.Enabled = False
    mnuDisconnect.Enabled = True
    mnuAddItem.Enabled = True
    mnuRemoveItem.Enabled = True
    mnuReadItem.Enabled = True
    mnuWriteItem.Enabled = True
    
    Timer1.Enabled = True
End Sub

Private Sub mnuDisconnect_Click()
    Disconnect
End Sub

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


Private Sub mnuVAIByDate_Click()
    'ToDo: 添加 'mnuVAIByDate_Click' 代码
'  lvListView.SortKey = DATE_COLUMN
End Sub


Private Sub mnuVAIByName_Click()
    'ToDo: 添加 'mnuVAIByName_Click' 代码
'  lvListView.SortKey = NAME_COLUMN
End Sub


Private Sub mnuVAIBySize_Click()
    'ToDo: 添加 'mnuVAIBySize_Click' 代码
'  lvListView.SortKey = SIZE_COLUMN
End Sub


Private Sub mnuVAIByType_Click()
    'ToDo: 添加 'mnuVAIByType_Click' 代码
'  lvListView.SortKey = TYPE_COLUMN
End Sub

Private Sub mnuReadItem_Click()
    If mListItem Is Nothing Then Exit Sub
    
    Dim sKey As String
    Dim pItem As CItem
    
    sKey = mListItem.Key
    Set pItem = g_ItemCol(sKey)
    Dim Var As Variant
    Dim Ft As FILETIME
    Dim Quality As Long
    mbReturn = KOC_ReadItem(gConnectionHandle, gGroupHandle, pItem.itemHandle, Var, Ft, Quality)
    If mbReturn = False Then
        MsgBox "Read item value failed!"
    End If
    pItem.ItemValue = Var
    pItem.ItemTimeStamp = Win32FileTimeToVB(Ft)
    pItem.ItemQuality = Quality
End Sub

Private Sub mnuRemoveItem_Click()
    If mListItem Is Nothing Then Exit Sub
    
    Dim sKey As String
    'Dim pItem As CItem
    
    sKey = mListItem.Key
    lvListView.ListItems.Remove mListItem.index
    g_ItemCol.Remove sKey
    
    Set mListItem = Nothing

End Sub

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


Private Sub mnuWriteItem_Click()
    If mListItem Is Nothing Then Exit Sub
    
    Dim sKey As String
    Dim pItem As CItem
    
    sKey = mListItem.Key
    Set pItem = g_ItemCol(sKey)
    
    dlgWriteItem.Show vbModal, Me
    If dlgWriteItem.mbReturn = False Then Exit Sub
    
    Dim sValue As String
    sValue = dlgWriteItem.msValue
    If sValue = "" Then Exit Sub
    Debug.Print sValue
    
    Dim Var As Variant
    'Var = CVar(dlgWriteItem.txtValue.Text)
    
    On Error GoTo Err
    
    Select Case VarType(pItem.ItemValue)
        Case vbBoolean
            Var = CBool(sValue)
        Case vbInteger
            Var = CInt(sValue)
        Case vbLong
            Var = CLng(sValue)
        Case vbSingle
            Var = CSng(sValue)
        Case vbString
            Var = CStr(sValue)
        Case Else
            GoTo Err
    End Select
    
    mbReturn = KOC_WriteItem(gConnectionHandle, gGroupHandle, pItem.itemHandle, Var, dlgWriteItem.ckAsync.Value)
    If mbReturn = False Then
        MsgBox "Write item failed!"
    Else
        Debug.Print "write ok"
    End If
    Exit Sub
    
Err:
    Exit Sub
End Sub

Private Sub Timer1_Timer()
    Dim sName, sTmp As String
    Dim pItem As CItem
    
    Dim listItem As listItem
    For Each listItem In lvListView.ListItems
        sName = listItem.Key
        Set pItem = g_ItemCol(sName)
        FormatDataType pItem.ItemValue, sTmp
        listItem.SubItems(1) = sTmp
        listItem.SubItems(2) = CStr(pItem.ItemValue)
        listItem.SubItems(3) = CStr(pItem.ItemTimeStamp)
        FormatOpcQuality pItem.ItemQuality, sTmp
        listItem.SubItems(4) = sTmp
        
    Next
End Sub