rt3.frm

实现图像控制,云台解码器控制,站点选择(配有Access数据库).

        cmdRight.Enabled = False  '
    Else
        auto.Picture = lr.Picture
        rotate = False
        a(5) = &H1
        Sendcommand4
        Sendcommand4 'lgh 990607
        Sendcommand4 'lgh 990607
        cmdLeft.Enabled = True '***lgh 99.01.28
        cmdRight.Enabled = True  '
    End If

End Sub
Private Sub CCDPowerOff_Click()
    a(5) = &H16
    Sendcommand4
    Sendcommand4 'lgh990427
    Sendcommand4 'lgh990427

End Sub
Private Sub CCDPowerOn_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    a(5) = &H15
    Sendcommand4
    Sendcommand4 'lgh990427
    Sendcommand4 'lgh990427

End Sub

Private Sub cmdF2Off_Click()
    a(5) = &H1A
    Sendcommand4
    Sendcommand4 'lgh990427
    Sendcommand4 'lgh990427

End Sub

Private Sub cmdF2On_Click()
    a(5) = &H19
    Sendcommand4
    Sendcommand4 'lgh990427
    Sendcommand4 'lgh990427

End Sub

Private Sub Combo1_Click()
 Select Case Val(Combo1.Text)
    Case 1200
        Comm1.Settings = "1200,N,8,1"
    Case 9600
        Comm1.Settings = "9600,N,8,1"
    Case Else
        Comm1.Settings = Combo1.Text & ",N,8,1"
    End Select


End Sub

Private Sub Comm1_OnComm()
    Dim ERMsg$
    On Error Resume Next
    
    Select Case Comm1.CommEvent
    
        Case comEvReceive
            rb() = Comm1.Input
            For tt = 1 To IntMax
                If ConnectedIndex(tt) <> 0 Then
                     If PSMSConnectedIndex(tt) = 0 Then 'lgh,990119
                         If tcpServer(tt).State = 7 Then tcpServer(tt).SendData (rb)
                    End If
                End If
            Next tt
            If rb(0) <> &HEF Then
               Comm1.PortOpen = False
               Comm1.PortOpen = True
               Exit Sub
            End If
            total = 0
            For i = 0 To 43
                total = total + rb(i)
            Next i
            ckr = 256 - (total Mod 256)
            If ckr <> rb(44) Then
               Comm1.PortOpen = False
               Comm1.PortOpen = True
               Exit Sub
            End If
            
           If flaghuifu = True Then GoTo eee
           If flagkey01(inrt) = True Then GoTo eee
           If station = rb(36 + inrt) Then GoTo eee
           station = rb(36 + inrt)
           For i = 1 To 16
               If mcu(inrt, i) = 2 Then
                  mcu(inrt, i) = 1
                  key01(i).Picture = bmp1.Picture
               End If
           Next i
           mcu(inrt, station) = 2
           key01(station).Picture = bmp2.Picture
       '    If mcu(inrt, 0) = 1 Then
       '       mcu(inrt, 0) = 0
       '       onoffs.Picture = bmp0.Picture
       '    End If
           splay (station)
           
eee:           If flagm = 0 Then Exit Sub
           For i = 0 To 7
           For j = 0 To 3
           n = i * 4 + 4 + j
           For k = 3 To 0 Step -1
           M = j * 4 + k + 1
           If rb(n) >= 2 ^ k Then
              mcur(i, M) = 1
              rb(n) = rb(n) - 2 ^ k
           Else
              mcur(i, M) = 0
           End If
           Next k
           Next j
           If 0 < rb(36 + i) And rb(36 + i) < 17 Then mcur(i, rb(36 + i)) = 2
           Next i
           Frmmcuret.play
''        Comm1.InBufferCount = 0
''        Case comEvSend


        ' Error messages.
'        Case comBreak
'            ERMsg$ = "接收中断! "
'        Case comOverrun
'            ERMsg$ = "数据丢失!"
'        Case comRxOver
'            ERMsg$ = "接收缓冲区溢出!"
'        Case comTxFull
'            ERMsg$ = "传输缓冲区已满!"
'        Case Else
'            ERMsg$ = "未知错误或事件!"
    End Select
    
    If Len(ERMsg$) Then
       If MsgBox(ERMsg$, vbOKCancel + vbExclamation) = vbOK Then
               Comm1.PortOpen = False
               Comm1.PortOpen = True
               Exit Sub
       Else
               Comm1.PortOpen = False
               Comm1.PortOpen = True
               Exit Sub
       End If
'       Exit Sub
    End If

End Sub


Private Sub Command1_Click()
'     Frmalarm.Show
     
        HWStr = "huawei='" & (Text1.Text) & "'"
         With db1rs8
             .FindFirst HWStr
             If .NoMatch Then
                 Text1.Text = "告警地址未知!"
             Else
                 add1 = .Fields(1)
                 add2 = .Fields(2)
                 add3 = .Fields(3)
                 Text1.Text = "告警地址为" & Str(add1) & Str(add2) & Str(add3)
             End If
         End With
End Sub

Private Sub Command2_Click()
Form1.Show

End Sub

Private Sub Command3_Click()
dbt111.Show
End Sub

Private Sub Form_Load()
    '''''''''''''
    'Kill FileCopy name

    If App.PrevInstance Then  '*** lgh,99.1.11
        MsgBox " 图像监控系统 主控台 已经运行！"
        Unload Me
    End If
    On Error Resume Next
    
    strLogFilePath = App.Path & "\MCS.log"    '***lgh 1999.1.27
    Open strLogFilePath For Input As #2
    If Err Then
        Err.Clear
    Else
        Line Input #2, textline
        Line Input #2, textline
        Close #2
        
        Pos = InStr(1, textline, "-")
        strYear = Mid(textline, 1, Pos - 1)
        Pos2 = InStr(Pos + 1, textline, "-")
        strMonth = Mid(textline, Pos + 1, Pos2 - Pos - 1)
        
        strTemp = Date
        Pos = InStr(1, strTemp, "-")
        Pos2 = InStr(Pos + 1, strTemp, "-")
        strMonth2 = Mid(strTemp, Pos + 1, Pos2 - Pos - 1)
        
        If strMonth2 <> strMonth Then
            strTemp = App.Path & "\HF" & strYear & strMonth & ".log"
            Kill strTemp
            Name strLogFilePath As strTemp
        End If
        Err.Clear
    End If
    
    Open strLogFilePath For Append As #2
    If Err Then
        Err.Clear
            Beep
            MsgBox "  不能写入日志设置文件 " & strLogFilePath
    Else
        Print #2, " "
        Print #2, Date & ","; Time & ",MCS(Ver " & App.Major & "." _
            & App.Minor & "." & App.Revision & ") 开始运行。"
    End If

    Dim fLogin As New frmLogin
    regTitle = "HF2000"
    regSection = "DataRecord"
    fLogin.Show vbModal
    If Not fLogin.OK Then
        '登录失败导致退出应用程序
        Close #2
        Open strLogFilePath For Append As #2 'lgh99.01.19
        Print #2, Date & ","; Time & ",MCS(Ver " & App.Major & "." _
                & App.Minor & "." & App.Revision & ") 运行结束。（登陆失败）"
        Close #2 '***lgh,99.1.18
        
        End
    Else
    
    End If
    Close #2
    Unload fLogin
    
    '''''''''''
    LoadInit
    

    For i = 1 To 16
        key01(i).Height = 240
        key01(i).Width = 240
        key01(i).Left = (i - 1) * 360 + 120
        key01(i).Top = 260
        Label1(i - 1).Height = 1080
        Label1(i - 1).Width = 200
        Label1(i - 1).Left = (i - 1) * 360 + 160
        Label1(i - 1).Top = 540
        key03(i).Height = 240
        key03(i).Width = 240
        key03(i).Left = (i - 1) * 360 + 120
        key03(i).Top = 260
        Label3(i - 1).Height = 900
        Label3(i - 1).Width = 200
        Label3(i - 1).Left = (i - 1) * 360 + 160
        Label3(i - 1).Top = 540
    Next i
    For i = 1 To 16
        key01(i).MouseIcon = hand.Picture
        key01(i).MousePointer = 99
        'key03(i).Picture = bmp0.Picture'lgh19990527
        key03(i).MouseIcon = hand.Picture
        key03(i).MousePointer = 99
    Next i
    For i = 1 To 4
        key02(i).Picture = bmp0.Picture
        key02(i).MouseIcon = hand.Picture
        key02(i).MousePointer = 99
    Next i
        
    onoffc.MouseIcon = hand.Picture
    onoffc.MousePointer = 99
    onoffs.MouseIcon = hand.Picture
    onoffs.MousePointer = 99


    'MCUnumber.Text = "1" 'lgh 990427 ' lgh 990527 rem
    
    IntMax = 0
    'tcpServer(0).LocalPort = 1400  ''''''''''''''''''''''''''

        Err.Clear '***lgh990118
    Set recInfo = dbHfdb.OpenRecordset("PSMSinfo") '990527
    tcpServer(0).LocalPort = recInfo.Fields("告警接收端口")
    recInfo.Close '990527

    tcpServer(0).Listen
        delay '***lgh990118
    For i = 0 To 10
        PSMSConnectedIndex(i) = 0
        ConnectedIndex(i) = 0
    Next i
        Open strLogFilePath For Append As #2 'lgh99.01.19
    If Err Then
        Err.Clear
            'Beep
            'MsgBox "  不能侦听网络端口，请检查网络状况！ ", vbExclamation
        Close #2
            
            Print #2, "  不能侦听网络端口，请检查网络状况！"
    Else
        Print #2, Date & ","; Time & ",MCS侦听OK: LocalHostName:" & tcpServer(0).LocalHostName _
            & " ,LocalIP :" & tcpServer(0).LocalIP & ",LocalPort:" & tcpServer(0).LocalPort
    End If
        Close #2 '***lgh,99.1.19
End Sub

Sub LoadInit()
    On Error Resume Next
    Set dbHfdb = OpenDatabase(App.Path & "\hfdb.mdb")
    If Err Then
        MsgBox "  数据库 " & App.Path & "\hfdb.mdb 不存在 !   "
        Exit Sub
    End If
     Set recAddrcorresponding = dbHfdb.OpenRecordset("addrcorresponding", dbOpenSnapshot)
     Set recCamera = dbHfdb.OpenRecordset("camera")
     'Set recInfo = dbHfdb.OpenRecordset("PSMSinfo")
     
     With recCamera
            Do While Not .EOF
                Invert(.Fields("端局编号"), .Fields("VS号"), .Fields("相机号"), 1) = .Fields("左右反向")
                Invert(.Fields("端局编号"), .Fields("VS号"), .Fields("相机号"), 2) = .Fields("上下反向")
                Invert(.Fields("端局编号"), .Fields("VS号"), .Fields("相机号"), 3) = .Fields("远近反向")
                .MoveNext
            Loop
        End With
     recCamera.Close
     station = 1
     controller = 1
     camera = 1
    Set db1 = OpenDatabase(App.Path + "\rtc.mdb")
    If Err Then MsgBox "  数据库不存在 !   "
    Set db1rs1 = db1.OpenRecordset("cmrsta")
    Set db1rs2 = db1.OpenRecordset("stationname")
    Set db1rs3 = db1.OpenRecordset("mcusta")
    Set db1rs4 = db1.OpenRecordset("cmrname")
    Set db1rs5 = db1.OpenRecordset("yuntai")
    Set db1rs6 = db1.OpenRecordset("flagkey01")
    Set db1rs7 = db1.OpenRecordset("tmrs")
    Set db1rs8 = db1.OpenRecordset("addrcorresponding", dbOpenSnapshot)
    Set db1RS9 = db1.OpenRecordset("alarmjilu")
    
    With db1rs1
      .MoveFirst
      For i = 0 To 15
      f(i + 1) = .Fields(i)
      Next i
      .MoveNext
      For i = 0 To 15
      For j = 0 To 4
      For k = 0 To 16
      cmrsta(i + 1, j, k) = .Fields(k)
      Next k
      .MoveNext
      Next j
      Next i
    End With
    
    With db1rs3
     .MoveFirst
     For i = 0 To 7
     For j = 0 To 16
     mcu(i, j) = .Fields(j)
     Next j
     .MoveNext
     Next i
     End With
    
    With db1rs2
      .MoveFirst
      For i = 0 To 15
      Label1(i).Caption = .Fields(i)
            If .Fields(i) <> "" Then  ' added by lgh.
                key01(i + 1).Visible = True '
            Else
                key01(i + 1).Visible = False '
                For iii = 0 To 7 '***lgh 99.01.28 don't loop
                    mcu(iii, i + 1) = 0 '
                Next iii '
            End If
      Next i
    End With
    
    With db1rs4
      .MoveFirst
      For i = 0 To 15
      For j = 0 To 4
      For k = 0 To 15
      kstr123(i + 1, j, k + 1) = .Fields(k)
      Next k
      .MoveNext
      Next j
      Ne