hfdb.frm

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

         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   1800
      TabIndex        =   18
      Top             =   1200
      Width           =   1215
   End
   Begin VB.Label Label3 
      Caption         =   "1--16"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   960
      TabIndex        =   17
      Top             =   1200
      Width           =   495
   End
   Begin VB.Label Label2 
      Caption         =   "有(1)无(0) 云台控制器"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4200
      TabIndex        =   16
      Top             =   2685
      Width           =   975
   End
   Begin VB.Label Label6 
      Caption         =   " MCU号 端局号 VS号 摄象机号  视频采集点名称   "
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   14
      Top             =   2700
      Width           =   3975
   End
   Begin VB.Label Label5 
      Caption         =   " MCU号   端局号      端局名称       视频矩阵(VS)数"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   13
      Top             =   1005
      Width           =   4815
   End
   Begin VB.Label Label4 
      Caption         =   "请输入端局(编码器)二级地址及名称:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   240
      Width           =   3255
   End
   Begin VB.Label Label1 
      Caption         =   "请输入视频采集点(摄象机)四级地址及名称:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   1920
      Width           =   3615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db1 As Database
Dim db1rs1 As Recordset
Dim db1rs2 As Recordset
Dim db1rs3 As Recordset
Dim db1rs4 As Recordset
Dim db1rs8 As Recordset
Dim f(1 To 16) As Byte      'change to two dimension
Dim yuntai(1 To 16, 4, 1 To 16) As Byte
Dim cmrname(1 To 16, 4, 1 To 16) As String
Dim stationname(5, 15) As String
Dim servernam As String
Dim i As Integer
Dim aa1 As Integer
Dim aa2 As Integer
Dim a1 As Integer
Dim a2 As Integer
Dim a3 As Integer
Dim mmm As Integer
Dim nnn As Integer


Private Sub Form_Load()
    Set db1 = OpenDatabase(App.Path + "\rtc.mdb")
    If Err Then MsgBox "  数据库不存在 !   "
    Set db1rs1 = db1.OpenRecordset("cmrname")
    Set db1rs2 = db1.OpenRecordset("stationname")
    Set db1rs3 = db1.OpenRecordset("yuntai")
    Set db1rs4 = db1.OpenRecordset("cmrsta")
    Set db1rs8 = db1.OpenRecordset("servername")
    
    With db1rs4
      .MoveFirst
      For i = 0 To 15
      f(i + 1) = .Fields(i)
      Next i
    End With
    
    With db1rs2
      .MoveFirst
      For i = 0 To 5
      For j = 0 To 15
            stationname(i, j) = .Fields(j)
      Next j
      .MoveNext
      Next i
    End With
    
    With db1rs1
      .MoveFirst
      For i = 0 To 15
      For j = 0 To 4
      For k = 0 To 15
      cmrname(i + 1, j, k + 1) = .Fields(k)
      Next k
      .MoveNext
      Next j
      Next i
    End With
    
    With db1rs3
      .MoveFirst
      For i = 0 To 15
      For j = 0 To 4
      For k = 0 To 15
      yuntai(i + 1, j, k + 1) = .Fields(k)
      Next k
      .MoveNext
      Next j
      Next i
    End With

    With db1rs8
    .MoveFirst
    Tservername.Text = .Fields(0)
    End With

'    Tmcuaddr.Text = 1
    Tenaddr.Text = 1
'    Taddr1.Text = 1
'    Taddr2.Text = 1
    Taddr3.Text = 1
End Sub

Private Sub cok1_Click()
    
    With db1rs4
      .MoveFirst
      .Edit
      For i = 0 To 15
      .Fields(i) = f(i + 1)
      Next i
      .Update
    End With
    
    With db1rs2
      .MoveFirst
      For i = 0 To 5
      .Edit
      For j = 0 To 15
             .Fields(j) = stationname(i, j)
      Next j
      .Update
      .MoveNext
      Next i
    End With
    
    With db1rs1
      .MoveFirst
      For i = 0 To 15
      For j = 0 To 4
      .Edit
          For k = 0 To 15
              .Fields(k) = cmrname(i + 1, j, k + 1)
          Next k
      .Update
      .MoveNext
      Next j
      Next i
    End With
    
    With db1rs3
      .MoveFirst
      For i = 0 To 15
      For j = 0 To 4
      .Edit
          For k = 0 To 15
              .Fields(k) = yuntai(i + 1, j, k + 1)
          Next k
      .Update
      .MoveNext
      Next j
      Next i
    End With
    
    With db1rs8
        .MoveFirst
        .Edit
        .Fields(0) = servernam
        .Update
    End With
End Sub

Private Sub Help_Click()
Screen.MousePointer = 11
FrmHelp.Show
Screen.MousePointer = 0
End Sub

Private Sub Tmcuaddr_Change()
     aa1 = Val(Tmcuaddr.Text)
     aa2 = Val(Tenaddr.Text)
     If aa1 < 1 Or aa1 > 6 Then
            If MsgBox(" 请输入数字(1--6)", vbExclamation) = vbOK Then
            Else
            End If
            Exit Sub
     End If
     Tstationname.Text = stationname(aa1 - 1, aa2 - 1)
     cnumber.Text = f(aa2)
End Sub

Private Sub Tenaddr_Change()
     aa1 = Val(Tmcuaddr.Text)
     aa2 = Val(Tenaddr.Text)
     If aa2 < 1 Or aa2 > 16 Then
            If MsgBox("请输入数字(1--16)", vbExclamation) = vbOK Then
            Else
            End If
            Exit Sub
     End If
     Tstationname.Text = stationname(aa1 - 1, aa2 - 1)
     cnumber.Text = f(aa2)
End Sub

Private Sub cnumber_Change()
        ccc = cnumber.Text
        If ccc = "0" Or ccc = "1" Or ccc = "2" Or ccc = "3" Or ccc = "4" Then
        Else
            If MsgBox("请输入数字(0--4)", vbExclamation) = vbOK Then
            Else
            End If
            Exit Sub
        End If
        f(aa2) = Val(ccc)
End Sub

Private Sub Taddr1_Change()
     a1 = Val(Taddr1.Text)
     If a1 < 1 Or a1 > 16 Then
            If MsgBox(" 请输入数字(1--16)", vbExclamation) = vbOK Then
            Else
            End If
            Exit Sub
     End If
     a2 = Val(Taddr2.Text)
     a3 = Val(Taddr3.Text)
'     nnn = (a1 - 1) * 5 + a2
'     mmm = a3 - 1
     Tname.Text = cmrname(a1, a2, a3)
     Tyuntai.Text = yuntai(a1, a2, a3)
End Sub

Private Sub Taddr2_Change()
     ccc = Taddr2.Text
     If ccc = "0" Or ccc = "1" Or ccc = "2" Or ccc = "3" Or ccc = "4" Then
         a2 = Val(Taddr2.Text)
     Else
            If MsgBox(" 请输入数字(0--4)", vbExclamation) = vbOK Then
            Else
            End If
         Exit Sub
     End If
     a1 = Val(Taddr1.Text)
     a3 = Val(Taddr3.Text)
'     nnn = (a1 - 1) * 5 + a2
'     mmm = a3 - 1
     Tname.Text = cmrname(a1, a2, a3)
     Tyuntai.Text = yuntai(a1, a2, a3)

End Sub

Private Sub Taddr3_Change()
     a3 = Val(Taddr3.Text)
     If a3 < 1 Or a3 > 16 Then
            If MsgBox("请输入数字(1--16)", vbExclamation) = vbOK Then
            Else
            End If
            Exit Sub
     End If
     a1 = Val(Taddr1.Text)
     a2 = Val(Taddr2.Text)
 '    nnn = (a1 - 1) * 5 + a2
 '    mmm = a3 - 1
      Tname.Text = cmrname(a1, a2, a3)
     Tyuntai.Text = yuntai(a1, a2, a3)

End Sub

Private Sub Tname_Change()
    cmrname(a1, a2, a3) = Tname.Text
End Sub

Private Sub Tservername_Change()
    servernam = Tservername.Text
End Sub

Private Sub Tstationname_Change()
    stationname(aa1 - 1, aa2 - 1) = Tstationname.Text
End Sub

Private Sub Tyuntai_Change()
     If Tyuntai.Text = "0" Or Tyuntai.Text = "1" Then
     Else
            If MsgBox("请输入数字(0或1)", vbExclamation) = vbOK Then
            Else
            End If
         Exit Sub
     End If
     yuntai(a1, a2, a3) = Val(Tyuntai.Text)
End Sub