📄 frmnogeneralusermanageinput.frm
字号:
Caption = "联系人"
Height = 255
Left = 195
TabIndex = 29
Top = 1380
Width = 540
End
Begin VB.Label Label7
Caption = "联系电话"
Height = 255
Left = 2505
TabIndex = 28
Top = 1380
Width = 795
End
Begin VB.Label Label8
Caption = "联系地址"
Height = 255
Left = 5460
TabIndex = 27
Top = 1365
Width = 750
End
Begin VB.Label Label2
Caption = "所属小区"
Height = 255
Left = 3150
TabIndex = 26
Top = 330
Width = 780
End
Begin VB.Label Label1
Caption = "所属片区"
Height = 255
Left = 195
TabIndex = 25
Top = 315
Width = 750
End
End
Begin VB.TextBox txtUID
Height = 330
Left = 1140
MaxLength = 5
TabIndex = 0
Top = 165
Width = 1575
End
Begin VB.Label LabelB
Caption = "检查时间"
Height = 255
Left = 5295
TabIndex = 39
Top = 255
Width = 750
End
Begin VB.Label LabelC
Caption = "检查人"
Height = 255
Left = 7680
TabIndex = 38
Top = 270
Width = 780
End
Begin VB.Label LabelA
Caption = "水表状态"
Height = 255
Left = 2925
TabIndex = 37
Top = 225
Width = 960
End
Begin VB.Label Label3
Caption = "用户顺序号"
Height = 255
Left = 210
TabIndex = 13
Top = 225
Width = 960
End
End
Attribute VB_Name = "frmNoGeneralUserManageInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim adoABWmRS As ADODB.Recordset '非正常用户水表记录集
Dim adoWmStatus As ADODB.Recordset '水表状态记录集
Dim bytCommandFlag As Byte
Dim blnEditFlag As Boolean
'---------------------------------------------------------
'按钮事件
'---------------------------------------------------------
Private Sub cmdCommandArray1_Click(Index As Integer)
Dim strSQL As String
Dim bytReturnFlag As Byte '用于接收msgbox
bytCommandFlag = Index
Select Case Index
Case 0 '输入
Call DisableCMD1
Call EnableCMD2
Call DisableCMD3
Me.txtUID.Text = "" 'ClearInterFace函数不包括用户号的清除
Call ClearInterFace
Call EnableInterFace
blnEditFlag = False
Me.txtUID.SetFocus
Case 1 '删除
If Trim(Me.cboStatus.Text) = "" Then Exit Sub
bytReturnFlag = MsgBox("确定要删除该用户非正常水表信息记录吗？", vbYesNo + vbInformation + vbDefaultButton2, "提示信息")
If bytReturnFlag = vbNo Then Exit Sub
'删除该记录
'得到用户对应的施工单号,从而可以删除材料明细信息
On Error GoTo errHandleDel
adoABWmRS.Delete
On Error GoTo 0
On Error Resume Next
adoABWmRS.MoveNext
If adoABWmRS.EOF Then adoABWmRS.MovePrevious
On Error GoTo 0
Call DisplayCurrentData '删除后,接着显示最近的一条记录
Case 2 '设置正常
If Trim(Me.cboStatus.Text) = "" Then Exit Sub
bytReturnFlag = MsgBox("确定该用户的水表已经恢复正常了吗？", vbYesNo + vbInformation + vbDefaultButton1, "提示信息")
If bytReturnFlag = vbNo Then Exit Sub
'恢复正常
'也就是将该非正常记录的当前标志CurrentFlag设置成历史状态
On Error GoTo errHandleUpdate
adoABWmRS!CurrentFlag = "0"
adoABWmRS.Update
On Error GoTo 0
'由于上一步设置CurrentFlag = "0"了,而adoABWmRS应该是CurrentFlag = "1"的记录集,因此要刷新
On Error Resume Next
adoABWmRS.Close
On Error GoTo 0
On Error GoTo errHandleOpen
adoABWmRS.Open "select * from ABWm where CurrentFlag='1' order by No" '只选择当前状态的用户，也就是只考虑当前非正常水表的用户
On Error GoTo 0
On Error Resume Next
adoABWmRS.MoveLast
On Error GoTo 0
Call DisplayCurrentData
Case Else
MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
End Select
Exit Sub
'-------错误处理---------
errHandleDel:
Warning "记录删除失败！" & Chr(13) & Err.Description
On Error GoTo 0
Exit Sub
errHandleUpdate:
Warning "恢复水表正常状态失败！" & Chr(13) & Err.Description
On Error GoTo 0
Exit Sub
errHandleOpen:
Warning "打开记录集失败！" & Chr(13) & Err.Description
On Error GoTo 0
Exit Sub
End Sub
Private Sub cmdCommandArray2_Click(Index As Integer)
Select Case Index
Case 0 '保存
Dim bytReturnFlag As Byte '用于接收msgbox
If Trim(Me.txtUID.Text) = "" Then
Beep
Me.txtUID.SetFocus
Exit Sub
End If
If Trim(Me.cboStatus.Text) = "" Then
Beep
Me.cboStatus.SetFocus
Exit Sub
End If
bytReturnFlag = MsgBox("确定要保存吗？", vbYesNo + vbInformation + vbDefaultButton1, "提示信息")
If bytReturnFlag = vbNo Then
Call CommondButtonCancel '直接调用放弃过程
Exit Sub
Else
'保存当前数据
On Error GoTo errHandleSave
adoABWmRS.AddNew
adoABWmRS!UID = Trim(Me.txtUID.Text)
adoABWmRS!Status = Me.cboStatus.BoundText
adoABWmRS!CheckTime = Me.dtpCheckTime.value
adoABWmRS!CheckMan = Trim(Me.txtCheckMan.Text)
adoABWmRS!CurrentFlag = "1"
adoABWmRS.Update
On Error GoTo 0
On Error Resume Next
adoABWmRS.MoveLast
On Error GoTo 0
Call DisableInterFace
Call InitCommandBox
End If
Case 1 '放弃
Call CommondButtonCancel
Case Else
MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
End Select
Exit Sub
'-------错误处理---------
errHandleSave:
Warning "记录保存失败！" & Chr(13) & Err.Description
On Error GoTo 0
Exit Sub
End Sub
Private Sub cmdCommandArray3_Click(Index As Integer)
Select Case Index
Case 0 '<<
If adoABWmRS.BOF Then '记录集为空的情况
'Warning "已经处于首记录！"
Beep
Exit Sub
End If
adoABWmRS.MovePrevious '如果已经是首条的情况,Beep
If adoABWmRS.BOF Then
adoABWmRS.MoveNext
Beep
Exit Sub
End If
adoABWmRS.MoveFirst '正常情况
Call DisplayCurrentData
Case 1 '<
If adoABWmRS.BOF Then
'Warning "已经处于首记录！"
Beep
Exit Sub
End If
adoABWmRS.MovePrevious
If adoABWmRS.BOF Then
adoABWmRS.MoveNext
Beep
Else
Call DisplayCurrentData
End If
Case 2 '>
If adoABWmRS.EOF Then
'Warning "已经处于尾记录！"
Beep
Exit Sub
End If
adoABWmRS.MoveNext
If adoABWmRS.EOF Then
adoABWmRS.MovePrevious
Beep
Else
Call DisplayCurrentData
End If
Case 3 '>>
If adoABWmRS.EOF Then '记录集为空的情况
'Warning "已经处于尾记录！"
Beep
Exit Sub
End If
adoABWmRS.MoveNext '如果已经是尾条的情况,Beep
If adoABWmRS.EOF Then
adoABWmRS.MovePrevious
Beep
Exit Sub
End If
adoABWmRS.MoveLast '正常情况
Call DisplayCurrentData
Case Else
MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
End Select
Exit Sub
End Sub
'---------------------------------------------------------
'自定义过程/函数
'---------------------------------------------------------
Private Sub ClearInterFace()
'清除界面
Call ClearWmStatus
Me.dtpCheckTime.value = Date
Me.txtCheckMan.Text = ""
Me.txtP.Text = ""
Me.txtQ.Text = ""
Me.txtUName.Text = ""
Me.txtAddr.Text = ""
Me.txtLinkMan.Text = ""
Me.txtLinkPhone.Text = ""
Me.txtLinkAddr.Text = ""
Me.txtWmID.Text = ""
Me.txtWmCaliber.Text = 0
Me.txtWmMakeAddr.Text = ""
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -