mtag.bas

来自「opc client 的开发工具」· BAS 代码 · 共 81 行

Attribute VB_Name = "mTag"
Public Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Public Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type

Public Type NOTIFYICONDATA
        cbSize As Long
        hwnd As Long
        uID As Long
        uFlags As Long
        uCallbackMessage As Long
        hIcon As Long
        szTip As String * 64
End Type

Public Type Tag
   TagID As String
   TagType As VbVarType
   TagValue As Variant
   TagHandle As Long
   TagFt As FILETIME
   TagQuality As Integer
   Active As Boolean
   lvIndex As Integer
End Type

Global Const MaxTagCount = 3

Global TagList(MaxTagCount) As Tag
Global Tagcount As Integer

Global TagRefresh As Boolean
Global UpdateLog As Boolean
Global Interval As Long


Public Declare Sub GetSystemTimeAsFileTime Lib "kernel32" (lpSystemTimeAsFileTime As FILETIME)
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias " Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Public Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Public Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long


Public Sub WriteTag(ByVal Handle As Long, pNewValue As Variant, pDeviceError As Long)
    Dim I As Integer
    Dim ft As FILETIME
    Dim UpdateOK As Boolean
    
    GetSystemTimeAsFileTime ft
    For I = 1 To Tagcount
        If TagList(I).TagHandle = Handle Then
            TagList(I).TagFt = ft
            TagList(I).TagQuality = 192
            TagList(I).TagValue = pNewValue
            UpdateOK = UpdateTag(TagList(I).TagHandle, TagList(I).TagValue, TagList(I).TagQuality)
            Exit For
        End If
    Next
    pDeviceError = 0
End Sub

Public Sub ShutDownNotify(ByVal ConnectedNum As Long)
    If ConnectedNum = 0 Then
       Unload fMain
    End If
End Sub