📄 frmuseroperate.frm
字号:
VERSION 5.00
Begin VB.Form frmUserOperate
BorderStyle = 1 'Fixed Single
Caption = "用户设备开关操作"
ClientHeight = 2955
ClientLeft = 45
ClientTop = 330
ClientWidth = 4305
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 2955
ScaleWidth = 4305
Begin VB.CommandButton cmdShut
Caption = "关断"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 324
Left = 1560
TabIndex = 8
Top = 2355
Width = 1140
End
Begin VB.CommandButton cmdOpen
Caption = "打开"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 324
Left = 240
TabIndex = 7
Top = 2355
Width = 1140
End
Begin VB.CommandButton cmdCancel
Caption = "返回"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 324
Left = 2880
TabIndex = 6
Top = 2355
Width = 1140
End
Begin VB.ComboBox cmbDev
Height = 300
Left = 1200
Style = 2 'Dropdown List
TabIndex = 5
Top = 360
Width = 2496
End
Begin VB.TextBox txtUser
Height = 264
Left = 1680
TabIndex = 4
Top = 1680
Width = 1932
End
Begin VB.OptionButton optScope
Caption = "用户号"
Height = 252
Index = 1
Left = 480
TabIndex = 3
Top = 1680
Width = 972
End
Begin VB.TextBox txtCardAddr
Height = 264
Left = 1680
TabIndex = 2
Top = 840
Width = 1932
End
Begin VB.OptionButton optScope
Caption = "卡地址"
Height = 252
Index = 0
Left = 480
TabIndex = 1
Top = 840
Width = 972
End
Begin VB.TextBox txtDevAddr
Height = 264
Left = 1680
TabIndex = 0
Top = 1200
Width = 1932
End
Begin VB.Label lblDev
Caption = "设备："
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 480
TabIndex = 10
Top = 360
Width = 855
End
Begin VB.Label Label1
Caption = "表地址"
Height = 255
Left = 720
TabIndex = 9
Top = 1200
Width = 735
End
End
Attribute VB_Name = "frmUserOperate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/07/09
'描 述：CBB三表户外计量系统 Ver 5.2
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Dim rcGate As Recordset
Dim rcBuild As Recordset
Dim rcUser As Recordset
Dim rcTemUserMap As Recordset
Dim curScope As Integer
Function prepareUser() As Integer
Dim curFrame As Integer
Dim curGate As Integer
Dim curBuild As String
Dim curBuildAddr As Integer
Dim curUserID As Integer
Dim curUserAddr As Integer
Dim i As Integer
Dim temVal As Boolean
'打开网关
If Trim(cmbGate.List(cmbGate.ListIndex)) <> "" And IsNumeric(Trim(cmbGate.List(cmbGate.ListIndex))) Then
curFrame = Format(Trim(cmbGate.List(cmbGate.ListIndex)))
For i = 1 To curFrame
rcGate.FindFirst "FrameID=" + Format(i)
If Not rcGate.NoMatch Then
curGate = rcGate!StartGate
If curGate = 0 Then
GoTo NextStartGate
End If
temVal = openGate(curGate)
If temVal Then
rcGate.Edit
rcGate!Status = 1
rcGate.Update
If i = curFrame Then
GoTo GateOK
End If
Else
CloseGate (curGate)
rcGate.Edit
rcGate!Status = 2
rcGate.Update
GoTo NotIsForward
End If
End If
NextStartGate:
Next i
NotIsForward:
For i = rcGate.RecordCount To curFrame Step -1
rcGate.FindFirst "FrameID=" + Format(i)
If Not rcGate.NoMatch Then
curGate = rcGate!endGate
If curGate = 0 Then
GoTo NextEndGate
End If
temVal = openGate(curGate)
If temVal Then
rcGate.Edit
rcGate!Status = 1
rcGate.Update
If i = curFrame Then
GoTo GateOK
End If
Else
CloseGate (curGate)
rcGate.Edit
rcGate!Status = 2
rcGate.Update
MsgBox "指定用户处于故障区间" + Chr(10) + "无法进行操作", 48, "用户煤气操作"
prepareUser = 0
Exit Function
End If
End If
NextEndGate:
Next i
GateOK:
'打开安全器
If Trim(cmbBuild.List(cmbBuild.ListIndex)) <> "" Then
curBuild = Trim(cmbBuild.List(cmbBuild.ListIndex))
rcBuild.FindFirst "BuildID=""" + curBuild + """"
If Not rcBuild.NoMatch Then
curBuildAddr = rcBuild!Address
If curBuildAddr <> 0 Then
If Not openBuild(curBuildAddr) Then
CloseBuild (curBuildAddr)
MsgBox "不能打开用户所在楼安全器"
prepareUser = 0
Exit Function
End If
End If
End If
End If
'得到用户地址
If Trim(cmbUser.List(cmbUser.ListIndex)) <> "" Then
curUserID = Val(Trim(cmbUser.List(cmbUser.ListIndex)))
rcUser.FindFirst "UserID=" + Format(curUserID)
If Not rcUser.NoMatch Then
If IsNull(rcTemUserMap!Address) Then
curUserAddr = 0
MsgBox "用户地址无效!", 48, "用户操作"
Else
curUserAddr = rcTemUserMap!Address
End If
prepareUser = curUserAddr
Else
MsgBox "无法找到指定用户信息!", 48, "用户操作"
prepareUser = 0
End If
End If
End If
End Function
'lblAddress.Caption = ""
'If Not (rcTemUserMap.RecordCount > 0) Then
'Exit Sub
'End If
'rcUser.FindFirst "UserID=" + Trim(cmbUser.List(cmbUser.ListIndex))
'If Not rcTemUserMap.NoMatch Then
'lblAddress.Caption = rcTemUserMap!Address
'End If
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOpen_Click()
Dim rcUserDev As Recordset
Dim curCardAddr As Integer
Dim curDevAddr As Integer
Select Case curScope
Case 0
curCardAddr = Val(txtCardAddr.Text)
curDevAddr = Val(txtDevAddr.Text)
Case 1
If Val(txtUser.Text) >= 0 Then
SQL = "select * from UserDev where UserID=" & Val(txtUser.Text) _
& " and devType=" & (cmbDev.ListIndex + 1)
Set rcUserDev = dbCbb.OpenRecordset(SQL, dbOpenSnapshot)
If rcUserDev.EOF Then
MsgBox "无效的用户号，请重新输入", vbOKOnly + vbInformation, "开关设备"
Exit Sub
End If
curCardAddr = rcUserDev!CardTermID
curDevAddr = rcUserDev!CardUserID
End If
End Select
closeCard
Delay 1, 1
'先发卡地址+开设备指令
openDev curCardAddr, DEVOP_OPEN
Delay 1, 1
'再发卡地址+设备地址
openDev curCardAddr, curDevAddr
Delay 1, 1
closeCard
MsgBox "打开设备（" & curCardAddr & " + " & curDevAddr & "）指令已发出", vbOKOnly + vbInformation, "打开设备"
End Sub
Private Sub cmdShut_Click()
Dim rcUserDev As Recordset
Dim curCardAddr As Integer
Dim curDevAddr As Integer
Select Case curScope
Case 0
curCardAddr = Val(txtCardAddr.Text)
curDevAddr = Val(txtDevAddr.Text)
Case 1
If Val(txtUser.Text) >= 0 Then
SQL = "select * from UserDev where UserID=" & Val(txtUser.Text) _
& " and devType=" & (cmbDev.ListIndex + 1)
Set rcUserDev = dbCbb.OpenRecordset(SQL, dbOpenSnapshot)
If rcUserDev.EOF Then
MsgBox "无效的用户号，请重新输入", vbOKOnly + vbInformation, "开关设备"
Exit Sub
End If
curCardAddr = rcUserDev!CardTermID
curDevAddr = rcUserDev!CardUserID
End If
End Select
closeCard
Delay 1, 1
'先发卡地址+关设备指令
openDev curCardAddr, DEVOP_SHUT
Delay 1, 1
'再发卡地址+设备地址
openDev curCardAddr, curDevAddr
Delay 1, 1
closeCard
MsgBox "关断设备（" & curCardAddr & " + " & curDevAddr & "）指令已发出", vbOKOnly + vbInformation, "关断设备"
End Sub
Sub initDev()
Dim rcDevsMap As Recordset
cmbDev.Clear
SQL = "select * from DevsMap order by typeID"
Set rcDevsMap = dbCbb.OpenRecordset(SQL, dbOpenSnapshot)
Do While Not rcDevsMap.EOF
cmbDev.AddItem rcDevsMap!Name
rcDevsMap.MoveNext
Loop
End Sub
Private Sub Form_Load()
If UBound(curForm) > 0 Then
curForm(UBound(curForm)).Enabled = False
End If
ReDim Preserve curForm(UBound(curForm) + 1)
Set curForm(UBound(curForm)) = Me
initDev
End Sub
Private Sub Form_Unload(Cancel As Integer)
ReDim Preserve curForm(UBound(curForm) - 1)
If UBound(curForm) > 0 Then
curForm(UBound(curForm)).Enabled = True
End If
End Sub
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
Private Sub optScope_Click(Index As Integer)
curScope = Index
Select Case Index
Case 0
txtCardAddr.Enabled = True
txtDevAddr.Enabled = True
txtUser.Enabled = False
Case 1
txtCardAddr.Enabled = False
txtDevAddr.Enabled = False
txtUser.Enabled = True
Case Else
txtCardAddr.Enabled = False
txtDevAddr.Enabled = False
txtUser.Enabled = False
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -