?? 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 + -