frmuserclose.frm

自来水公司的一个管理系统

         Left            =   135
         TabIndex        =   20
         Top             =   1155
         Width           =   540
      End
      Begin VB.Label Label5 
         Caption         =   "用户用水地址"
         Height          =   255
         Left            =   5010
         TabIndex        =   19
         Top             =   795
         Width           =   1140
      End
      Begin VB.Label Label4 
         Caption         =   "用户名称"
         Height          =   255
         Left            =   135
         TabIndex        =   18
         Top             =   795
         Width           =   765
      End
      Begin VB.Label Label9 
         Caption         =   "用水性质"
         Height          =   255
         Left            =   135
         TabIndex        =   17
         Top             =   1485
         Width           =   750
      End
      Begin VB.Label Label10 
         Caption         =   "用户缴费性质"
         Height          =   255
         Left            =   4995
         TabIndex        =   16
         Top             =   1500
         Width           =   1080
      End
      Begin VB.Label Label11 
         Caption         =   "开户银行"
         Height          =   255
         Left            =   135
         TabIndex        =   15
         Top             =   1830
         Width           =   750
      End
      Begin VB.Label Label12 
         Caption         =   "开户名称"
         Height          =   255
         Left            =   5355
         TabIndex        =   14
         Top             =   1815
         Width           =   795
      End
      Begin VB.Label Label13 
         Caption         =   "账号"
         Height          =   255
         Left            =   8130
         TabIndex        =   13
         Top             =   1830
         Width           =   435
      End
      Begin VB.Label Label22 
         Caption         =   "水表初始读数"
         Height          =   255
         Left            =   5580
         TabIndex        =   12
         Top             =   2685
         Width           =   1170
      End
      Begin VB.Label Label18 
         Caption         =   "m/m"
         Height          =   255
         Index           =   0
         Left            =   8580
         TabIndex        =   10
         Top             =   2295
         Width           =   330
      End
      Begin VB.Label Label17 
         Caption         =   "用户水表产地"
         Height          =   255
         Left            =   135
         TabIndex        =   9
         Top             =   2685
         Width           =   1170
      End
      Begin VB.Label Label16 
         Caption         =   "用户水表口径"
         Height          =   255
         Left            =   6225
         TabIndex        =   8
         Top             =   2325
         Width           =   1170
      End
      Begin VB.Label Label15 
         Caption         =   "用户水表编号"
         Height          =   255
         Left            =   3375
         TabIndex        =   7
         Top             =   2325
         Width           =   1170
      End
      Begin VB.Label Label14 
         Caption         =   "总表"
         Height          =   255
         Left            =   135
         TabIndex        =   6
         Top             =   2325
         Width           =   750
      End
   End
   Begin MSComCtl2.DTPicker dtpDestroyTime 
      Height          =   300
      Left            =   6105
      TabIndex        =   55
      Top             =   90
      Width           =   1395
      _ExtentX        =   2461
      _ExtentY        =   529
      _Version        =   393216
      Format          =   23592961
      CurrentDate     =   37023
   End
   Begin VB.Label Label28 
      Caption         =   "操作员"
      Height          =   255
      Left            =   7710
      TabIndex        =   57
      Top             =   165
      Width           =   960
   End
   Begin VB.Label Label27 
      Caption         =   "消户时间"
      Height          =   225
      Left            =   5340
      TabIndex        =   56
      Top             =   165
      Width           =   720
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000003&
      Index           =   9
      X1              =   90
      X2              =   10350
      Y1              =   480
      Y2              =   480
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      Index           =   8
      X1              =   90
      X2              =   10335
      Y1              =   495
      Y2              =   495
   End
   Begin VB.Label Label3 
      Caption         =   "用户顺序号"
      Height          =   255
      Left            =   315
      TabIndex        =   27
      Top             =   165
      Width           =   960
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      Index           =   0
      X1              =   60
      X2              =   10335
      Y1              =   5895
      Y2              =   5895
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000003&
      Index           =   1
      X1              =   60
      X2              =   10320
      Y1              =   5880
      Y2              =   5880
   End
End
Attribute VB_Name = "frmUserClose"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim adoUserRecordRS As ADODB.Recordset

Private Sub cmdUserClose_Click()
    Dim bytReturnFlag As Byte
    Dim strSQL As String
    
    bytReturnFlag = MsgBox("请仔细核对该用户信息,是否确认要对该用户进行消户?", vbYesNo + vbDefaultButton2 + vbInformation, "警告")
    If bytReturnFlag = vbNo Then
        Call HindT
        Me.rtbDestroyNote.Text = ""
        Me.dtpDestroyTime.value = Date
        Call DisableInterFace
        Exit Sub
    End If
    
    '消户操作
    strSQL = "update UserRecord set Status='0',DestroyTime='" & Me.dtpDestroyTime.value & "',DestroyNote='" & Trim(Me.rtbDestroyNote.Text) & "',DestroyOgID='" & gstrCurOperatorID & "',DestroyOgName='" & gstrCurOperatorName & "' where UID='" & Trim(Me.txtUID.Text) & "'"
    On Error GoTo errHandleUpdate
    gConnect.Execute strSQL
    On Error GoTo 0
    
    Me.txtUID.Text = ""
    Call HindT
    Call ClearInterFace
    Call DisableInterFace
    Me.txtUID.SetFocus
    Exit Sub
    
    '-------错误处理---------
errHandleUpdate:
    Warning "用户消户操作失败！" & Chr(13) & Err.Description
    On Error GoTo 0
    
End Sub

Private Sub Form_Load()
    MoveToCenter gMainFormRefer, Me
        
    '设置关键控件的属性
    Me.txtWmCaliber.MaxLen = 9
    Me.txtAddCharge.MaxLen = 9
    Me.txtAuditCharge.MaxLen = 9
    
    '设置记录集
    On Error GoTo errHandleOpen
    Set adoUserRecordRS = New ADODB.Recordset
    Set adoUserRecordRS.ActiveConnection = gConnect
    adoUserRecordRS.CursorLocation = adUseClient
    adoUserRecordRS.CursorType = adOpenForwardOnly
    adoUserRecordRS.LockType = adLockOptimistic
    On Error GoTo 0
    
    Me.txtUID.Text = ""
    Call ClearInterFace
    Call DisableInterFace
    Call HindT
    Exit Sub
    
    '-------错误处理---------
errHandleOpen:
    Warning "记录创建失败！" & Chr(13) & Err.Description
    On Error GoTo 0

End Sub

Private Sub ClearInterFace()
'    Me.txtUID.Text = ""
    Me.dtpDestroyTime.value = Date
    Me.txtP.Text = ""
    Me.txtQ.Text = ""
    Me.txtUName.Text = ""
    Me.txtAddr.Text = ""
    Me.txtLinkMan.Text = ""
    Me.txtLinkPhone.Text = ""
    Me.txtLinkAddr.Text = ""
    Me.txtUserType.Text = ""
    Me.txtChargetType.Text = ""
    Me.txtBank.Text = ""
    Me.txtBankSubOrgan.Text = ""
    Me.txtBankUserName.Text = ""
    Me.txtAccount.Text = ""
    Me.txtMWM.Text = ""
    Me.txtWmID.Text = ""
    Me.txtWmCaliber.Text = 0
    Me.txtWmMakeAddr.Text = ""
    Me.txtWMStartReadNumber.Text = 0
    Me.txtAddCharge.Text = 0
    Me.txtAuditCharge.Text = 0
    Me.txtLeaderIdea.Text = ""
    Me.txtNote.Text = ""
    Me.rtbDestroyNote.Text = ""
End Sub

Private Sub DisplayCurrentData()
    '将表中的当前数据记录显示在屏幕上
    '要考虑数据表为空的情况
    If adoUserRecordRS.EOF Or adoUserRecordRS.BOF Then Exit Sub
    
    With adoUserRecordRS
    If adoUserRecordRS!Status = "0" Then    '已经消户用户
        Me.dtpDestroyTime.value = .Fields("DestroyTime")
        Me.txtDestroyOgName.Text = .Fields("DestroyOgName")
        Me.rtbDestroyNote.Text = .Fields("DestroyNote")
    Else                                    '尚未消户用户
        Me.dtpDestroyTime.value = Date
        Me.txtDestroyOgName.Text = gstrCurOperatorName
        Me.rtbDestroyNote.Text = ""
    End If
    Me.txtP.Text = .Fields("PName")
    Me.txtQ.Text = .Fields("QName")
    Me.txtUName.Text = .Fields("UName")
    Me.txtAddr.Text = .Fields("Addr")
    Me.txtLinkMan.Text = .Fields("LinkMan")
    Me.txtLinkPhone.Text = .Fields("LinkPhone")
    Me.txtLinkAddr.Text = .Fields("LinkAddr")
    Me.txtUserType.Text = .Fields("UTypeName")
    Me.txtChargetType.Text = .Fields("ChargeTypeName")
        
    Me.txtBank.Text = IIf(IsNull(.Fields("BankName")), "", .Fields("BankName"))
    Me.txtBankSubOrgan.Text = IIf(IsNull(.Fields("SubOrganName")), "", .Fields("SubOrganName"))
    Me.txtBankUserName.Text = IIf(IsNull(.Fields("BankUserName")), "", .Fields("BankUserName"))
    Me.txtAccount.Text = IIf(IsNull(.Fields("Account")), "", .Fields("Account"))
    
    Me.txtMWM.Text = .Fields("MwmName")
    Me.txtWmID.Text = .Fields("WMID")
    Me.txtWmCaliber.Text = .Fields("WmCaliber")
    Me.txtWmMakeAddr.Text = .Fields("WmMakeAddr")
    Me.txtWMStartReadNumber.Text = .Fields("WMStartReadNumber")
    Me.txtAddCharge.Text = .Fields("AddCharge")
    Me.txtAuditCharge.Text = .Fields("AuditCharge")
    Me.txtLeaderIdea.Text = .Fields("LeaderIdea")
    Me.txtNote.Text = .Fields("Note")
    End With
    
End Sub

Private Sub txtUID_GotFocus()
    Call AutoSelectText(Me.txtUID)
End Sub

Private Sub txtUID_KeyPress(KeyAscii As Integer)
'    Call IfEnterKeyMoveNext(KeyAscii)
    If KeyAscii = 13 Then
        KeyAscii = 0
        SendKeys "{tab}"
    End If

End Sub

Private Sub txtUID_LostFocus()
    Dim strSQL As String
    
    If txtUID.Text = "" Then
        Call ClearInterFace
        Call DisableInterFace
        Call HindT
        Me.txtUID.SetFocus
        Exit Sub
    End If
        
    Me.txtUID.Text = String(gUIDLen - Len(Trim(Me.txtUID.Text)), "0") & Trim(Me.txtUID.Text)
    '在用户档案视图中查询该用户
    On Error Resume Next
    adoUserRecordRS.Close
    On Error GoTo 0
    strSQL = "select * from vUserRecord where UID='" & Trim(Me.txtUID.Text) & "'"
    On Error GoTo errHandleOpen
    adoUserRecordRS.Open strSQL
    On Error GoTo 0
    
    If adoUserRecordRS.EOF And adoUserRecordRS.BOF Then
        '未查到该用户号的档案记录
'        Beep
        Call ClearInterFace
        Call DisableInterFace
        Call HindT
        Warning "该用户不存在！！！"
        Exit Sub
    End If
    
    '查到该用户号的档案记录
    If adoUserRecordRS!Status = "0" Then '该用户已经消户
'        Beep
        Call DisplayCurrentData
        Call DisableInterFace
        Call ShowT
        Warning "该用户已经消户！！！"
        Exit Sub
    End If
    
    '可以消户的正常用户
    Call ShowT
    Call DisplayCurrentData
    Call EnableInterFace
    Me.rtbDestroyNote.SetFocus
    Exit Sub
    
    '-------错误处理---------
errHandleOpen:
    Call ClearInterFace
    Call DisableInterFace
    Call HindT
    Warning "记录集打开失败！" & Chr(13) & Err.Description
    On Error GoTo 0
    
End Sub

Private Sub DisableInterFace()
    Me.txtP.Enabled = False
    Me.txtQ.Enabled = False
    Me.txtUName.Enabled = False
    Me.txtAddr.Enabled = False
    Me.txtLinkMan.Enabled = False
    Me.txtLinkPhone.Enabled = False
    Me.txtLinkAddr.Enabled = False
    Me.txtUserType.Enabled = False
    Me.txtChargetType.Enabled = False
    Me.txtBank.Enabled = False
    Me.txtBankSubOrgan.Enabled = False
    Me.txtBankUserName.Enabled = False
    Me.txtAccount.Enabled = False
    Me.txtMWM.Enabled = False
    Me.txtWmID.Enabled = False
    Me.txtWmCaliber.Enabled = False
    Me.txtWmMakeAddr.Enabled = False
    Me.txtWMStartReadNumber.Enabled = False
    Me.txtAddCharge.Enabled = False
    Me.txtAuditCharge.Enabled = False
    Me.txtLeaderIdea.Enabled = False
    Me.txtNote.Enabled = False
    
    Me.dtpDestroyTime.Enabled = False
    Me.rtbDestroyNote.Enabled = False
    Me.cmdUserClose.Enabled = False
End Sub

Private Sub EnableInterFace()
    Me.dtpDestroyTime.Enabled = True
    Me.rtbDestroyNote.Enabled = True
    Me.cmdUserClose.Enabled = True
End Sub

Private Sub ShowT()
    Me.dtpDestroyTime.Visible = True
    Me.txtDestroyOgName.Visible = True
End Sub

Private Sub HindT()
    Me.dtpDestroyTime.Visible = False
    Me.txtDestroyOgName.Visible = False
End Sub