crossset.cls

金算盘软件代码

Public Function GetReportSet(ByVal lngReportID As Long) As Boolean
Dim rstView As rdoResultset
Dim strSql As String
Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
    strSql = "SELECT View1.* FROM  View1 WHERE View1.lngViewId=(Select Report.lngViewID From Report Where Report.lngReportID=" & lngReportID & ")"
    Set rstView = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    mvarFrom = " FROM " & rstView!strViewSQL
    mvarViewCond = rstView.rdoColumns("strViewWhere").GetChunk(2048)
    Set rstView = Nothing
    mvarReportID = lngReportID
    GetReport
    GetField
    GetReportSet = True
    Exit Function
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         GetReportSet = False
         Utility.ShowMsg frmMain.hWnd, "组织数据失败!", vbOKOnly + vbInformation, App.title
    End If
End Function

'得到Report表内容
Private Sub GetReport()
Dim rstReport As rdoResultset
Dim strSql As String
    strSql = "SELECT  *  FROM Report WHERE Report.lngReportID = " & mvarReportID
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rstReport.EOF Then
        Utility.ShowMsg frmMain.hWnd, "没有报表栏目!", vbOKOnly, App.title
        Exit Sub
    End If
    On Error Resume Next
    With rstReport
       .MoveNext
       .MoveFirst
       mvarOperatorID = !lngOperatorID
       mvarGroupNo = !bytGroup
       mvarViewID = !lngViewId
       mvarReportPrep = !bytPrep
       mvarLevel = !intLevel
       mvarParentID = !lngParentId
       mvarReportName = !strReportName
       mvarReportCond = Trim(!strExtraCond)
       mvarVersion = !bytVersion
       mvarPrintSetID = !lngPrintSetupID
       mvarBudgetID = !lngPageFieldID
       
       mvarIsRowSum = !blnIsRowTotal
       mvarIsColSum = !blnIsColTotal
       mvarRowTotalMethod = !bytRowTotalMethod
       mvarColTotalMethod = !bytColTotalMethod
       mvarTitleWidth = !intTitleWidth
       mvarTitleHeight = !intTitleHeight
       mvarTitleTop = !intTitleTop
       mvarTitleLeft = !intTitleLeft
       mvarTitleAlign = !intTitleAlign
       mvarGridTop = !intGridTop
       
       mvarCondShow = !bytCondShow
       mvarCondTop = !intCondTop
       mvarCondLeft = !intCondLeft
       mvarCondWidth = !intCondWidth
       mvarCondHeight = !intCondHeight
       mvarCondAlign = !intCondAlign
       mvarDefWidth = !lngCrossDefWidth
       
       If mvarTitleWidth = 0 Then
            mvarTitleWidth = StrLen(mvarReportName) * 90 + 30
            mvarTitleHeight = 400
       End If
       If mvarCondWidth = 0 Then
            mvarCondWidth = 8000
            mvarCondHeight = 330
       End If
       If mvarDefWidth = 0 Then
            mvarDefWidth = 1300
       End If
       
    End With
    Set rstReport = Nothing
 End Sub
'得到字段内容
Private Sub GetField()
    Dim intCount As Integer
    Dim intChoosed As Integer, intList As Integer
    Dim strSql As String
    Dim rstReport As rdoResultset
    Dim strCondVersion As String, strCondHospital As String
    On Error Resume Next
    #If conVersionType = 1 Then
        strCondVersion = " And MOD(ViewField.bytVersion,2)>0 "
    #Else
      #If conVersionType = 2 Then
        strCondVersion = " And MOD(ViewField.bytVersion,4)>1 "
      #Else
        #If conVersionType = 4 Then
           strCondVersion = " And MOD(ViewField.bytVersion,8)>3 "
        #Else
           #If vonversiontype = 8 Then
              strCondVersion = " And MOD(ViewField.bytVersion,16)>7 "
           #Else
              strCondVersion = " And MOD(ViewField.bytVersion,32)>15 "
           #End If
        #End If
      #End If
    #End If
    '对栏目
    Select Case gclsBase.AccountSys
    Case "3"      '会计制度 3:行政
        strCondHospital = " And ViewField.blnNotHospital=0 "
    Case Else
        strCondHospital = ""
    End Select
'    On Error Resume Next
    strSql = "SELECT   ReportField.*,ViewField.* FROM ReportField,ViewField " _
            & " WHERE ReportField.lngViewFieldID = ViewField.lngViewFieldID " _
            & strCondVersion & strCondHospital & " And ReportField.lngReportID =" & mvarReportID _
            & " ORDER BY ReportField.blnIsChoosed,ReportField.lngReportFieldNO,ReportField.intShowNO"
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rstReport.EOF Then
       Exit Sub
    End If
    With rstReport
        .MoveLast
        .MoveFirst
        Columns = .RowCount + 5
    End With
    strSql = "SELECT   ReportField.*,ViewField.* FROM ReportField,ViewField " _
            & " WHERE ((ReportField.lngViewFieldID>0 " & strCondVersion & strCondHospital & ") or strFomular<>' ') And " _
            & "  ReportField.lngViewFieldID = ViewField.lngViewFieldID(+) And ReportField.lngReportID =" & mvarReportID _
            & " ORDER BY ReportField.blnIsChoosed,ReportField.lngReportFieldNO,ReportField.intShowNO"
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
     With rstReport
      intChoosed = 0
      intList = 0
      intCount = 0
      Do While Not .EOF
            mvarColumnID(intCount) = !lngViewFieldID
            mvarColumnDesc(intCount) = !strReportFieldDesc
            mvarColumnWidth(intCount) = !lngDisplayWidth
            mvarColumnHeight(intCount) = !lngDisplayHeight
            mvarColumnLeft(intCount) = !lngDisplayLeft
            mvarColumnTop(intCount) = !lngdisplaytop
            mvarColumnAlign(intCount) = !intAlign
            mvarColumnStyle(intCount) = !bytReportFieldType
            mvarColumnChoosed(intCount) = !blnIsChoosed
            mvarColumnNO(intCount) = !lngReportFieldNO
            mvarCodeName(intCount) = !bytCodeShow
            mvarReportFieldID(intCount) = !lngReportFieldID
            
            mvarTableName(intCount) = IIf(IsNull(!strTableName), "", !strTableName)
            mvarFieldName(intCount) = IIf(IsNull(!strFieldName), "", !strFieldName)
            mvarFieldDesc(intCount) = IIf(IsNull(!strViewFieldDesc), "", !strViewFieldDesc)
            mvarFieldType(intCount) = IIf(IsNull(!strFieldType), "Double", !strFieldType)
            mvarFieldHead(intCount) = IIf(IsNull(!bytHead), 0, !bytHead)
            mvarColumnFormat(intCount) = IIf(IsNull(!bytFormat), 0, !bytFormat)
        
            If !blnIsChoosed Then
                intChoosed = intChoosed + 1
            End If
            If !bytReportFieldType = 6 And !bytHead = 2 Then
                intList = intList + 1
            End If
            .MoveNext
            intCount = intCount + 1
      Loop
    End With
    
    ChoosedColumns = intChoosed
    ListColumns = intList
    intChoosed = 0
    intList = 0
    For intCount = 0 To mvarColumns - 1
        If mvarColumnChoosed(intCount) = 1 Then
            mvarChoosedID(intChoosed) = mvarColumnID(intCount)
            mvarChoosedLoc(intChoosed) = intCount
            intChoosed = intChoosed + 1
        End If
        If mvarFieldHead(intCount) = 2 And mvarColumnStyle(intCount) = 6 Then
            mvarListID(intList) = mvarColumnID(intCount)
            mvarListLoc(intList) = intCount
            intList = intList + 1
        End If
    Next intCount
    
    '对行标题
     strSql = "SELECT   ReportField.*,ViewField.* FROM ReportField,ViewField " _
            & " WHERE ReportField.lngViewFieldID = ViewField.lngViewFieldID " _
            & " And ReportField.lngReportID =" & mvarReportID & " And ReportField.blnIsChoosed=1 " & strCondVersion _
            & " And ReportField.bytReportFieldType=3 ORDER BY ReportField.lngReportFieldNO "
     Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
     With rstReport
        .MoveLast
        .MoveFirst
        RowColumns = .RowCount
        intCount = 0
        Do While Not .EOF
            RowFieldID(intCount) = .rdoColumns("lngViewFieldID")
            .MoveNext
            intCount = intCount + 1
        Loop
    End With
    '对列标题
    strSql = "SELECT   ReportField.*,ViewField.* FROM ReportField,ViewField " _
            & " WHERE ReportField.lngViewFieldID = ViewField.lngViewFieldID " _
            & " And ReportField.lngReportID =" & mvarReportID & " And ReportField.blnIsChoosed=1 " & strCondVersion _
            & " And ReportField.bytReportFieldType=4 ORDER BY ReportField.lngReportFieldNO "
     Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
     With rstReport
        .MoveLast
        .MoveFirst
        ColColumns = .RowCount
        intCount = 0
        Do While Not .EOF
             colFieldID(intCount) = .rdoColumns("lngViewFieldID")
            .MoveNext
            intCount = intCount + 1
        Loop
    End With
    '对数据栏目
    strSql = "SELECT   ReportField.*,ViewField.* FROM ReportField,ViewField " _
            & " WHERE ReportField.lngViewFieldID = ViewField.lngViewFieldID " _
            & " And ReportField.lngReportID =" & mvarReportID & " And ReportField.blnIsChoosed=1 " & strCondVersion _
            & " And ReportField.bytReportFieldType=8 ORDER BY ReportField.lngReportFieldNO "
     Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rstReport
        .MoveLast
        .MoveFirst
        DataColumns = .RowCount
        intCount = 0
        Do While Not .EOF
            DataFieldID(intCount) = .rdoColumns("lngViewFieldID")
            .MoveNext
            intCount = intCount + 1
        Loop
    End With
    Set rstReport = Nothing
    On Error GoTo 0
End Sub


'行标题
Public Function GetSelect(strReturnSql As String, Optional ByVal strCond As String = "") As Boolean
Dim intCount As Integer, intLoc As Integer, intName As Integer
Dim strSql As String, strName As String, strColName As String
Dim arrSum() As Double, arrTax() As Double
Dim rstCol As rdoResultset
Dim strTemp As String
    
    On Error GoTo ErrHandle
    GetSelect = False
    intCount = 0
    mstrSelect = ""
    '行项目
    Do While intCount < RowColumns
       intLoc = mvarRowLoc(intCount)
       If mstrSelect = "" Then
            mstrSelect = mvarFieldName(intLoc) & " As """ & mvarColumnDesc(intLoc) & """"
       Else
            mstrSelect = mstrSelect & "," & mvarFieldName(intLoc) & " As """ & mvarColumnDesc(intLoc) & """"
       End If
       intCount = intCount + 1
    Loop
    '分解列项目
    strColName = mvarFieldName(mvarColLoc(0))
'    strTemp = strCond
    If strCond <> "" Then
        strTemp = " WHERE " & strCond
    Else
        strTemp = ""
    End If
    strName = mvarTableName(mvarColLoc(0))
    Select Case UCase(strName)
    Case "ACTIVITYTYPE1"
        strName = " ActivityType  ActivityType1"
    Case "ITEMACTIVITY1"
        strName = " ItemActivity  ItemActivity1"
    Case "Item1Type"
        strName = " ItemType  Item1Type"
    Case "ITEM1"
        strName = " Item  Item1"
    Case "AREA1"
        strName = " Area  Area1"
    Case "AREA2"
        strName = " Area  Area2"
    Case Else
    End Select
    If mvarViewID <> 1213 Then
        strSql = " SELECT Distinct RTrim(" & strColName & ") As ""CName""  From " & strName & strTemp & " ORDER BY RTrim(" & strColName & ")"
    Else    '地区销售交叉表
        strSql = " SELECT  " & strColName & " As ""CName"",Sum(RCustomerSale.dblSumAmount) As ""SumAmount"",Sum(RCustomerSale.dblTaxAmount) As ""TaxAmount"" " _
                & mstrFromBack & strCond & " Group BY " & strColName & " ORDER BY " & strColName
    End If
    Set rstCol = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rstCol
        If .EOF Then
            intName = 0
        Else
            .MoveLast
            .MoveFirst
            intName = .RowCount
            If intName * mvarDataColumns > 120 Then
                Utility.ShowMsg frmMain.hWnd, "列栏目太多，后面的栏目将丢掉!", vbInformation + vbOKOnly, App.title
                intName = 120 \ mvarDataColumns
            End If
            
            If mvarViewID <> 1213 Then
                ReDim marrCol(intName - 1)
                ReDim arrSum(intName - 1)
                ReDim arrTax(intName - 1)
                For intCount = 0 To intName - 1
                    marrCol(intCount) = IIf(IsNull(!CName), "", ![CName])
                    arrSum(intCount) = 1
                    arrTax(intCount) = 1
                    .MoveNext
                Next intCount
            Else
                ReDim marrCol(intName - 1)
                ReDim arrSum(intName - 1)
                ReDim arrTax(intName - 1)
                For intCount = 0 To intName - 1
                    marrCol(intCount) = IIf(IsNull(![CName]), "", ![CName])
                    arrSum(intCount) = IIf(IsNull(![SumAmount]), 0, ![SumAmount])
                    arrTax(intCount) = IIf(IsNull(![TaxAmount]), 0, ![TaxAmount])
                    If Abs(arrSum(intCount)) < 0.000001 Then arrSum(intCount) = 1E+18
                    If Abs(arrTax(intCount)) < 0.000001 Then arrTax(intCount) = 1E+18
                    .MoveNext
                Next intCount
            End If
        End If
    End With
    Set rstCol = Nothing
    '数据项目
    If intName > 0 Then
        For intName = 0 To UBound(marrCol)
            intCount = 0
            Do While intCount < DataColumns
                intLoc = mvarDataLoc(intCount)
                '''''''''''''''''''''''''''''''''''''''''''''
                ''重大修改
                strName = FormatFieldName(mvarFieldDesc(intLoc), strColName, marrCol(intName), mvarFieldName(intLoc), mvarColumnFormat(intLoc), arrSum(intName), arrTax(intName))
                '''''''''''''''''''''''''''''''''''''''''''''
                mstrSelect = mstrSelect & "," & strName & " As """ & CStr(intName) & "$" & mvarFieldDesc(intLoc) & """"
                intCount = intCount + 1
            Loop
        Next intName
    End If
    strReturnSql = " SELECT " & mstrSelect & Space(1) & mvarFrom
    GetSelect = True
ErrHandle:
    Set rstCol = Nothing
    Erase arrSum
    Erase arrTax
End Function


'分组子句
Public Function GetGroup() As String
Dim intCount As Integer
    intCount = 0
    mstrGroup = ""
    Do While intCount < RowColumns
       If mstrGroup = "" Then
            mstrGroup = mvarFieldName(mvarRowLoc(intCount))
       Else
            mstrGroup = mstrGroup & "," & mvarFieldName(mvarRowLoc(intCount))
       End If
       intCount = intCount + 1
    Loop
    GetGroup = " GROUP BY " & mstrGroup
End Function
'得到交叉表数据列的格式
Public Function GetFormat(ByVal intIndex As Integer) As String
Dim intLen As Integer
    Select Case mvarColumnFormat(intIndex)
    Case 5  '本币金额
        intLen = gclsBase.NaturalCurDec
    Case 2  '单价
        intLen = gclsBase.NaturalCurDec
    Case 7  '固定百分比
        intLen = 2
    Case Else
        intLen = 0
    End Select
    If intLen > 0 Then
        GetFormat = "##0." & String(intLen, "0")