frmsetbj.frm

Visual Basic串口通信技术与典型实例

VERSION 5.00
Begin VB.Form frmSetbj 
   Caption         =   "报警事件处理"
   ClientHeight    =   4875
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6195
   LinkTopic       =   "Form1"
   ScaleHeight     =   4875
   ScaleWidth      =   6195
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdOut 
      Caption         =   "选出"
      Height          =   375
      Left            =   2640
      TabIndex        =   10
      Top             =   3480
      Width           =   855
   End
   Begin VB.CommandButton cmdIn 
      Caption         =   "选入"
      Height          =   375
      Left            =   2640
      TabIndex        =   9
      Top             =   2760
      Width           =   855
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   4320
      TabIndex        =   8
      Top             =   4320
      Width           =   1095
   End
   Begin VB.ListBox listcj 
      Height          =   645
      Left            =   3840
      TabIndex        =   7
      Top             =   3360
      Width           =   1935
   End
   Begin VB.ListBox listBox1 
      Height          =   645
      Left            =   360
      TabIndex        =   6
      Top             =   3360
      Width           =   1815
   End
   Begin VB.CommandButton cmdLast 
      Caption         =   "上一步"
      Height          =   375
      Left            =   2520
      TabIndex        =   5
      Top             =   4320
      Width           =   1215
   End
   Begin VB.CommandButton cmdEnd 
      Caption         =   "完成"
      Height          =   375
      Left            =   720
      TabIndex        =   4
      Top             =   4320
      Width           =   1215
   End
   Begin VB.ListBox listbf 
      Height          =   1035
      Left            =   240
      TabIndex        =   1
      Top             =   1080
      Width           =   5775
   End
   Begin VB.Label Label3 
      Caption         =   "处警动作已选中"
      Height          =   375
      Left            =   3960
      TabIndex        =   3
      Top             =   2640
      Width           =   1815
   End
   Begin VB.Label Label2 
      Caption         =   "待选处警动作"
      Height          =   375
      Left            =   360
      TabIndex        =   2
      Top             =   2640
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "布防设置"
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   975
   End
End
Attribute VB_Name = "frmSetbj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private strcj(100) As String   '记录单个布防所对应的多个处警名
Private strDcj() As String     '记录所有布防所对应的多个处警名

Private Sub cmdCancel_Click()
   Unload Me
End Sub

Private Sub cmdEnd_Click()
On Error GoTo x
   
   Me.Hide
   '写入设置
   Dim r As ADODB.Recordset
   Dim str As String
   Set r = New ADODB.Recordset
   str = "select * from bftocj"
   r.Open str, cn, adOpenStatic, adLockOptimistic
   r.MoveFirst
   While Not r.EOF And Not r.BOF
     r.Delete
     r.MoveNext
   Wend
    r.Close
    Set r = New ADODB.Recordset
    r.Open "bftocj", cn, adOpenStatic, adLockOptimistic
   Dim i As Integer
   For i = 0 To listbf.ListCount - 1
     r.AddNew
     r!bfname = listbf.List(i)
     r!cjname = strDcj(i)
     r.Update
     r.MoveNext
   Next i
   r.Close
   mAction = True
   frmbaojing.mnuOperateAct.Checked = mAction
   Exit Sub

x:
   MsgBox ("出现错误")
   
End Sub

Private Sub cmdIn_Click()
   Dim i As Integer
   For i = 0 To listBox1.ListCount - 1
     If listBox1.Selected(i) Then
        Dim j As Integer
       For j = 0 To listcj.ListCount
        If listcj.List(j) = listBox1.List(i) Then GoTo m1
       Next j
       listcj.AddItem listBox1.List(i)
     End If
m1:
   Next i
   strDcj(itemBfClk) = ""
  For i = 0 To listcj.ListCount - 1
   strDcj(itemBfClk) = strDcj(itemBfClk) & listcj.List(i) & "@"
  Next i
End Sub

Private Sub cmdOut_Click()
 Dim i As Integer
  For i = listcj.ListCount - 1 To 0 Step -1
   If listcj.Selected(i) Then
      listcj.RemoveItem i
   End If
 Next i
 strDcj(itemBfClk) = ""
  For i = 0 To listcj.ListCount - 1
   strDcj(itemBfClk) = strDcj(itemBfClk) & listcj.List(i) & "@"
  Next i
End Sub

Private Sub cmdLast_Click()
    Me.Hide
    frmSetcj.Show vbModal
End Sub

Private Sub Form_Load()
   Call Init
End Sub
Private Sub initStr()
  Dim i As Integer
  For i = 0 To 99
    strcj(i) = ""
  Next i
End Sub

Private Sub Form_Resize()
  Me.Height = frmSetcj.Height
  Me.Width = frmSetcj.Width
  Me.Left = frmSetcj.Left
  Me.Top = frmSetcj.Top
End Sub
Private Sub Init()
  '显示和提取数据
  Call Getdb
  '在bfset和cjset中显示初值
   listbf.Selected(0) = True
   listBox1.Selected(0) = True
End Sub
'显示数据
Private Sub Getdb()
  Dim rs As ADODB.Recordset
  Set rs = New ADODB.Recordset
  Dim str As String
  '显示布防名称
  str = "select bfname from bufangset;"
  rs.Open str, cn, adOpenStatic, adLockOptimistic
  rs.MoveFirst
   While Not rs.EOF
     listbf.AddItem rs!bfname
     rs.MoveNext
    Wend
  rs.Close
  
 Set rs = New ADODB.Recordset
  '显示处警名称
  str = "select cjname from chujingset;"
  rs.Open str, cn, adOpenStatic, adLockOptimistic
  rs.MoveFirst
  While Not rs.EOF
     listBox1.AddItem rs!cjname
     rs.MoveNext
  Wend
   rs.Close
   
  '提取数据
  ReDim strDcj(listbf.ListCount + 1)
  
   Dim x As Integer
' For x = 0 To listbf.ListCount - 1
  ' Set rs = New ADODB.Recordset
  'str = "select cjname from bftocj where bfname='" & listbf.List(x) & "';"
   ' rs.Open str, cn, adOpenStatic, adLockOptimistic
   'If rs.RecordCount = 0 Then GoTo s
   'strDcj(x) = rs!cjname
's:
  '  rs.Close
 'Next x
End Sub
'cjname分析
Private Function analystRs(s As String) As Integer
   Dim i As Integer
   Dim count As Integer '纪录获取的字符串个数
   count = 0
   For i = 1 To Len(s)
      If Mid(s, i, 1) = "@" Then
                count = count + 1
      Else
                strcj(count) = strcj(count) & Mid(s, i, 1)
      End If
   Next i
   analystRs = count
End Function

Private Sub listbf_Click()
   Dim x As Integer
   x = showcj(itemBfClk)
End Sub
'查询bfset中哪项被选中
Private Function itemBfClk() As Integer
   Dim i As Integer
   For i = 0 To listbf.ListCount - 1
     If listbf.Selected(i) Then
           itemBfClk = i
           Exit Function
     End If
   Next i
   itemBfClk = -1
End Function
'显示布防所对应的cj
Private Function showcj(index As Integer) As Integer
  If index = -1 Then Exit Function
   '显示布防所对应的处警动作（可能有多个）
'   Dim rs As ADODB.Recordset
'   Dim str As String
'   Set rs = New ADODB.Recordset
'   str = "select cjname from bftocj where bfname ='" & Trim(listbf.List(index)) & "';"
'   rs.Open str, cn, adOpenStatic, adLockOptimistic
   Call initStr
   Dim i As Integer
   i = analystRs(strDcj(itemBfClk))
   listcj.Clear
   Dim n As Integer
   For n = 0 To i
     Dim m As Integer
    For m = 0 To listBox1.ListCount - 1
      If strcj(n) = listBox1.List(m) Then
         listcj.AddItem strcj(n)
      End If
    Next m
   Next n
'   rs.Close
  showcj = i
End Function
Private Sub listBox1_DblClick()
  Call cmdIn_Click
End Sub

Private Sub listcj_DblClick()
  Call cmdOut_Click
End Sub