frmevents.frm

用vb实现在线考试系统

        WriteEvents App.Path + "\报警日志.txt", Format(Now, "yyyy年mm月dd日 hh:mm:ss") & "$0$0$0$0$0$手动解除报警"
    ElseIf iType = 2 Then
        WriteEvents App.Path + "\报警日志.txt", Format(Now, "yyyy年mm月dd日 hh:mm:ss") & "$0$0$0$0$0$自动解除报警"
    End If
    
    bBaojingHandle = True

    outflag(1) = 0
        
    dat = 0
    For i = 14 To 0 Step -1
    dat = dat * 2 + outflag(i)
    Next i
    If outflag(15) = 1 Then
          dat = dat - 32768
    End If
    Pci16pr1.DataOut (dat)
    
    For i = 1 To lstEvents.ListItems.Count
        i1 = lstEvents.ListItems(i).SubItems(1) '服务器号
        i2 = lstEvents.ListItems(i).SubItems(2) '报警器编号
        i3 = lstEvents.ListItems(i).SubItems(3) '防区编号
        i4 = lstEvents.ListItems(i).SubItems(5) '通道号
        
        iLostStatus(i1, i4) = 0
        iChannelStatus(i1, i4) = 0             '还原状态
        iBaojingStatus(i1, i2, i3) = 0
    Next i
End Sub
Private Sub cmdOK_Click()
    
    BaojingHandle (1)
    Unload Me
End Sub

Private Sub cmdSearch_Click()
    ReadEvents App.Path + "\报警日志.txt", txtEventDate
End Sub



Private Sub Form_Load()
    
    Timer2.Enabled = True
    
    freshServerMap
    ReadEvents App.Path + "\报警日志.txt", Now
    
    For i = 0 To 16
        imgServer(i).MousePointer = 2
    Next i
    
    imgTance(0).Visible = False
    
    iTimer3Count = 0
    
    bBaojingHandle = True
    
    imgServer(0).Visible = False
    imgServer1(0).Visible = False
    imgTance(0).Visible = False
    
'---------------------报警卡的初始化--------------------------------------------------------
'    Pci16pr1.Init (0)
    For i = 0 To 15
        outflag(i) = 0
    Next i
    
'-------------------------------------------------------------------------------------------
    '测试
'    ShowMap 2
'    iBaojingStatus(1, 1, 3) = 1
End Sub

Public Sub WriteEvents(ByVal strFilename As String, ByVal strEventValue As String)
    Open strFilename For Append As #1 '追加记录
    Print #1, strEventValue
    Close #1
End Sub
Public Sub ReadEvents(ByVal strFilename As String, ByVal strEventDate As String)
On Error Resume Next

    Timer2.Enabled = True
    
    Dim iFile As Integer
    Dim strInput As String
    Dim strArray() As String
    Dim strEvent As String
    
    If lstEvents.ListItems.Count > 0 Then
        lstEvents.ListItems.Clear
    End If
    
    iFile = FreeFile
    Open strFilename For Input As #iFile
    Do While Not EOF(1)
        Line Input #iFile, strEvent
        strArray = Split(strEvent, "$")
        
        If Format(strArray(0), "yyyy-mm-dd") = Format(strEventDate, "yyyy-mm-dd") Then
            'Dim itemx As ListItem
            Set itemx = lstEvents.ListItems.Add(, , strArray(0)) '时间
            itemx.SubItems(1) = strArray(1) '服务器号
            itemx.SubItems(2) = strArray(2) '报警器编号
            itemx.SubItems(3) = strArray(3) '防区编号
            itemx.SubItems(4) = strArray(4) '是否报警联动
            itemx.SubItems(5) = strArray(5) '通道号
            itemx.SubItems(6) = strArray(6) '报警事件
            
'            i1 = strArray(1)
'            i2 = strArray(2)
'            i3 = strArray(3)
'            i4 = strArray(5)
'
'            iChannelStatus(i1, i4) = 1      '通道状态
'            iBaojingStatus(i1, i2, i3) = 1  '报警器状态
            
            iTanceNum = ReadInt("总量", "探测器总数")
            For i = 1 To iTanceNum
                Dim strTag As String
                strTag = strArray(2) & "$" & strArray(3)
                If InStr(imgTance(i).Tag, strTag) Then
                    imgTance(i).Picture = LoadPicture(App.Path + "\res\Aqua03.jpg")
                End If
            Next i
            
            
        End If
    Loop
    
    Close #iFile
End Sub

Public Sub ShowMap(ByVal iServer As Integer, ByVal iMap As Integer)
On Error Resume Next

    Dim strbgFilename As String
    Dim i As Integer
    Dim iTanceNum As Integer
    Dim itemx As ListItem
    Dim iX As Integer
    Dim iY As Integer
    Dim k As Integer
    
    iServerNo = iServer
    
    SpecifyIni App.Path + "\map\Map" & iServer & ".ini"
         
    strbgFilename = ReadString("背景图列表", "pic" & iMap, 100)
    imgMap.Picture = LoadPicture(App.Path + "\map\" & strbgFilename)

    '根据地图配置文件设置摄像机的地图位置
    For i = 0 To 15
        strSection(i) = "第" & i & "通道"
        imgChannel(i).ToolTipText = "第" & i + 1 & "通道摄像机"
        strKey = "X" & iMap
        iLeft = ReadInt(strSection(i), strKey)
        strKey = "Y" & iMap
        iTop = ReadInt(strSection(i), strKey)
        k = ReadInt(strSection(i), "所在地图")
        
        Debug.Print "imap:" & iMap & ",k:" & k
        
        If (iTop > 0 Or iLeft > 0) And k = iMap Then
            Debug.Print "show"
            imgChannel(i).Visible = True
            imgChannel(i).Move iLeft, iTop
        Else
            imgChannel(i).Visible = False
        End If
               
        imgServer1(i).Visible = False
    Next i
    
    imgServer1(16).Visible = False
    imgTance(0).Visible = False
    
    iTanceNum = ReadInt("总量", "探测器总数")
'    If iTanceNum = 0 Then
        For i = 0 To imgTance.Count - 1
            imgTance(i).Visible = False
        Next i
'    End If
    
    For i = 1 To iTanceNum
        iX = ReadInt("探测器" & i, "X" & iMap)
        iY = ReadInt("探测器" & i, "Y" & iMap)
        k = ReadInt("探测器" & i, "所在地图")
        
        imgTance(i).Tag = ReadInt("探测器" & i, "报警器编号") & "$" & ReadInt("探测器" & i, "防区编号")
        imgTance(i).ToolTipText = i & ".报警器编号:" & ReadInt("探测器" & i, "报警器编号") & "-防区编号:" & ReadInt("探测器" & i, "防区编号") & "-" & ReadString("探测器" & i, "说明", 100)
            
        If (iX <> 0 Or iY <> 0) And k = iMap Then
            imgTance(i).Visible = True
            imgTance(i).top = iY
            imgTance(i).left = iX
        Else
            imgTance(i).Visible = False
        End If
    Next i
End Sub

Public Sub ChannelWaring(ByVal iChannel As Integer)
    '报警导致图标变换
    imgChannel(iChannel).Picture = LoadPicture(App.Path + "\res\waring.ico")
End Sub


Private Sub Form_Unload(Cancel As Integer)
    cmdHandle_Click
End Sub



Private Sub imgServer_Click(Index As Integer)
    ShowMap Index, 1
End Sub




Private Sub Timer1_Timer()
    ReadEvents App.Path + "\报警日志.txt", Format(Now, "mm-dd")
End Sub

''
' 图标刷新
' 对于多服务器报警如何处理地图的显示????

Private Sub Timer2_Timer()
On Error Resume Next

    '测试
'    iChannelStatus(2, 4) = 1
'    iChannelStatus(2, 7) = 1
    
    Dim i As Integer
    Dim iBaojingID As Integer
    Dim k As Integer
    
    
    
    For i = 1 To lstEvents.ListItems.Count
        i1 = lstEvents.ListItems(i).SubItems(1) '服务器号
        i2 = lstEvents.ListItems(i).SubItems(2) '报警器号
        i3 = lstEvents.ListItems(i).SubItems(3) '防区编号
        i4 = CInt(lstEvents.ListItems(i).SubItems(5))  '通道号
        
        SpecifyIni App.Path + "\map\Map" & i1 & ".ini"
        
        If iChannelStatus(i1, i4) = 1 Or iLostStatus(i1, i4) = 1 Then
            
            k = ReadInt("第" & i4 - 1 & "通道", "所在地图")
            
            ShowMap i1, k
            
            gDelay 2000
            
'            imgChannel(i4 - 1).Picture = LoadPicture(App.Path + "\res\waring.ICO")
'            imgServer(i1).Picture = LoadPicture(App.Path + "\res\server.ICO")
'            gDelay 50
'            imgChannel(i4 - 1).Picture = LoadPicture(App.Path + "\res\camera.jpg")
'            imgServer(i1).Picture = LoadPicture(App.Path + "\res\warning.ICO")
        End If
        
        Dim strTag As String
        Dim iTanceNum As Integer
        
        '测试
        'iBaojingStatus(i1, i2, i3) = 1
        
        strTag = i2 & "$" & i3
        iTanceNum = ReadInt("总量", "探测器总数")
        For j = 1 To iTanceNum
            'Debug.Print imgTance(j).Tag
'            imgTance(j).Visible = True
            If InStr(imgTance(j).Tag, strTag) Then
                'Debug.Print "Stauts" & iBaojingStatus(i1, i2, i3)
                If iBaojingStatus(i1, i2, i3) = 1 Then
                    k = ReadInt("探测器" & j, "所在地图")
                    Debug.Print "imgTance:" & j
                    ShowMap i1, k
                    
                    gDelay 2000
                    
'                    imgTance(j).Picture = LoadPicture(App.Path + "\res\warning.ICO")
'                    imgServer(i1).Picture = LoadPicture(App.Path + "\res\server.ICO")
'                    gDelay 50
'                    imgTance(j).Picture = LoadPicture(App.Path + "\res\Aqua03.jpg")
'                    imgServer(i1).Picture = LoadPicture(App.Path + "\res\warning.ICO")
                End If
            End If
        Next j
    Next i
    
End Sub

Private Sub freshServerMap()
 On Error Resume Next
 
    Dim iX As Integer
    Dim iY As Integer
    
    ServerName(1) = "服务器00"
    ServerName(2) = "服务器01"
    ServerName(3) = "服务器02"
    ServerName(4) = "服务器03"
    ServerName(5) = "服务器04"
    ServerName(6) = "服务器05"
    ServerName(7) = "服务器06"
    ServerName(8) = "服务器07"
    ServerName(9) = "服务器08"
    ServerName(10) = "服务器09"
    ServerName(11) = "服务器10"
    ServerName(12) = "服务器11"
    ServerName(13) = "服务器12"
    ServerName(14) = "服务器13"
    ServerName(15) = "服务器14"
    ServerName(16) = "服务器15"
        
    SpecifyIni App.Path + "\map\Map0.ini"
    
'    strbgFilename = ReadString("总图设置", "pic1", 100)
    imgServerMap.Picture = LoadPicture(App.Path + "\map\Server0.bmp")
    
    For i = 1 To 16
        iX = ReadInt(ServerName(i), "X1")
        iY = ReadInt(ServerName(i), "Y1")
        If iX > 0 Or iY > 0 Then
            imgServer(i).Move iX / 3.38, iY / 3.38
            imgServer(i).ToolTipText = "第" & i & "服务器"
            imgServer(i).Visible = True
        Else
            imgServer(i).Visible = False
        End If
    Next i
    
End Sub

Public Sub StartBaojing()

    outflag(1) = 1

    dat = 0
    For i = 14 To 0 Step -1
    dat = dat * 2 + outflag(i)
    Next i
    If outflag(15) = 1 Then
          dat = dat - 32768
    End If
    Pci16pr1.DataOut (dat)
    
    bBaojingHandle = False
    Timer3.Enabled = True
End Sub

'自动解除报警
Private Sub Timer3_Timer()
    iTimer3Count = iTimer3Count + 1
    
    If iTimer3Count = 2 Then
        Timer3.Enabled = False
        BaojingHandle (2)
        
    End If
End Sub

Private Sub Timer4_Timer()
On Error Resume Next
    
    Dim i As Integer
    Dim iBaojingID As Integer
    Dim k As Integer
    
    For i = 1 To lstEvents.ListItems.Count
        i1 = lstEvents.ListItems(i).SubItems(1) '服务器号
        i2 = lstEvents.ListItems(i).SubItems(2) '报警器号
        i3 = lstEvents.ListItems(i).SubItems(3) '防区编号
        i4 = CInt(lstEvents.ListItems(i).SubItems(5))  '通道号
        
        SpecifyIni App.Path + "\map\Map" & i1 & ".ini"
        
        If iChannelStatus(i1, i4) = 1 Or iLostStatus(i1, i4) = 1 Then
            imgChannel(i4 - 1).Picture = LoadPicture(App.Path + "\res\waring.ICO")
            imgServer(i1).Picture = LoadPicture(App.Path + "\res\server.ICO")
            gDelay 50
            imgChannel(i4 - 1).Picture = LoadPicture(App.Path + "\res\camera.jpg")
            imgServer(i1).Picture = LoadPicture(App.Path + "\res\warning.ICO")
        End If
        
        Dim strTag As String
        Dim iTanceNum As Integer
        
        '测试
'        iBaojingStatus(i1, i2, i3) = 1
        
        strTag = i2 & "$" & i3
        iTanceNum = ReadInt("总量", "探测器总数")
        For j = 1 To iTanceNum
            If InStr(imgTance(j).Tag, strTag) Then
                If iBaojingStatus(i1, i2, i3) = 1 Then
                   
                    imgTance(j).Picture = LoadPicture(App.Path + "\res\warning.ICO")
                    imgServer(i1).Picture = LoadPicture(App.Path + "\res\server.ICO")
                    gDelay 50
                    imgTance(j).Picture = LoadPicture(App.Path + "\res\Aqua03.jpg")
                    imgServer(i1).Picture = LoadPicture(App.Path + "\res\warning.ICO")
                End If
            End If
        Next j
    Next i
End Sub