📄 frmsetpara3.frm
字号:
VERSION 5.00
Begin VB.Form frmSetpara3
Caption = "参数设置 3：报警事件的处理动作"
ClientHeight = 6705
ClientLeft = 4230
ClientTop = 2475
ClientWidth = 6765
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6705
ScaleWidth = 6765
Begin VB.CommandButton cmdOut
Caption = "选出"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5040
TabIndex = 8
ToolTipText = "单击可选出"
Top = 2760
Width = 615
End
Begin VB.CommandButton cmdIn
Caption = "选入"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3720
TabIndex = 7
ToolTipText = "单击可选入"
Top = 2760
Width = 615
End
Begin VB.CommandButton cmdEnd
Caption = "完成"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5160
TabIndex = 6
Top = 6120
Width = 1335
End
Begin VB.CommandButton cmdCancel
Caption = "取消"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 5
Top = 6120
Width = 1335
End
Begin VB.CommandButton cmdPrev
Caption = "上一步"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2700
TabIndex = 4
Top = 6120
Width = 1335
End
Begin VB.ListBox lstDcj
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2220
Left = 3240
MultiSelect = 2 'Extended
TabIndex = 3
Top = 360
Width = 3255
End
Begin VB.ListBox lstCj
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1500
Left = 3240
MultiSelect = 2 'Extended
TabIndex = 2
Top = 3780
Width = 3255
End
Begin VB.ListBox lstBf
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4920
Left = 240
TabIndex = 0
Top = 360
Width = 2775
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "已选中处警动作："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 3240
TabIndex = 10
Top = 120
Width = 1440
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "待选处警动作："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 3240
TabIndex = 9
Top = 3480
Width = 1260
End
Begin VB.Line Line2
BorderColor = &H80000005&
BorderWidth = 2
X1 = 240
X2 = 6480
Y1 = 6000
Y2 = 6000
End
Begin VB.Line Line1
X1 = 240
X2 = 6480
Y1 = 5970
Y2 = 5970
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "布防设置："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 240
TabIndex = 1
Top = 120
Width = 900
End
End
Attribute VB_Name = "frmSetpara3"
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 lstBf.ListCount - 1
r.AddNew
r!bfname = lstBf.List(i)
r!cjname = strDcj(i)
r.Update
r.MoveNext
Next i
r.Close
mAction = True
frmMain.mnuOperateAct.Checked = mAction
Exit Sub
x:
MsgBox ("出现错误")
End Sub
Private Sub cmdIn_Click()
Dim i As Integer
For i = 0 To lstCj.ListCount - 1
If lstCj.Selected(i) Then
Dim j As Integer
For j = 0 To lstDcj.ListCount
If lstDcj.List(j) = lstCj.List(i) Then GoTo m1
Next j
lstDcj.AddItem lstCj.List(i)
End If
m1:
Next i
strDcj(itemBfClk) = ""
For i = 0 To lstDcj.ListCount - 1
strDcj(itemBfClk) = strDcj(itemBfClk) & lstDcj.List(i) & "@"
Next i
End Sub
Private Sub cmdOut_Click()
Dim i As Integer
For i = lstDcj.ListCount - 1 To 0 Step -1
If lstDcj.Selected(i) Then
lstDcj.RemoveItem i
End If
Next i
strDcj(itemBfClk) = ""
For i = 0 To lstDcj.ListCount - 1
strDcj(itemBfClk) = strDcj(itemBfClk) & lstDcj.List(i) & "@"
Next i
End Sub
Private Sub cmdPrev_Click()
Me.Hide
frmSetpara2.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 = frmSetpara2.Height
Me.Width = frmSetpara2.Width
Me.Left = frmSetpara2.Left
Me.Top = frmSetpara2.Top
End Sub
Private Sub Init()
'显示和提取数据
Call Getdb
'在bfset和cjset中显示初值
lstBf.Selected(0) = True
lstCj.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
lstBf.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
lstCj.AddItem rs!cjname
rs.MoveNext
Wend
rs.Close
'提取数据
ReDim strDcj(lstBf.ListCount + 1)
Dim x As Integer
For x = 0 To lstBf.ListCount - 1
Set rs = New ADODB.Recordset
str = "select cjname from bftocj where bfname='" & lstBf.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 lstBf_Click()
Dim x As Integer
x = showcj(itemBfClk)
End Sub
'查询bfset中哪项被选中
Private Function itemBfClk() As Integer
Dim i As Integer
For i = 0 To lstBf.ListCount - 1
If lstBf.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(lstBf.List(index)) & "';"
' rs.Open str, cn, adOpenStatic, adLockOptimistic
Call initStr
Dim i As Integer
i = analystRs(strDcj(itemBfClk))
lstDcj.Clear
Dim n As Integer
For n = 0 To i
Dim m As Integer
For m = 0 To lstCj.ListCount - 1
If strcj(n) = lstCj.List(m) Then
lstDcj.AddItem strcj(n)
End If
Next m
Next n
' rs.Close
showcj = i
End Function
Private Sub lstCj_DblClick()
Call cmdIn_Click
End Sub
Private Sub lstDcj_DblClick()
Call cmdOut_Click
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -