业务逻辑代码

Option Explicit

'各种设备报警信号，格式：不同报警信号之间以分号分隔，每个报警信号定义各元素之间以逗号分隔，分别为：数据库标签前缀，正常状态值，当出现报警时的报警描述
'不同的项目因设计不同表示设备正常状态的信号可能不同，因此不同的项目要分别定义

'寺家庄
'Public Const ALM_TAB = "QL,1,未送电" _
'                     + ";SS,1,停车按钮" _
'                     + ";KH,1,热继或综保" _
'                     + ";ALM_DAHUA,0,打滑" _
'                     + ";ALM_DUSE,0,堵煤" _
'                     + ";ALM_JT_PAOPIAN1_,0,机头一级跑偏;ALM_JT_PAOPIAN2_,0,机头二级跑偏" _
'                     + ";ALM_JZ_PAOPIAN1_,0,中部一级跑偏;ALM_JZ_PAOPIAN2_,0,中部二级跑偏" _
'                     + ";ALM_JW_PAOPIAN1_,0,机尾一级跑偏;ALM_JW_PAOPIAN2_,0,机尾二级跑偏"

'姚桥
'Public Const ALM_TAB = "QL,1,未送电" _
                     + ";SS,0,停车按钮" _
                     + ";KH,0,热继或综保" _
                     + ";ALM_DAHUA,0,打滑" _
                     + ";ALM_DUSE,0,堵煤" _
                     + ";ALM_JT_PAOPIAN1_,0,机头一级跑偏;ALM_JT_PAOPIAN2_,0,机头二级跑偏" _
                     + ";ALM_JZ_PAOPIAN1_,0,中部一级跑偏;ALM_JZ_PAOPIAN2_,0,中部二级跑偏" _
                     + ";ALM_JW_PAOPIAN1_,0,机尾一级跑偏;ALM_JW_PAOPIAN2_,0,机尾二级跑偏"

'SCADA服务器节点名
Public Const SCADA_NAME = "FIX"

'定义默认的数据库标签前缀
'Const KMTAG_PREFIX = "KM"
'Const KMFTAG_PREFIX = "KMF"
'Const KMRTAG_PREFIX = "KMR"
Const DQTAG_PREFIX = "DQ"
Const DTTAG_PREFIX = "DT"
Const DQFTAG_PREFIX = "DQF"
Const DQRTAG_PREFIX = "DQR"
'Const SQFTAG_PREFIX = "SQF"
'Const SQRTAG_PREFIX = "SQR"

Dim dialogs As New Collection



'当画面初始化时重新设置画面的宽度和高度，这样可避免出现推拉条


'隐藏单启单停画面中的DataLink对象
Sub InvisibleDataLinks(pic As Object)
  Dim obj As Object
  
  For Each obj In pic.ContainedObjects
    If obj.ClassName = "DataLink" Then
        obj.visible = False
    End If
  Next
End Sub
'居中窗口
Sub CenterWindow(pic As Object)
  pic.WindowTopPercentage = (100 - pic.WindowHeightPercentage) / 2
  pic.WindowLeftPercentage = (100 - pic.WindowWidthPercentage) / 2
End Sub

'打开一个对话框画面
Sub OpenDialog(pic As String, Optional TagGroupFile As String = "")
    
    Dim objPic As Object
    Dim TmpPicName As String
    
    TmpPicName = pic
    
    On Error Resume Next
    Set objPic = System.findObject(pic)
    On Error GoTo 0
    
    If Not (objPic Is Nothing) Then
        If TagGroupFile <> "" Then
          opentgdpicture TmpPicName, , , , TagGroupFile
        End If
    
        
      objPic.Parent.Active = True
      Exit Sub
    End If

    CloseDialogs
    
    If TagGroupFile = "" Then
      OpenPicture TmpPicName
    Else
      opentgdpicture TmpPicName, , , , TagGroupFile
    End If
    
    
    dialogs.Add pic
End Sub

'关闭所有对话框画面
Sub CloseDialogs()
    Dim tmp_pic As String
    Dim i As Integer
    
    For i = dialogs.Count To 1 Step -1
        tmp_pic = dialogs.Item(i)
        ClosePicture tmp_pic
        dialogs.Remove i
    Next i
End Sub

Function OperateConfirm(prompt As String)
    OperateConfirm = MsgBox(prompt, vbApplicationModal + vbYesNo + vbExclamation, "请确认您的操作!")
End Function


Sub ActiveDialogs()
    Dim tmp_pic As String
    Dim i As Integer
    Dim objPic As Object
    
    On Error Resume Next
    For i = dialogs.Count To 1 Step -1
        tmp_pic = dialogs.Item(i)
        Set objPic = System.findObject(tmp_pic)
        If Not (objPic Is Nothing) Then
            If Application.ActiveDocument.Page.SelectedShapes.Count = 0 Then
                objPic.Parent.Active = True
            End If
            Exit Sub
        End If
    Next i
End Sub

Function TagDefined(aTag As String)
    Dim tag As Object
    
    Set tag = Nothing
    
    On Error Resume Next
    Set tag = System.findObject(aTag)
    On Error GoTo 0

    TagDefined = Not (tag Is Nothing)
End Function

'在采用标签组设计的对话框中的单启单停操作
Sub OperateDev2(devno As String, Operate As String)
    Dim hintMsg As String
    Dim OperateTag As String, ResetTag As String
    
    
    If Operate = "停车" Then
        OperateTag = "fix32." + SCADA_NAME + "." + DTTAG_PREFIX + devno + ".f_cv"
        ResetTag = "fix32." + SCADA_NAME + "." + DQTAG_PREFIX + devno + ".f_cv"
    ElseIf Operate = "启车" Then
        OperateTag = "fix32." + SCADA_NAME + "." + DQTAG_PREFIX + devno + ".f_cv"
        ResetTag = "fix32." + SCADA_NAME + "." + DTTAG_PREFIX + devno + ".f_cv"
    ElseIf Operate = "正转启车" Then
        OperateTag = "fix32." + SCADA_NAME + "." + DQFTAG_PREFIX + devno + ".f_cv"
        ResetTag = "fix32." + SCADA_NAME + "." + DTTAG_PREFIX + devno + ".f_cv"
    ElseIf Operate = "反转启车" Then
        OperateTag = "fix32." + SCADA_NAME + "." + DQRTAG_PREFIX + devno + ".f_cv"
        ResetTag = "fix32." + SCADA_NAME + "." + DTTAG_PREFIX + devno + ".f_cv"
    End If
        opendigitalpoint ResetTag
        opendigitalpoint OperateTag
    hintMsg = "您确定要对设备『" + devno + "』执行【" + Operate + "】操作吗？" + vbCrLf + vbCrLf + vbCrLf + "请核对设备号，务必在清楚现场情况时再执行启停车操作！"
    
    If MsgBox(hintMsg, vbApplicationModal + vbQuestion + vbYesNo, "请您确认！") = vbYes Then
        
        closedigitalpoint OperateTag
        CloseDialogs
    End If
End Sub


'取得当前操作的设备的编号
Private Function GetDevNo()
    GetDevNo = Application.ActiveDocument.Page.SelectedShapes.Item(1).Caption
End Function

'打开使用标签组技术设计的设备控制对话框
Sub DevOpDlg(dlg_name As String, Optional devno As String = "")
    If devno = "" Then
        devno = GetDevNo
    End If

    Dim TagGroupFileName  As String
    
    TagGroupFileName = "dev_" + devno
    
    OpenDialog dlg_name, TagGroupFileName
    
     

End Sub


Function GetDevNoFromTagGruup(pic As Object) As String

    Dim devno As String

    pic.TagGroupSubstitution "@devno@", devno
    

    GetDevNoFromTagGruup = devno
End Function
'切换数字量点
Sub SwitchPoint(pic As Object, tag As String)
    Dim devno As String
    
    devno = GetDevNoFromTagGruup(pic)
    
    tag = Replace(tag, "@devno@", devno)
    
    ToggleDigitalPoint tag
End Sub

Sub CloseAllPics(Optional ExceptMe As Boolean = False)
    Dim i As Integer
    Dim pic As Object
    
    
    For i = Application.Documents.Count To 1 Step -1
        Set pic = Application.Documents.Item(i)
        If pic.Type = "FIX.Picture" Then
            If Not (ExceptMe And (Application.ActiveDocument.filename = pic.filename)) Then
                pic.close
            End If
        End If
        
    Next i
    
End Sub