frmbasic.frm

有线电视收费软件 数据库密码winter

        txtID.Text = !uID
        txtName.Text = !Name
        txtAddr.Text = CStr(Format(!addr))
        txtPlace.Text = CStr(Format(!dept))
        txtTelephone.Text = CStr(Format(!tele))
        cboSign.Text = Format(!sign)
        txtOrgFee.Text = Format(!fee)
        dtpOrgDate.Value = Format(!feedate)
        txtCostFee.Text = Format(!cost)
        dtpFixDate.Value = Format(!termdate)
        dtpGetDate.Value = Format(!startdate)
        lblOperator.Caption = Format(!operator)
        lblOperationTime.Caption = Format(!opdate)
   End With

End Sub
'设置空值
Private Sub SetNull()
    txtID = ""
    txtName = ""
    txtPlace = ""
    txtAddr = ""
    txtTelephone = ""
    cboSign = "正常"
    txtOrgFee = ""
    dtpOrgDate = Date
    txtCostFee = ""
    dtpFixDate = Date
    If Month(Date) = 12 Then
        dtpGetDate.Value = Year(Date) + 1 & "-01-01"
    Else
        dtpGetDate.Value = Year(Date) & "-" & Month(Date) + 1 & "-01"
    End If
    
    lblOperator.Caption = sOperator
    lblOperationTime = Date
End Sub
Private Sub SetButtons(bVal As Boolean)
  'cmdAdd.Enabled = bVal
  cmdUpdate.Enabled = bVal
  cmdDelete.Enabled = bVal
  cmdRefresh.Enabled = bVal
  CmdNext.Enabled = bVal
  CmdFirst.Enabled = bVal
  CmdLast.Enabled = bVal
  CmdPrevious.Enabled = bVal
End Sub
'--检查数据
Private Function CheckData() As Boolean
CheckData = False
If Format(txtID.Text) = "" Then
    MsgBox "请输入用户编号信息！   ", vbCritical
    txtID.SetFocus
    Exit Function
ElseIf Format(txtName.Text) = "" Then
    MsgBox "请输入用户姓名信息！   ", vbCritical
    txtName.SetFocus
    Exit Function
ElseIf Format(txtAddr) = "" Then
    MsgBox "请输入用户地址信息！   ", vbCritical
    txtAddr.SetFocus
    Exit Function
ElseIf Format(cboSign) = "" Then
    MsgBox "请选择信号情况！   ", vbCritical
    cboSign.SetFocus
    Exit Function
ElseIf Format(dtpOrgDate) = "" Then
    MsgBox "请添入初装交费日期！   ", vbCritical
    dtpOrgDate.SetFocus
    Exit Function
ElseIf Format(dtpGetDate) = "" Then
    MsgBox "请添入开通起始日期！   ", vbCritical
    dtpGetDate.SetFocus
    Exit Function

End If
CheckData = True
End Function
'--
Private Sub CboSign_GotFocus()
    ShowStatus ("选择信号情况（必选）")
End Sub
'--查找指定的用户编号或姓名
Private Sub CmdFind_Click()
    Dim glbRYBH
    Dim sSQL As String
    
    glbRYBH = InputBox("请输入用户编号或姓名！")
    If Len(glbRYBH) = 0 Then
        MsgBox "请输入用户编号或姓名！", vbInformation, "查找"
        Exit Sub
    End If
    glbRYBH = glbRYBH & "%"
    If Trim(glbRYBH) = "" Then
        SetNull
        SetButtons False
        Exit Sub
    End If
    sSQL = " SELECT * FROM t_user" _
         & " WHERE uID like '" & glbRYBH _
         & "' OR name LIKE '" & glbRYBH & "'"
    datPrimaryRS.RecordSource = sSQL
    datPrimaryRS.Refresh
    If datPrimaryRS.Recordset.BOF And datPrimaryRS.Recordset.EOF Then
        glbRYBH = ""
        MsgBox "未查到该人员的信息！", vbInformation, "查找"
        SetNull
        SetButtons False
    Else
        GetRecInfo
        
        SetButtons True
        cmdPrint.Enabled = True
    End If
End Sub
'--
Private Sub cmdFirst_Click()
    On Error GoTo GoFirstError

    datPrimaryRS.Recordset.MoveFirst
    GetRecInfo
    Exit Sub

GoFirstError:
    MsgBox Err.Description
End Sub
'--
Private Sub cmdLast_Click()
    On Error GoTo GoLastError
    
    datPrimaryRS.Recordset.MoveLast
    GetRecInfo
    Exit Sub

GoLastError:
    MsgBox Err.Description
End Sub
'--
Private Sub cmdNext_Click()
    On Error GoTo GoNextError

    If Not datPrimaryRS.Recordset.EOF Then datPrimaryRS.Recordset.MoveNext
    If datPrimaryRS.Recordset.EOF And datPrimaryRS.Recordset.RecordCount > 0 Then
        Beep
         '已到最后返回
        datPrimaryRS.Recordset.MoveLast
    End If
    '显示当前记录
    GetRecInfo
    Exit Sub
GoNextError:
    MsgBox Err.Description
End Sub
'--
Private Sub cmdPrevious_Click()
    On Error GoTo GoPrevError
    
    If Not datPrimaryRS.Recordset.BOF Then datPrimaryRS.Recordset.MovePrevious
    If datPrimaryRS.Recordset.BOF And datPrimaryRS.Recordset.RecordCount > 0 Then
        Beep
        '已到最后返回
        datPrimaryRS.Recordset.MoveFirst
    End If
      '显示当前记录
    GetRecInfo
    Exit Sub
    
GoPrevError:
    MsgBox Err.Description
End Sub
'--
Private Sub cmdPrint_Click()
    GetPrintInfo
    PrintReceipt
End Sub
'--
Private Sub dtpFixDate_Validate(Cancel As Boolean)
    'dtpFixDate.Value = Date
End Sub
'--
Private Sub dtpOrgDate_Validate(Cancel As Boolean)
    'dtpOrgDate.Value = Date
End Sub

'--窗体载入
Private Sub Form_Load()
    
    With Me
        .Hide
        .Left = 0
        .Top = 0
        .Width = rectWIDTH
        .Height = rectHEIGHT
    End With
        
    On Error GoTo 0
    datPrimaryRS.ConnectionString = CN.ConnectionString
    
    lblOperator.Caption = sOperator
    lblOperationTime.Caption = Date
    cboSign.Text = "正常"
    
    dtpOrgDate.Value = Date
    If Month(Date) = 12 Then
        dtpGetDate.Value = Year(Date) + 1 & "-01-01"
    Else
        dtpGetDate.Value = Year(Date) & "-" & Month(Date) + 1 & "-01"
    End If
    dtpFixDate.Value = Date
    
    cmdPrint.Enabled = False
    GetPrintInfo
    Me.Show
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - 1600 - Me.Height) / 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Screen.MousePointer = vbDefault
End Sub

Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
  '错误处理程序代码置于此处
  '想要忽略错误，注释掉下一行
  '想要捕获它们，在此添加代码以处理它们
  MsgBox "Data error event hit err:" & Description
End Sub
'添加新用户记录
Private Sub CmdAdd_Click()

    If MsgBox("确定要添加数据吗？  ", vbYesNo + vbQuestion) = vbNo Then Exit Sub
        If CheckData = False Then
        Exit Sub
    End If
    If txtPlace.Text = "" Then
        txtPlace.Text = "无"
    End If
    Set adoPrimaryRS = New ADODB.Recordset
    adoPrimaryRS.Open "t_user", CN, adOpenKeyset, adLockPessimistic, adCmdTableDirect
    On Error GoTo AddErr
  
    With adoPrimaryRS
            .AddNew
            !uID = txtID.Text
            !Name = txtName.Text
            If txtPlace.Text <> "" Then !dept = txtPlace.Text
            !addr = txtAddr.Text
            !Type = "个人"
            !sign = cboSign.Text
            If txtTelephone.Text <> "" Then !tele = txtTelephone.Text
            If txtCostFee.Text <> "" Then
                !cost = txtCostFee.Text
            Else
                !cost = 0
            End If
            If txtOrgFee.Text <> "" Then
                !fee = txtOrgFee.Text
            Else
                !fee = 0
            End If
            If dtpOrgDate.Value <> "" Then !feedate = dtpOrgDate.Value
            '!初装交费日期 = Date
            '!终端安装日期 = dtpFixDate.Value
            If dtpFixDate.Value <> "" Then !termdate = dtpFixDate.Value
            '!终端安装日期 = Date
            !startdate = dtpGetDate.Value
            !opdate = Date
            !operator = lblOperator.Caption
        .UpdateBatch
    End With
    adoPrimaryRS.Close
    SetNull
    SetButtons False
Exit Sub
AddErr:
  MsgBox "因有数据错误而操作失败！" + vbCr + vbCr + "请检查用户编号是否重复！", vbCritical 'Err.Description
    
End Sub

'删除
Private Sub cmdDelete_Click()
    If MsgBox("确定要删除数据吗？  ", vbYesNo + vbQuestion) = vbNo Then Exit Sub

    On Error GoTo DeleteErr
    With datPrimaryRS.Recordset
        .Delete
        .UpdateBatch
        .MoveNext
        If .EOF And .RecordCount = 0 Then
            SetNull
            SetButtons False
            Exit Sub
        End If
        If .EOF And .RecordCount > 0 Then
            .MoveLast
        End If
        GetRecInfo
    End With
    cmdPrint.Enabled = False
    Exit Sub
DeleteErr:
    MsgBox Err.Description
End Sub
'清空当前内容
Private Sub cmdRefresh_Click()
    On Error GoTo RefreshErr
    SetNull
    SetButtons False
    cmdPrint.Enabled = False
    Exit Sub
RefreshErr:
    MsgBox Err.Description
End Sub
'--更新
Private Sub cmdUpdate_Click()

    If MsgBox("确定要修改数据吗？  " + vbCr + "提示：用户编号将不被修改！！", vbYesNo + vbQuestion) = vbNo Then Exit Sub
    If CheckData = False Then
        Exit Sub
    End If
    If txtPlace.Text = "" Then
        txtPlace.Text = "无"
    End If
    Set adoPrimaryRS = New ADODB.Recordset
    adoPrimaryRS.Open "select * from t_user where uID = '" & txtID & "'", CN, adOpenKeyset, adLockPessimistic
    On Error GoTo UpdateErr
    
    With adoPrimaryRS
'        !uID = txtID.Text
        !Name = txtName.Text
        If txtPlace.Text <> "" Then !dept = txtPlace.Text
        !addr = txtAddr.Text
        !Type = "个人"
        !sign = cboSign.Text
        If txtTelephone.Text <> "" Then !tele = txtTelephone.Text
        !cost = Val(txtCostFee.Text)
        !fee = Val(txtOrgFee.Text)
        If dtpOrgDate.Value <> "" Then !feedate = dtpOrgDate.Value
        If dtpFixDate.Value <> "" Then !termdate = dtpFixDate.Value
        !startdate = dtpGetDate.Value
    .UpdateBatch
    End With
    adoPrimaryRS.Close
    datPrimaryRS.Recordset.Requery
    datPrimaryRS.Refresh
    
    
    cmdPrint.Enabled = True
  Exit Sub
UpdateErr:
  MsgBox "因有数据错误而操作失败！" 'Err.Description
End Sub


Private Sub cmdClose_Click()
  Unload Me
End Sub


Private Sub txtBP_GotFocus()
    ShowStatus ("最多十四位的传呼号码")
End Sub


Private Sub txtBP_Validate(Cancel As Boolean)
txtBP = Trim(txtBP)
If txtBP.Text = "" Then txtBP.Text = "无"
End Sub

Private Sub txtAddr_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        txtName.SetFocus
    End If
End Sub

Private Sub txtCostFee_GotFocus()
    ShowStatus ("工本费")
End Sub


Private Sub txtCostFee_Validate(Cancel As Boolean)
On Error GoTo ErrHandle
txtCostFee = CCur(txtCostFee)
Exit Sub
ErrHandle:
txtCostFee = ""

End Sub
'--
Private Sub txtID_GotFocus()
    ShowStatus ("最多四位的编号（必填）")
End Sub

Private Sub txtID_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        txtAddr.SetFocus
    End If
End Sub

'--
Private Sub txtID_Validate(Cancel As Boolean)
txtID = Trim(txtID)
If Len(txtID.Text) < 4 Then
    MsgBox "用户编号位数不足 4 位！", vbInformation, "输入提示"
    Cancel = True
End If
End Sub
'--
Private Sub txtName_GotFocus()
    ShowStatus ("最多10位的姓名（必填）")
End Sub

Private Sub txtName_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        txtPlace.SetFocus
    End If
End Sub

'--
Private Sub txtName_Validate(Cancel As Boolean)
txtName = Trim(txtName)
End Sub
Private Sub txtOrgFee_GotFocus()
    ShowStatus ("初装费用")
End Sub

Private Sub txtOrgFee_Validate(Cancel As Boolean)
On Error GoTo ErrHandle
txtOrgFee = CCur(txtOrgFee)
Exit Sub
ErrHandle:
txtOrgFee = ""
End Sub

Private Sub txtPlace_GotFocus()
    ShowStatus ("最多二十位的单位名称")
End Sub

Private Sub txtPlace_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        txtTelephone.SetFocus
    End If
End Sub

Private Sub txtPlace_Validate(Cancel As Boolean)
txtPlace = Trim(txtPlace)
If txtPlace.Text = "" Then txtPlace.Text = "无"
End Sub

Private Sub txtTelephone_GotFocus()
    ShowStatus ("最多十四位的电话号码")
End Sub

Private Sub txtTelephone_Validate(Cancel As Boolean)
txtTelephone = Trim(txtTelephone)
If txtTelephone.Text = "" Then txtTelephone.Text = "无"
End Sub