age.cls

金算盘软件代码

            Else
                strField1 = strField1 & strTemp1
            End If
           
            If ColIsChoosed(intI) Then
                If ColType(intI) = 1 Then
                    ColGrouped(intI) = True                                         '分组
                Else
                    ColGrouped(intI) = False
                End If
            End If
            If (ColOrderType(intI) <> 0) And (ColIsChoosed(intI)) Then              '排序字段
    
                If mstrOrderBy = "" Then                                '用别名组织排序子句
                    mstrOrderBy = " ORDER BY " & IIf(colDesc(intI) = "帐龄天数", strS1, ColName(intI))
                Else
                    mstrOrderBy = mstrOrderBy & " , " & IIf(colDesc(intI) = "帐龄天数", strS1, ColName(intI))
                End If
                If ColOrderType(intI) = 2 Then
                    mstrOrderBy = mstrOrderBy & " DESC "
                End If
            End If
        End If
    Next intI
    For intI = 0 To ColNumber - 1                                   '注：用别名
'        strTemp1 = IIf(ColIsChoosed(intI), IIf(colDesc(intI) = "帐龄天数", "Decode(sign(" & strZLTSField & "-0),1,TO_NUMBER(" & strS1 & "),0)", ColName(intI)) & " AS " & """" & colDesc(intI) & """", "")
        If mblnIsHeadCol(intI) Then
            strTemp1 = IIf(ColIsChoosed(intI), IIf(colDesc(intI) = "帐龄天数", "TO_NUMBER(" & strS1 & ")", ColName(intI)) & " AS " & """" & colDesc(intI) & """", "")
             
            If ColIsChoosed(intI) And colDesc(intI) = "应收帐龄天数" And (AgeViewID = 610 Or AgeViewID = 1005) Then
                mHaveChooseZLTS = True
            End If
            
            If strField1 <> "" And strTemp1 <> "" Then
                strField1 = strField1 & "," & strTemp1
            Else
                strField1 = strField1 & strTemp1
            End If
'
'            If ColIsChoosed(intI) Then
'                If ColType(intI) = 1 Then
'                    ColGrouped(intI) = True                                         '分组
'                Else
'                    ColGrouped(intI) = False
'                End If
'            End If
'            If (ColOrderType(intI) <> 0) And (ColIsChoosed(intI)) Then              '排序字段
'
'                If mstrOrderBy = "" Then                                '用别名组织排序子句
'                    mstrOrderBy = " ORDER BY " & IIf(colDesc(intI) = "帐龄天数", strS1, ColName(intI))
'                Else
'                    mstrOrderBy = mstrOrderBy & " , " & IIf(colDesc(intI) = "帐龄天数", strS1, ColName(intI))
'                End If
'                If ColOrderType(intI) = 2 Then
'                    mstrOrderBy = mstrOrderBy & " DESC "
'                End If
'            End If
        End If
    Next intI
    
    '区间字段
    
    strTemp1 = ""
    strAgePeriod1 = ""
    
'*************      金额计算公式（按“应收”+“应付”分析时）        ***************************
'
'
'查询结果 = IIF( 区间条件，应收 - 应付 ，0 )
'
'************************************************************************************************
    If Not IsGrouped Then                                      '按明细数据分析
        strTemp = "("
        strTemp2 = ")"
    Else
        strTemp = "(Sum("                                '按汇总数据分析
        strTemp2 = "))"
    End If
        
    strAmount1 = Me.Currencys
    If IsGrouped Then           '增加百分比字段（不是真实数据）
        strPercent = ",sum(dblRate) AS "
    Else
        strPercent = ",dblRate AS "
    End If
    
    For intI = 0 To PeriodNumber - 1
        strTemp1 = ""
        strTemp3 = ""

        If intI <> PeriodNumber - 1 Then
            strTemp1 = "DECODE(SIGN(" & strS1 & "-(" & str(PeriodDay(intI)) & ")),-1,0,(DECODE(SIGN(" & strS1 & "-(" & str(PeriodDay(intI + 1)) & _
                    ")),-1," & strAmount1 & ",0)))"
        Else
            strTemp1 = "DECODE(SIGN(" & strS1 & "-(" & str(PeriodDay(intI)) & ")),-1,0," & strAmount1 & ")"
        End If
        
        If strAgePeriod1 <> "" Or strField1 <> "" Then
            strAgePeriod1 = strAgePeriod1 & "," & strTemp & strTemp1 & strTemp2       '& " AS [" & PeriodName(inti) & "]"
        Else
            strAgePeriod1 = strTemp & strTemp1 & strTemp2
        End If
        If IsGrouped Then
            strAgePeriod1 = strAgePeriod1 & strPercent & """" & "%" & String(intI, "%") & """"
        End If
    Next intI
    
    If IsGrouped Then          ' 合计字段（不是真实数据）
        strSum = ",abs(sum(dblCurrPaymentAmount)) as " & """合计"""
    Else
        strSum = ",abs(dblCurrPaymentAmount) AS " & """合计"""
    End If
    
    strAgePeriod1 = strAgePeriod1 & strSum
    
'    mstrSelect1 = "SELECT " & strField1 & strAgePeriod1
        '**********************
    '计算帐龄天数的期间条件
     '是否已选应收帐龄天数,仅当应收帐龄汇总表
    If mHaveChooseZLTS Then
        GetYearMonth
        strAmount1 = Me.Currencys
        Select Case AgeViewID
            Case 610
                strS1 = "ARRQuery." & mvarAgeStartDate
                strAmount1 = "Decode(ARRQuery.blnIsDebit,1," & strAmount1 & ",0)"
            Case Else
                strS1 = "ARRQuery2." & mvarAgeStartDate
                strAmount1 = "Decode(ARRQuery2.blnIsDebit,1," & strAmount1 & ",0)"
        End Select
        strAgeYearMonth = ""
        For intI = 0 To mvarYearMonthNumber - 1
            strTemp1 = ""
            strTemp3 = ""
    
            If intI <> mvarYearMonthNumber - 1 Then
                strTemp1 = "SUM(Decode(Sign(To_Date(" & strS1 & ",'yyyy-mm-dd')-To_Date('" & mvarYearMonth(intI) & "','yyyy-mm-dd')),-1,0,1)* Decode(Sign(To_Date( " & strS1 & ",'yyyy-mm-dd')-To_Date('" & mvarYearMonth(intI + 1) & "','yyyy-mm-dd')),-1,1,0)*" & _
                          strAmount1 & ")"
            Else
                strTemp1 = "SUM(Decode(Sign(To_Date(" & strS1 & ",'yyyy-mm-dd')-To_Date('" & mvarYearMonth(intI) & "','yyyy-mm-dd')),-1,0,1)* Decode(Sign(To_Date( " & strS1 & ",'yyyy-mm-dd')-To_Date('JZRQ','yyyy-mm-dd')),-1,1,0)*" & _
                          strAmount1 & ") "
            End If
            
            If strAgeYearMonth <> "" Or strTemp1 <> "" Then
                strAgeYearMonth = strAgeYearMonth & "," & strTemp1 & " as " & """" & mvarYearMonth(intI) & """"
            Else
                strAgeYearMonth = "," & strTemp1 & " as " & """" & mvarYearMonth(intI) & """"
            End If
        Next
    End If
    
    '
    If mHaveChooseZLTS Then
        mstrSelect1 = "SELECT " & strField1 & strAgePeriod1 & strAgeYearMonth
    Else
        mstrSelect1 = "SELECT " & strField1 & strAgePeriod1
    End If

    SetAgeSelect = True
    
End Function

'设置 FROM 子句
'根据视图ID读出 View 数据表中的 SQL
Private Function SetAgeSQLFrom(ByVal lngViewId As Long) As Boolean
    Dim strSelect, strWhere As String
    Dim rstRecord As rdoResultset
    Dim strTemp As String
    
    strSelect = "SELECT * FROM view1 "
    
    If AgeViewID <> 0 Then
        strWhere = " WHERE lngViewID = " & AgeViewID
    Else
        strWhere = " WHERE lngViewID = " & lngViewId
    End If
    
    Set rstRecord = gclsBase.BaseDB.OpenResultset(strSelect & strWhere, rdOpenDynamic, 4)
    
    If rstRecord.EOF Then
        SetAgeSQLFrom = False
        Exit Function
    End If
    
    With rstRecord
        If Not .EOF Then
            .MoveLast
            .MoveFirst
            strTemp = !strViewSQL
            mstrWhereJoin = !StrViewWhere
        End If
        .Close
    End With
    mstrFrom1 = "FROM " & strTemp     '在 View 中，FROM 子句用“，”分隔为 3 个
    SetAgeSQLFrom = True
    mstrWhere1 = " where " & mstrWhereJoin & mstrWhere1
End Function

'设置汇总栏目，即 GROUP BY 子句
Private Function SetGroups() As Boolean
    Dim intI As Integer
    Dim strTemp As String
    Dim strStr1, strStr2, strStr3 As String
    
    strTemp = "GROUP BY "
    strStr1 = ""
    For intI = 0 To ColNumber - 1
        If IsGrouped Then
            If (ColType(intI) = 5 Or ColType(intI) = 1) And ColIsChoosed(intI) Then
                If ColOrderType(intI) = 0 Then ColOrderType(intI) = 1       '汇总字段必须排序
                
                If strStr1 = "" Then
                    strStr1 = ColName(intI) ' "[" & ColDesc(intI) & "]"
                Else
                    strStr1 = strStr1 & "," & ColName(intI) ' ColDesc(intI) & "]"
                End If
                
            Else
'                ColIsChoosed(intI) = False
            '************
'                If AgeViewID <> 610 And AgeViewID <> 1005 Then
'                    ColIsChoosed(intI) = False
'                End If
            '************
            End If
        End If
        
    Next intI
    
    mstrGroupBy1 = IIf(Len(strStr1) < 2, "", strTemp & strStr1)
    
    SetGroups = True
    
End Function

'存贮帐龄区间
Private Function SaveAgePeriod() As Boolean
    Dim strStr As String
    Dim rstRecord As rdoResultset
    Dim intI As Integer
    
    strStr = "DELETE  FROM AgePeriod  WHERE lngReportID = " & AgeReportID
    gclsBase.BaseDB.Execute (strStr)
    
    strStr = "SELECT * FROM AgePeriod"
    Set rstRecord = gclsBase.BaseDB.OpenResultset(strStr, rdOpenDynamic, rdConcurRowVer)
    
    With rstRecord
        For intI = 1 To PeriodNumber - 1
            .AddNew
            !LNGAGEPERIODID = GetNewID("AgePeriod")
            !strAgePeriodName = Trim(PeriodName(intI))  '区间描述
            !intDay = PeriodDay(intI)                   '天数
            !lngReportID = AgeReportID
            .Update
        Next intI
        .Close
    End With
    
    SaveAgePeriod = True
    
End Function

'释放类
Private Sub Class_Terminate()

    Erase mvarColDesc()         '栏目字段描述
    Erase mvarColTable()        '栏目字段所在表名
    Erase mvarColName()         '栏目字段名称
    Erase mvarColType()         '栏目字段类型
    Erase mvarColIsChoosed()    '栏目选择标志
    Erase mvarColWidth()        '栏目显示宽度
    Erase mvarColVersionType()  '栏目版本号
    Erase mvarColOrderType()    '栏目排序方式
    Erase mvarColIsFixed()      '是否固定栏目
    Erase mvarColFieldID()      '栏目ID
    Erase mvarColFieldSize()    '栏目字段宽度
    Erase mvarColGrouped()


    Erase mvarPeriodName()      '帐龄区间名称
    Erase mvarPeriodDay()       '帐龄区间天数
    
End Sub

'仅修改了日期条件，在报表显示窗体直接调用
Public Function GetReportSQL(Optional ByVal blnDate As Boolean = True) As Boolean
    Dim strSql1 As String
    
    If AgeReportID = 0 Then
        GetReportSQL = False
        Exit Function
    End If
    
    mblnOnlyDateChanged = blnDate
    
    GetAgeConditions AgeReportID, AgeViewID
    
    If SetGroups And SetAgeSelect And SetAgeSQLFrom(AgeViewID) Then     'And SetConditions(AgeViewID)
        strSql1 = mstrSelect1 & " " & mstrFrom1 & " " & mstrWhere1 & " " & mstrGroupBy1 & " " & mstrOrderBy
        SQLString = strSql1

    End If
    
    If UCase(AgeStartDate) = UCase("strReceiptDate") Then
        AgeDateDesc = "开票日"
    ElseIf UCase(AgeStartDate) = UCase("strDueDate") Then
        AgeDateDesc = "到期日"
    End If
    
    If blnDate Then
        SaveReport
    End If
        
    GetReportSQL = True
End Function

'取表头表尾栏目
Private Sub GetHeadTail(ByVal lngID As Long)
    Dim intCount As Integer
    Dim rstReport As rdoResultset
    '取表头栏目
    Set rstReport = gclsBase.BaseDB.OpenResultset("SELECT * FROM ReportHeadTail WHERE lngReportID=" _
                    & lngID & " AND bytFieldType=1 ORDER BY intFieldNO ", rdOpenDynamic)
    With rstReport
       If Not .EOF Then
         .MoveLast
         .MoveFirst
         HeadColumns = .RowCount
         For intCount = 0 To mvarHeadColumns - 1
           mvarHeadDesc(intCount) = !strFieldDesc
           mvarHeadFuncIndex(intCount) = !intFuncIndex
           mvarHeadWidth(intCount) = !lngFieldWidth
           mvarHeadHeight(intCount) = !lngFieldHeight
           mvarHeadLeft(intCount) = !lngFieldLeft
           mvarHeadTop(intCount) = !lngFieldTop
           mvarHeadAlign(intCount) = IIf(IsNull(!intAlign), 9, !intAlign)
           .MoveNext
         Next
      End If
   End With
   '取表尾栏目
   Set rstReport = gclsBase.BaseDB.OpenResultset("SELECT * FROM ReportHeadTail WHERE lngReportID=" _
                    & lngID & " AND bytFieldType=2 ORDER BY intFieldNO ", rdOpenDynamic)
    With rstReport
       If Not .EOF Then
         .MoveLast
         .MoveFirst
         TailColumns = .RowCount
         For intCount = 0 To mvarTailColumns - 1
           mvarTailDesc(intCount) = !strFieldDesc
           mvarTailFuncIndex(intCount) = !intFuncIndex
           mvarTailWidth(intCount) = !lngFieldWidth
           mvarTailHeight(intCount) = !lngFieldHeight
           mvarTailLeft(intCount) = !lngFieldLeft
           mvarTailTop(intCount) = !lngFieldTop
           mvarTailAlign(intCount) = IIf(IsNull(!intAlign), 9, !intAlign)
           .MoveNex