📄 frmuserturnon.frm
字号:
Begin VB.Label Label10
Caption = "用户缴费性质"
Height = 255
Left = 4935
TabIndex = 43
Top = 1245
Width = 1155
End
Begin VB.Label Label9
Caption = "用水性质"
Height = 255
Left = 210
TabIndex = 42
Top = 1230
Width = 750
End
Begin VB.Label Label4
Caption = "用户名称"
Height = 255
Left = 210
TabIndex = 41
Top = 345
Width = 765
End
Begin VB.Label Label5
Caption = "用户用水地址"
Height = 255
Left = 4950
TabIndex = 40
Top = 345
Width = 1215
End
Begin VB.Label Label6
Caption = "联系人"
Height = 255
Left = 210
TabIndex = 39
Top = 795
Width = 540
End
Begin VB.Label Label7
Caption = "联系电话"
Height = 255
Left = 2295
TabIndex = 38
Top = 795
Width = 795
End
Begin VB.Label Label8
Caption = "联系地址"
Height = 255
Left = 5310
TabIndex = 37
Top = 780
Width = 825
End
End
Begin VB.Frame Frame1
Caption = "区域"
ForeColor = &H8000000D&
Height = 795
Left = 150
TabIndex = 23
Top = 120
Width = 10185
Begin MSDataListLib.DataCombo cboQ
Height = 330
Left = 4065
TabIndex = 1
Top = 300
Width = 2040
_ExtentX = 3598
_ExtentY = 582
_Version = 393216
Style = 2
Text = ""
End
Begin MSDataListLib.DataCombo cboP
Height = 330
Left = 1035
TabIndex = 0
Top = 300
Width = 1905
_ExtentX = 3360
_ExtentY = 582
_Version = 393216
Style = 2
Text = ""
End
Begin VB.TextBox txtUID
Enabled = 0 'False
Height = 330
Left = 7530
MaxLength = 5
TabIndex = 2
Text = "Text1"
Top = 300
Width = 1290
End
Begin VB.Label Label3
Caption = "用户顺序号"
Height = 255
Left = 6525
TabIndex = 35
Top = 345
Width = 960
End
Begin VB.Label Label2
Caption = "所属小区"
Height = 255
Left = 3285
TabIndex = 34
Top = 360
Width = 780
End
Begin VB.Label Label1
Caption = "所属片区"
Height = 255
Left = 225
TabIndex = 33
Top = 360
Width = 750
End
End
Begin VB.Line Line1
BorderColor = &H80000005&
Index = 0
X1 = 60
X2 = 10395
Y1 = 5730
Y2 = 5730
End
Begin VB.Line Line1
BorderColor = &H80000003&
Index = 1
X1 = 60
X2 = 10395
Y1 = 5715
Y2 = 5715
End
End
Attribute VB_Name = "frmUserTurnOn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'detect()函数尚未实现
'
'
Option Explicit
Dim adoUserRecordRS As ADODB.Recordset '用户档案
Dim adoPRS As ADODB.Recordset '片区
Dim adoQRS As ADODB.Recordset '小区
Dim adoUTypeRS As ADODB.Recordset '用户类型
Dim adoChargetTypeRS As ADODB.Recordset '交费类型
Dim adoBankRS As ADODB.Recordset '银行
Dim adoBankSubOrganRS As ADODB.Recordset '银行分理处
Dim adoMwmRS As ADODB.Recordset '总水表
Dim bytCommandFlag As Byte '用于记录第一组按钮的状态,这样,在第二组的保存,放弃按钮中
'就可知道是原来是按的新增还是编辑,从而采取不同的处理方法
Dim blnEditFlag As Boolean '编辑标志，对内容的任何编辑，该变量都将置为TRUE
'---------------------------------------------------------
'按钮事件
'---------------------------------------------------------
Private Sub cmdCommandArray1_Click(Index As Integer)
Dim strSQL As String
bytCommandFlag = Index
Select Case Index
Case 0 '新增
Call DisableCMD1
Call EnableCMD2
Call DisableCMD3
Call DisableCMD4
Call InitInterFace
Call EnableInterFace
blnEditFlag = False
cboP.SetFocus
Case 1 '编辑
If Trim(Me.txtUID.Text) = "" Then Exit Sub
Call DisableCMD1
Call EnableCMD2
Call DisableCMD3
Call DisableCMD4
Call EnableInterFace
'对于编辑状态,如果在抄表档案中有该用户的抄表记录则 用户水表号 是不允许修改的
If Detect(Trim(Me.txtUID.Text)) Then
Me.txtWmID.Enabled = False
End If
blnEditFlag = False
cboP.SetFocus
Case 2 '删除
Dim bytReturnFlag As Byte '用于接收msgbox
Dim adoTmpRS As ADODB.Recordset
Dim strConstructID As String
If Trim(Me.txtUID.Text) = "" Then Exit Sub
'首先检测是否可以删除，对于已经有抄表记录的用户是不能删除的
If Detect(Trim(Me.txtUID.Text)) Then
Warning "已经存在该用户的抄表记录，不允许删除该用户的档案！！！"
Exit Sub
End If
bytReturnFlag = MsgBox("确定要删除该用户档案吗？", vbYesNo + vbInformation + vbDefaultButton2, "提示信息")
If bytReturnFlag = vbNo Then Exit Sub
'删除该记录
'得到用户对应的施工单号,从而可以删除材料明细信息
strConstructID = ""
strSQL = "select ConstructID from Construct where UID='" & adoUserRecordRS.Fields("UID") & "'"
Set adoTmpRS = gConnect.Execute(strSQL)
If adoTmpRS.EOF And adoTmpRS.BOF Then
strConstructID = ""
Else
strConstructID = Trim(adoTmpRS.Fields(0))
End If
adoTmpRS.Close
Set adoTmpRS = Nothing
gConnect.BeginTrans
On Error GoTo errHandleDel
'删除材料明细表信息
strSQL = "delete from ConDetail where ConstructID='" & strConstructID & "'"
gConnect.Execute strSQL
'删除施工档案信息
strSQL = "delete from Construct where UID='" & adoUserRecordRS.Fields("UID") & "'"
gConnect.Execute strSQL
'删除用户水表信息
strSQL = "delete from watermeter where UID='" & adoUserRecordRS.Fields("UID") & "'"
gConnect.Execute strSQL
'删除用户档案信息
adoUserRecordRS.Delete
On Error GoTo 0
gConnect.CommitTrans
On Error Resume Next
adoUserRecordRS.MoveNext
If adoUserRecordRS.EOF Then adoUserRecordRS.MovePrevious
On Error GoTo 0
Call DisplayCurrentData
If Me.txtUName.Text = "" Then
Call DisableCMD4
Else
Call EnableCMD4
End If
Case Else
MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
End Select
Exit Sub
'-------错误处理---------
errHandleDel:
gConnect.RollbackTrans
Warning "记录删除失败！" & Chr(13) & Err.Description
On Error GoTo 0
End Sub
Private Sub cmdCommandArray2_Click(Index As Integer)
Dim ctlEmptyControl As Control
Select Case Index
Case 0 '保存
Dim bytReturnFlag As Byte '用于接收msgbox
If bytCommandFlag = 0 Then '新增---保存
'关键数据没有填写的返回相应控件
Set ctlEmptyControl = CheckEmptyControl()
If Not (ctlEmptyControl Is Nothing) Then
Beep
ctlEmptyControl.SetFocus
Set ctlEmptyControl = Nothing
Exit Sub
End If
ElseIf bytCommandFlag = 1 Then '编辑---保存
'如果没有做任何改动，不做保存处理，屏幕退出编辑状态
If Not blnEditFlag Then
Call DisableInterFace
Call InitCommandBox
Exit Sub
End If
'如果有改动，检查关键数据是否填写，如没有填写的返回相应控件
Set ctlEmptyControl = CheckEmptyControl()
If Not (ctlEmptyControl Is Nothing) Then
Beep
ctlEmptyControl.SetFocus
Set ctlEmptyControl = Nothing
Exit Sub
End If
End If
'改动过，且符合保存条件（关键数据都写了）
bytReturnFlag = MsgBox("确定要保存吗？", vbYesNo + vbInformation + vbDefaultButton1, "提示信息")
If bytReturnFlag = vbNo Then
Call CommondButtonCancel '直接调用放弃过程
Exit Sub
Else
'保存当前数据
If Not SaveCurrentData() Then '保存不成功
Exit Sub
End If
Me.txtUID.Text = Trim(adoUserRecordRS.Fields("UID"))
End If
Call DisableInterFace
Call InitCommandBox
Case 1 '放弃
Call CommondButtonCancel
Case Else
MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
End Select
End Sub
Private Sub cmdCommandArray3_Click(Index As Integer)
Select Case Index
Case 0 '<<
If adoUserRecordRS.BOF Then '记录集为空的情况
'Warning "已经处于首记录！"
Beep
Exit Sub
End If
adoUserRecordRS.MovePrevious '如果已经是首条的情况,Beep
If adoUserRecordRS.BOF Then
adoUserRecordRS.MoveNext
Beep
Exit Sub
End If
adoUserRecordRS.MoveFirst '正常情况
Call DisplayCurrentData
Case 1 '<
If adoUserRecordRS.BOF Then
'Warning "已经处于首记录！"
Beep
Exit Sub
End If
adoUserRecordRS.MovePrevious
If adoUserRecordRS.BOF Then
adoUserRecordRS.MoveNext
Beep
Else
Call DisplayCurrentData
End If
Case 2 '>
If adoUserRecordRS.EOF Then
'Warning "已经处于尾记录！"
Beep
Exit Sub
End If
adoUserRecordRS.MoveNext
If adoUserRecordRS.EOF Then
adoUserRecordRS.MovePrevious
Beep
Else
Call DisplayCurrentData
End If
Case 3 '>>
If adoUserRecordRS.EOF Then '记录集为空的情况
'Warning "已经处于尾记录！"
Beep
Exit Sub
End If
adoUserRecordRS.MoveNext '如果已经是尾条的情况,Beep
If adoUserRecordRS.EOF Then
adoUserRecordRS.MovePrevious
Beep
Exit Sub
End If
adoUserRecordRS.MoveLast '正常情况
Call DisplayCurrentData
Case Else
MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
End Select
Exit Sub
End Sub
Private Sub cmdEngineering_Click()
frmUserTurnOn_Engineering.Show
End Sub
'---------------------------------------------------------
'窗体事件
'---------------------------------------------------------
Private Sub Form_Load()
MoveToCenter gMainFormRefer, Me
'设置控件的关键属性
Me.txtWmCaliber.MaxLen = 6
Me.txtAddCharge.MaxLen = 9
Me.txtWMStartReadNumber.MaxLen = 10
Me.txtAuditCharge.MaxLen = 10
Me.txtWmID.MaxLength = gWmIDLen
'打开记录集
On Error GoTo errHandleOpen
Set adoUserRecordRS = New ADODB.Recordset
Set adoUserRecordRS.ActiveConnection = gConnect
adoUserRecordRS.CursorLocation = adUseClient
adoUserRecordRS.CursorType = adOpenKeyset
adoUserRecordRS.LockType = adLockOptimistic
adoUserRecordRS.Open "select * from UserRecord where Status='1'" '1：正常用户，0：已经消户用户
Set adoPRS = New ADODB.Recordset
Set adoPRS.ActiveConnection = gConnect
adoPRS.CursorLocation = adUseClient
adoPRS.CursorType = adOpenForwardOnly
adoPRS.LockType = adLockOptimistic
adoPRS.Open "select PID,PName from Pian"
Set adoQRS = New ADODB.Recordset
Set adoQRS.ActiveConnection = gConnect
adoQRS.CursorLocation = adUseClient
adoQRS.CursorType = adOpenForwardOnly
adoQRS.LockType = adLockOptimistic
Set adoUTypeRS = New ADODB.Recordset
Set adoUTypeRS.ActiveConnection = gConnect
adoUTypeRS.CursorLocation = adUseClient
adoUTypeRS.CursorType = adOpenForwardOnly
adoUTypeRS.LockType = adLockOptimistic
adoUTypeRS.Open "select UTypeID,UTypeName from UserType"
Set adoChargetTypeRS = New ADODB.Recordset
Set adoChargetTypeRS.ActiveConnection = gConnect
adoChargetTypeRS.CursorLocation = adUseClient
adoChargetTypeRS.CursorType = adOpenForwardOnly
adoChargetTypeRS.LockType = adLockOptimistic
adoChargetTypeRS.Open "select ChargeTypeID,ChargeTypeName from ChargeType"
Set adoBankRS = New ADODB.Recordset
Set adoBankRS.ActiveConnection = gConnect
adoBankRS.CursorLocation = adUseClient
adoBankRS.CursorType = adOpenForwardOnly
adoBankRS.LockType = adLockOptimistic
Set adoBankSubOrganRS = New ADODB.Recordset
Set adoBankSubOrganRS.ActiveConnection = gConnect
adoBankSubOrganRS.CursorLocation = adUseClient
adoBankSubOrganRS.CursorType = adOpenForwardOnly
adoBankSubOrganRS.LockType = adLockOptimistic
Set adoMwmRS = New ADODB.Recordset
Set adoMwmRS.ActiveConnection = gConnect
adoMwmRS.CursorLocation = adUseClient
adoMwmRS.CursorType = adOpenForwardOnly
adoMwmRS.LockType = adLockOptimistic
adoMwmRS.Open "select MWmID,MWmName from MWatermeter"
On Error GoTo 0
'设置数据列表控件的字段关联
Set Me.cboP.RowSource = adoPRS
Me.cboP.ListField = "PName"
Me.cboP.BoundColumn = "PID"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -