frmnoteprint.frm

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

    '设置关键控件属性
    Me.txtUID.MaxLength = gUIDLen
    Me.txtYear.MaxLength = 4
    Me.txtYear.Mask = "9999"
    
    
    '填充年月份
    Me.txtYear.Text = Trim(Str(Year(Date)))
    cboMonth.AddItem ("01")
    cboMonth.AddItem ("02")
    cboMonth.AddItem ("03")
    cboMonth.AddItem ("04")
    cboMonth.AddItem ("05")
    cboMonth.AddItem ("06")
    cboMonth.AddItem ("07")
    cboMonth.AddItem ("08")
    cboMonth.AddItem ("09")
    cboMonth.AddItem ("10")
    cboMonth.AddItem ("11")
    cboMonth.AddItem ("12")

    '初始化其它返回值
    strReturnYear = ""
    strReturnMonth = ""
    strReturnChargeTypeID = ""
    strReturnChargeTypeName = ""
    strReturnPID = ""
    strReturnQID = ""
    strReturnPName = ""
    strReturnQName = ""
    strReturnUID = ""
    
    '初始化记录集
    On Error GoTo errHandleOpen
    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 adoChargeTypeRS = New ADODB.Recordset
    Set adoChargeTypeRS.ActiveConnection = gConnect
    adoChargeTypeRS.CursorLocation = adUseClient
    adoChargeTypeRS.CursorType = adOpenForwardOnly
    adoChargeTypeRS.LockType = adLockOptimistic
    adoChargeTypeRS.Open "select ChargeTypeID,ChargeTypeName from ChargeType order by ChargeTypeID"
    
    Set adoWaterRateRS = New ADODB.Recordset
    Set adoWaterRateRS.ActiveConnection = gConnect
    adoWaterRateRS.CursorLocation = adUseClient
    adoWaterRateRS.CursorType = adOpenForwardOnly
    adoWaterRateRS.LockType = adLockOptimistic
    adoWaterRateRS.Open "select WaterRate.No,WaterRate.Ym,WaterRate.PID,WaterRate.QID,WaterRate.UID,WaterRate.UName,WaterRate.LinkAddr,WaterRate.UTypeID,WaterRate.ChargeTypeID,WaterRate.Price,WaterRate.PmWaterRead,WaterRate.CmWaterRead,WaterRate.WaterRevise,WaterRate.PmOwe,WaterRate.CmOwe,WaterRate.WaterRates,WaterRate.FineRule,WaterRate.Status,WaterRate.IID,WaterRate.CmWaterRead-WaterRate.PmWaterRead+WaterRate.WaterRevise as TmpWaterRevise from WaterRate where Ym='999999' and rtrim(WaterRate.IID)=''"    '这儿999999的含义是取空集
    On Error GoTo 0
    
    Me.cboP.ListField = "PName"
    Me.cboP.BoundColumn = "PID"
    Me.cboChargeType.ListField = "ChargeTypeName"
    Me.cboChargeType.BoundColumn = "ChargeTypeID"
    
    strCurJFYm = GetCurJFYm()
    If strCurJFYm = "" Then
        Call DisableInterface
        Warning "计费表空!!!"
        Exit Sub
    End If
    Me.txtYear.Text = Mid(strCurJFYm, 1, 4)
    Me.cboMonth.ListIndex = Val(Mid(strCurJFYm, 5, 2)) - 1
    
    Exit Sub
    
    '-------错误处理---------
errHandleOpen:
    Warning "记录集创建失败！" & Chr(13) & Err.Description
    Me.cmdCB.Enabled = False
    On Error GoTo 0
    Exit Sub

End Sub


Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    adoChargeTypeRS.Close
    adoPRS.Close
    adoQRS.Close
    adoWaterRateRS.Close
    Set adoChargeTypeRS = Nothing
    Set adoPRS = Nothing
    Set adoQRS = Nothing
    Set adoWaterRateRS = Nothing
    On Error GoTo 0
End Sub

Private Sub txtYear_GotFocus()
    Call AutoSelectText(txtYear)
End Sub

Private Sub txtYear_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub txtYear_LostFocus()
    If Trim(Me.txtYear.Text) = "" Then
        Warning "日期格式错！"
        Me.txtYear.SetFocus
    End If
    If Val(Me.txtYear.Text) < 1000 Or Val(Me.txtYear.Text) > 9999 Then
        Warning "日期格式输入错误!!!"
        Me.txtYear.SetFocus
        Exit Sub
    End If
    If Val(Me.txtYear.Text) > Year(Date) Then
        Warning "年份不能大于当前年份!!!"
        Me.txtYear.SetFocus
        Exit Sub
    End If
End Sub

Private Sub cmbMonth_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub FillChargeType()
    Set Me.cboChargeType.RowSource = adoChargeTypeRS
    Me.cboChargeType.Text = ""
End Sub

Private Sub ClearChargeType()
    Set Me.cboChargeType.RowSource = Nothing
    Me.cboChargeType.Text = ""
End Sub

Private Sub FillP()
    Set Me.cboP.RowSource = adoPRS
    Me.cboP.Text = ""
End Sub

Private Sub ClearP()
    Set Me.cboP.RowSource = Nothing
    Me.cboP.Text = ""
End Sub

Private Sub FillQ(ByVal strPID As String)
    On Error Resume Next
    adoQRS.Close
    On Error GoTo 0
    On Error GoTo errHandleOpen
    adoQRS.Open "select QID,QName from Qu where PID='" & Trim(strPID) & "'"
    On Error GoTo 0
    
    Set Me.cboQ.RowSource = adoQRS
    Me.cboQ.ListField = "QName"
    Me.cboQ.BoundColumn = "QID"
    Me.cboQ.Text = ""
    Exit Sub
    
    '-------错误处理---------
errHandleOpen:
    Warning "记录集打开失败！" & Chr(13) & Err.Description
    On Error GoTo 0
    Exit Sub
    
End Sub

Private Sub ClearQ()
    Set Me.cboQ.RowSource = Nothing
    Me.cboQ.Text = ""
End Sub

Private Sub chkPQ_Click(Index As Integer)
    Select Case Index
    Case 0      '片
        If Me.chkPQ(0).value = 0 Then
            Call ClearP
            Me.cboP.Enabled = False
            Me.chkPQ(1).value = 0
            Me.chkPQ(1).Enabled = False
        Else
            Call FillP
            Me.cboP.Enabled = True
            Me.chkPQ(1).Enabled = True
            Me.chkUser.value = 0
            Me.cboP.SetFocus
        End If
        
    Case 1      '区
        If Me.chkPQ(1).value = 0 Then
            Call ClearQ
            Me.cboQ.Enabled = False
        Else
            Call FillQ(Me.cboP.BoundText)
            Me.cboQ.Enabled = True
        End If
    End Select
End Sub

Private Sub chkUser_Click()
    If Me.chkUser.value = 0 Then
        Me.txtUID.Text = ""
        Me.txtUName.Text = ""
        Me.txtUID.Enabled = False
    Else
        Me.chkChargeType.value = 0
        chkPQ(0).value = 0
        Me.txtUID.Enabled = True
        Me.txtUID.SetFocus
    End If
End Sub

Private Function GetCurJFYm() As String
'得到当前所处的水费计费年月
'注意:这儿的GetCurJFYm()和计费/通知单模块中的GetCurJFYm()同名,但查询标准稍有不同,这儿取计费表中存在的
'最大计费月份作为返回值,而上述两个模块则是取最大计费月份的下个月作为返回值
    Dim strSQL As String
    Dim adoTmpRS As ADODB.Recordset
    
    strSQL = "select max(Ym) from WaterRate"
    On Error GoTo errHandleExe
    Set adoTmpRS = gConnect.Execute(strSQL)
    On Error GoTo 0
    If IsNull(adoTmpRS.Fields(0)) Then
        '如果计费表为空，则表示没有可供打印的计费数据
        GetCurJFYm = ""
    Else
        '如果计费表不为空,则表中最大的计费年月就是当前待打印的计费年月
        GetCurJFYm = adoTmpRS.Fields(0).value
    End If
    
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
    
    Exit Function
    '-------错误处理---------
errHandleExe:
    On Error GoTo 0
    GetCurJFYm = ""
End Function

Private Sub DisableInterface()
    Me.txtYear.Enabled = False
    Me.cboMonth.Enabled = False
    Me.chkChargeType.value = 2
    Me.chkPQ(0).value = 2
    Me.chkPQ(1).value = 2
    Me.chkUser.value = 2
    Me.cboChargeType.Enabled = False
    Me.cboP.Enabled = False
    Me.cboQ.Enabled = False
    Me.txtUID.Enabled = False
    Me.cmdCB.Enabled = False
End Sub

Private Sub PlanBeging(ByVal lngMax As Long, ByVal lngMin As Long)
    Me.Enabled = False
    frmNotePrint_Wait.pgbPlan.Max = lngMax
    frmNotePrint_Wait.pgbPlan.Min = lngMin
    frmNotePrint_Wait.Show
End Sub
Private Sub PlanStep(ByVal strInfo As String, ByVal intValue As Integer)
    frmNotePrint_Wait.lblInfo.Caption = strInfo
    frmNotePrint_Wait.pgbPlan.value = intValue
    frmNotePrint_Wait.Refresh
End Sub
Private Sub PlanEnd()
    Unload frmNotePrint_Wait
    Me.Enabled = True
End Sub

Private Function UpdateTable() As Boolean
'打印某用户发票之前要先调用该函数
'1,发票表增加相应记录
'2,将计费表相应的记录IID字段置成对应发票记录的IID
    Dim strIID As String
    Dim strSQL As String
    
    '得到可用发票流水号
    strIID = GetMaxID()
    If strIID = "" Then
        UpdateTable = False
        Exit Function
    End If
    strSQL = "insert Invoice(IID,WaterRateYm,Ym,PID,QID,UID,UName,LinkAddr,UtypeID,ChargeTypeID,Price,PmWaterRead,CmWaterRead,WaterRevise,PmOwe,CmOwe,WaterRates,FineRule,ItypeID,CgID,Ctime,Status) " & _
             "values(" & _
                    "'" & strIID & "'," & _
                    "'" & adoWaterRateRS!Ym & "'," & _
                    "'" & strCurJFYm & "'," & _
                    "'" & adoWaterRateRS!PID & "'," & _
                    "'" & adoWaterRateRS!QID & "'," & _
                    "'" & adoWaterRateRS!Uid & "'," & _
                    "'" & adoWaterRateRS!UName & "'," & _
                    "'" & adoWaterRateRS!LinkAddr & "'," & _
                    "'" & adoWaterRateRS!UtypeID & "'," & _
                    "'" & adoWaterRateRS!ChargeTypeID & "'," & _
                    "'" & adoWaterRateRS!Price & "'," & _
                    "'" & adoWaterRateRS!PmWaterRead & "'," & _
                    "'" & adoWaterRateRS!CmWaterRead & "'," & _
                    "'" & adoWaterRateRS!WaterRevise & "'," & _
                    "'" & adoWaterRateRS!PmOwe & "'," & _
                    "'" & adoWaterRateRS!CmOwe & "'," & _
                    "'" & adoWaterRateRS!WaterRates & "'," & _
                    "'" & adoWaterRateRS!FineRule & "'," & _
                    "'" & Trim(Str(TogetherPrint)) & "'," & _
                    "'" & gstrCurOperatorID & "'," & _
                    "'" & Now & "'," & _
                    "'1'" & _
                   ")"
    
    gConnect.BeginTrans
    On Error GoTo errHandleExe
        '1,发票表增加相应记录
        gConnect.Execute strSQL
        '2,将计费表相应的记录IID字段置成对应发票记录的IID
        adoWaterRateRS!IID = Trim(strIID)
        adoWaterRateRS.Update
    On Error GoTo 0
    gConnect.CommitTrans
    UpdateTable = True

    Exit Function
errHandleExe:
    gConnect.RollbackTrans
    Warning "发票记录保存失败！" & Chr(13) & Err.Description
    UpdateTable = False
    On Error GoTo 0
End Function

Private Function GetMaxID() As String
'在发票表中得到最大的流水号
    Dim strSQL As String
    Dim adoTmpRS As ADODB.Recordset
    Dim strIID As String
    
    strSQL = "select max(IID) from Invoice where IID<>'" & String(gIIDLen, "9") & "'"   '注意：IID=99999999是银行导入发票标志
    On Error GoTo errHandleExe
    Set adoTmpRS = gConnect.Execute(strSQL)
    On Error GoTo 0
    
    If IsNull(adoTmpRS.Fields(0)) Then
        strIID = String(gIIDLen, "0")
    Else
        strIID = Trim(adoTmpRS.Fields(0).value)
        If strIID = "" Then strIID = String(gIIDLen, "0")
    End If
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
    
    strIID = Trim(Str(Val(strIID) + 1))
    strIID = String(gIIDLen - Len(strIID), "0") & strIID
    GetMaxID = strIID
    
    Exit Function
errHandleExe:
    Warning "得到发票流水号失败！" & Chr(13) & Err.Description
    GetMaxID = ""
    On Error GoTo 0
End Function

Private Sub cboChargeType_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub cboMonth_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub cboP_LostFocus()
    If Trim(Me.cboP.Text) = "" Then
        Exit Sub
    End If
    If Me.chkPQ(1).value = 1 Then
        Call FillQ(Me.cboP.BoundText)
    End If
End Sub

Private Sub cboQ_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub cboSQ_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

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

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

Private Sub cboP_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub cboP_Change()
    Me.cboQ.Text = ""
End Sub

Private Sub txtUID_LostFocus()
    Dim strSQL As String
    Dim adoTmpRS As ADODB.Recordset
    
    If Trim(Me.txtUID.Text) = "" Then
        Me.txtUName.Text = ""
        Exit Sub
    End If
        
    Me.txtUID.Text = String(gUIDLen - Len(Trim(Me.txtUID.Text)), "0") & Trim(Me.txtUID.Text)
    
    strSQL = "select UID,UName from UserRecord where UID='" & Trim(Me.txtUID.Text) & "' and Status='1'"     '从正常用户中查找
    On Error GoTo errHandleExe
    Set adoTmpRS = gConnect.Execute(strSQL)
    On Error GoTo 0
    If adoTmpRS.EOF And adoTmpRS.BOF Then
        Me.txtUName.Text = ""
        Warning "用户号无效！！！"
        Me.txtUID.SetFocus
    Else
        Me.txtUName.Text = Trim(adoTmpRS.Fields("UName"))
    End If
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
    Exit Sub
    
    '-------错误处理---------
errHandleExe:
    On Error GoTo 0
    Me.txtUID.Text = ""
    Me.txtUName.Text = ""
    Warning "用户查找失败！" & Chr(13) & Err.Description
    On Error Resume Next
    adoTmpRS.Close
    Set adoTmpRS = Nothing
    On Error GoTo 0
End Sub