showalterinfo.bas

金算盘软件代码

    Dim recBalance As rdoResultset
    
    BeenInputWork = True
    
    strQFixedMax = "SELECT FixedBalance.lngFixedCardID, " _
        & "MAX(FixedBalance.intYear*100+FixedBalance.bytPeriod) AS MaxPeriod " _
        & "FROM FixedBalance,FixedCard,FixedAlter " _
        & "WHERE FixedCard.lngRecentFixedAlterID=FixedAlter.lngFixedAlterID " _
        & "AND FixedBalance.lngFixedCardID=FixedCard.lngFixedCardID " _
        & "AND FixedBalance.intYear * 100 + FixedBalance.bytPeriod <= " & CLng(intYear) * 100 + bytPeriod _
        & " And (FixedBalance.dblDeprection<>0 OR (FixedBalance.dblWork<>0 AND FixedBalance.intYear=" & intYear & " AND FixedBalance.bytPeriod=" & bytPeriod & ") OR FixedAlter.intYear*100+FixedAlter.bytPeriod>=" _
        & "FixedBalance.intYear * 100 + FixedBalance.bytPeriod) " _
        & "GROUP BY FixedBalance.lngFixedCardID"
    
    strSql = "SELECT FixedCard.lngFixedCardID,FixedAlter.dblTotalWork,FixedBalance.dblInitAccumaWork" _
        & "+FixedBalance.dblWork As dblAccumaWork,DECODE(DECODE(FixedBalance.intYear," & intYear & ",1,0)+DECODE(FixedBalance.bytPeriod," & bytPeriod & ",1,0),2," _
        & "FixedBalance.dblWork,0) As dblWork " _
        & "FROM FixedCard,FixedAlter,FixedBalance,(" & strQFixedMax & ") QFixedMax " _
        & "WHERE FixedCard.lngFixedCardID=QFixedMax.lngFixedCardID AND " _
        & "FixedCard.lngRecentFixedAlterID=FixedAlter.lngFixedAlterID AND " _
        & "QFixedMax.lngFixedCardID=FixedBalance.lngFixedCardID AND  " _
        & "QFixedMax.MaxPeriod=FixedBalance.intYear*100+FixedBalance.bytPeriod " _
        & "AND FixedAlter.bytAlterType<>2 AND (FixedAlter.strFixedState='1' OR FixedAlter.strFixedState='4') " _
        & "AND FixedAlter.strDepreciationMethod='3' AND FixedAlter.blnIsVoid=0 AND FixedBalance.dblInitAmount>0 " _
        & "AND FixedBalance.dblWork=0 AND FixedBalance.dblWork+FixedBalance.dblInitAccumaWork<FixedAlter.dblTotalWork"
    Set recBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recBalance.EOF Then
        BeenInputWork = False
    Else
        strQFixedMax = "SELECT FixedBalance.lngFixedCardID,MIN(FixedAlter.dblTotalWork-(FixedBalance.dblInitAccumaWork+FixedBalance.dblWork)) As dblWork, " _
            & "MAX(FixedBalance.intYear*100+FixedBalance.bytPeriod) AS MaxPeriod " _
            & "FROM FixedBalance,FixedCard,FixedAlter " _
            & "WHERE FixedCard.lngRecentFixedAlterID=FixedAlter.lngFixedAlterID " _
            & "AND FixedBalance.lngFixedCardID=FixedCard.lngFixedCardID " _
            & "AND FixedBalance.intYear * 100 + FixedBalance.bytPeriod <= " & CLng(intYear) * 100 + bytPeriod _
            & " And (FixedBalance.dblDeprection<>0 Or FixedBalance.dblDebitAmount<>0 " _
            & "OR FixedBalance.dblCreditAmount<>0 Or FixedBalance.dblAlterDeprection<>0 OR FixedBalance.dblWork>0) " _
            & "AND FixedAlter.strDepreciationMethod='3' AND FixedAlter.strFixedState<>'2' AND FixedAlter.strFixedState<>'3' " _
            & "GROUP BY FixedBalance.lngFixedCardID HAVING MIN(FixedAlter.dblTotalWork-(FixedBalance.dblInitAccumaWork+FixedBalance.dblWork))>0 ORDER BY 2"
        Set recBalance = gclsBase.BaseDB.OpenResultset(strQFixedMax, rdOpenStatic)
        If recBalance.EOF Then
            BeenInputWork = True
        ElseIf IsNumeric(recBalance!MaxPeriod) Then
            If recBalance!MaxPeriod = CLng(intYear) * 100 + bytPeriod Then
                BeenInputWork = True
            Else
                BeenInputWork = False
            End If
        Else
            BeenInputWork = True
        End If
    End If
    recBalance.Close
    Set recBalance = Nothing
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 更新指定月份以后的变动记录
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub UpdateMonthFixedAlter(ByVal intYear As Integer, ByVal intPeriod As Integer, Optional blnUpdateBalance As Boolean = True)
    Dim strSql As String
'    Dim recFixedBalance As rdoresultset
    Dim recFixedAlter As rdoResultset
'    strSql = "SELECT * FROM FixedBalance WHERE intYear=" & intYear & " AND bytPeriod=" & intPeriod
'    Set recFixedBalance = gclsBase.BaseDB.OpenResultset(strsql, rdOpenstatic)
'    Do While Not recFixedBalance.EOF
'        strSql = "SELECT lngFixedCardID,lngFixedAlterID,lngLastFixedAlterID FROM FixedAlter WHERE lngFixedCardID=" & recFixedBalance!lngFixedCardID _
'            & " AND Format(strDate,'yyyy-mm-dd')>='" & intYear & "-" & Format(intPeriod, "00") & "-01'" _
'            & " ORDER BY strDate"
'        Set recFixedAlter = gclsBase.BaseDB.OpenResultset(strsql, rdOpenstatic)
'        UpdateAfterFixedBalance recFixedBalance!lngFixedCardID, intYear, intPeriod
'        If Not recFixedAlter.EOF Then
'            UpdateAfterFixedAlter recFixedAlter!lngFixedAlterID, blnUpdateBalance
'        End If
'        recFixedAlter.Close
'        recFixedBalance.MoveNext
'    Loop
'    recFixedBalance.Close
    Dim recFixedCard As rdoResultset
    strSql = "SELECT lngFixedCardID,lngRecentFixedAlterID FROM FixedCard "
    Set recFixedCard = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Do While Not recFixedCard.EOF
        strSql = "SELECT lngFixedCardID,lngFixedAlterID,lngLastFixedAlterID FROM FixedAlter WHERE FixedAlter.lngFixedAlterID = (SELECT  " _
            & "Min(lngFixedAlterID) FROM FixedAlter WHERE lngFixedCardID=" & recFixedCard!lngFixedCardID _
            & " AND intYear*100+bytPeriod<=" & CLng(intYear) * 100 + intPeriod _
            & " AND TO_DATE(strDate,'YYYY-MM-DD')>=TO_DATE('" & Format(gclsBase.BeginDate, "yyyy-mm-dd") _
            & "','YYYY-MM-DD'))"
        Set recFixedAlter = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        UpdateAfterFixedBalance recFixedCard!lngFixedCardID, intYear, intPeriod
        If Not recFixedAlter.EOF Then
            UpdateAfterFixedAlter recFixedAlter!lngFixedAlterID, blnUpdateBalance
        End If
        recFixedAlter.Close
        recFixedCard.MoveNext
    Loop
    recFixedCard.Close
    Set recFixedCard = Nothing
End Sub

Public Sub UpdateAfterFixedBalance(ByVal lngFixedCardID As Long, ByVal intYear As Integer, ByVal intPeriod As Integer)
    Dim strSql As String
    Dim recAlter As rdoResultset
    Dim recFixedBalance As rdoResultset
    Dim dblInitAmount As Double
    Dim dblInitDeprection As Double
    Dim dblInitAccumaWork As Double
    Dim dblCalcAmount As Double
    Dim intCalcPeriod As Integer
    Dim intCalcUseAge As Integer
    Dim dblCalcDeprection As Double
    
    strSql = "SELECT * FROM FixedBalance WHERE lngFixedCardID=" & lngFixedCardID _
        & " AND intYear*100+bytPeriod<=" & CLng(intYear) * 100 + intPeriod _
        & " ORDER BY intYear DESC,bytPeriod DESC"
    Set recFixedBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recFixedBalance.EOF Then
        recFixedBalance.MoveNext
        If recFixedBalance.EOF Then
            recFixedBalance.MoveFirst
            With recFixedBalance
                dblInitAmount = !dblInitAmount
                dblInitDeprection = !dblInitDeprection
                dblInitAccumaWork = !dblInitAccumaWork
                dblCalcAmount = !dblCalcAmount
                intCalcPeriod = !intCalcPeriod
                intCalcUseAge = !intCalcUseAge
                dblCalcDeprection = !dblCalcDeprection
            End With
        Else
            With recFixedBalance
                dblInitAmount = !dblInitAmount + !dblDebitAmount - !dblCreditAmount
                dblInitDeprection = !dblInitDeprection + !dblDeprection + !dblAlterDeprection
                dblInitAccumaWork = !dblInitAccumaWork + !dblWork
'                dblCalcAmount = !dblCalcAmount
'                intCalcPeriod = !intCalcPeriod + !intPeriod
'                intCalcUseAge = !intCalcUseAge
'                dblCalcDeprection = !dblCalcDeprection + !dblDeprection
            End With
        End If
        strSql = "SELECT * FROM FixedBalance WHERE lngFixedCardID=" & lngFixedCardID _
            & " AND intYear*100+bytPeriod>=" & CLng(intYear) * 100 + intPeriod _
            & " ORDER BY intYear ,bytPeriod "
        Set recFixedBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
        With recFixedBalance
            Do While Not .EOF
                If (!dblDebitAmount = 0 And !dblCreditAmount = 0 And !dblAlterDeprection = 0 And _
                    !dblDeprection = 0 And !dblWork = 0 And !intPeriod = 0) And (IIf(!intYear = gclsBase.FYearOfDate(gclsBase.BeginDate) _
                    And !bytPeriod = gclsBase.PeriodOfDate(GetAccountBeginDate()), !dblInitAmount = 0, True)) Then
                    strSql = "SELECT lngFixedAlterID FROM FixedAlter WHERE intYear=" & !intYear _
                        & " AND bytPeriod=" & !bytPeriod & " AND lngFixedCardID=" & lngFixedCardID
                    Set recAlter = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If recAlter.EOF Then
                        .Delete
                    End If
                    recAlter.Close
                    Set recAlter = Nothing
                Else
                    .Edit
                    !dblInitAmount = dblInitAmount
                    !dblInitDeprection = dblInitDeprection
                    !dblInitAccumaWork = dblInitAccumaWork
'                    !dblCalcAmount = dblCalcAmount
'                    !intCalcPeriod = intCalcPeriod
'                    !intCalcUseAge = intCalcUseAge
'                    !dblCalcDeprection = dblCalcDeprection
                    .Update
                    dblInitAmount = !dblInitAmount + !dblDebitAmount - !dblCreditAmount
                    dblInitDeprection = !dblInitDeprection + !dblDeprection + !dblAlterDeprection
                    dblInitAccumaWork = !dblInitAccumaWork + !dblWork
                    dblCalcAmount = !dblCalcAmount
                    intCalcPeriod = !intCalcPeriod + !intPeriod
                    intCalcUseAge = !intCalcUseAge
                    dblCalcDeprection = !dblCalcDeprection + !dblDeprection
                End If
                .MoveNext
            Loop
        End With
    End If
    recFixedBalance.Close
    Set recFixedBalance = Nothing
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 根据当前变动记录更新以后的变动记录
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub UpdateAfterFixedAlter(ByVal lngFixedAlterID As Long, Optional blnUpdateBalance As Boolean = True)
    Dim strDate As String
    Dim intYear As Integer
    Dim intPeriod As Integer
    Dim strSql As String
    Dim recFixedBalance As rdoResultset
    Dim recFixedAlter As rdoResultset
    Dim lngFixedCardID As Long
    Dim lngLastFixedAlterID As Long
    Dim blnFirst As Boolean
    Dim recTmp As rdoResultset
    lngLastFixedAlterID = lngFixedAlterID
    
    strSql = "SELECT * FROM FixedAlter WHERE lngFixedAlterID=" & lngLastFixedAlterID
    Set recFixedAlter = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    If Not recFixedAlter.EOF Then
        lngFixedCardID = recFixedAlter!lngFixedCardID
        Do While lngLastFixedAlterID > 0
            If CDate(recFixedAlter!strDate) < CDate(gclsBase.BeginDate) Then
                intYear = gclsBase.FYearOfDate(CDate(gclsBase.BeginDate))
                intPeriod = gclsBase.PeriodOfDate(CDate(gclsBase.BeginDate))
            Else
                intYear = gclsBase.FYearOfDate(recFixedAlter!strDate)
                intPeriod = gclsBase.PeriodOfDate(recFixedAlter!strDate)
            End If
            If blnUpdateBalance Then
                UpdateFixedBalance lngLastFixedAlterID
            End If
            If recFixedAlter!lngLastFixedAlterID > 0 Then
                blnFirst = False
                If recFixedAlter!bytAlterType <> 2 Then
                    strSql = "SELECT * FROM FixedBalance WHERE lngFixedCardID=" & recFixedAlter!lngFixedCardID _
                        & " AND intYear=" & intYear & " AND bytPeriod=" & intPeriod
                    Set recFixedBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If Not recFixedBalance.EOF Then
                        With recFixedBalance
                            recFixedAlter.Edit
                            recFixedAlter!dblAmount = !dblInitAmount + !dblDebitAmount - !dblCreditAmount
                            recFixedAlter!dblDeprection = !dblInitDeprection + !dblDeprection + !dblAlterDeprection
                            recFixedAlter.Update
                        End With
                    End If
                    recFixedBalance.Close
                    Set recFixedBalance = Nothing
                End If
            Else
                strSql = "SELECT * FROM FixedAlter WHERE lngLastFixedAlterID=" & lngLastFixedAlterID
                Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
                If Not recTmp.EOF Then
                    blnFirst = (gclsBase.FYearOfDate(recTmp!strDate) <> intYear Or gclsBase.PeriodOfDate(recTmp!strDate) <> intPeriod)
                Else
                    blnFirst = True
                End If
                recTmp.Close
                Set recTmp = Nothing
                If blnFirst And CDate(recFixedAlter!strDate) > CDate(gclsBase.BeginDate) Then
                    strSql = "SELECT * FROM FixedBalance WHERE lngFixedCardID=" & recFixedAlter!lngFixedCardID _
                        & " AND intYear=" & intYear & " AND bytPeriod=" & intPeriod
                    Set recFixedBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If Not recFixedBalance.EOF Then
                        With recFixedBalance
                            recFixedAlter.Edit
                            recFixedAlter!dblDeprection = !dblInitDeprection + !dblDeprection + !dblAlterDeprection
                            recFixedAlter.Update
                        End With
                    End If
                    recFixedBalance.Close
                    Set recFixedBalance = Nothing
                End If
            End If
            strSql = "SELECT * FROM FixedAlter WHERE lngLastFixedAlterID=" & lngLastFixedAlterID
            Set recFixedAlter = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
            If Not recFixedAlter.EOF Then
                lngLastFixedAlterID = recFixedAlter!lngFixedAlterID
            Else
                strSql = "UPDATE FixedCard SET lngRecentFixedAlterID=" & lngLastFixedAlterID _