reportset.cls

金算盘软件代码

       .MoveFirst
       
       Columns = .RowCount
       
       mvarFixColumns = 0
       mvarGridTop = !intGridTop
       mintDirect = !intDirection
       Select Case mvarViewID
           Case 2, 4, 360
              mintDirect = 1
           Case 359
              mintDirect = -1
       End Select
       For intCount = 1 To .RowCount
            mvarColumnDesc(intCount) = !strReportFieldDesc
            mbytFormat(intCount) = IIf(IsNull(!bytFormat), 0, !bytFormat)
            mbytFomular(intCount) = IIf(IsNull(!bytFormula), 0, !bytFormula)
            mvarColumnFieldName(intCount) = IIf(IsNull(!strFieldName), "", !strFieldName)
            
            lngWidth = !lngWidth

            mvarColumnWidth(intCount) = lngWidth
            
            mvarColumnOrderType(intCount) = !bytsort
            mvarColumnIsFix(intCount) = !blnIsFixed
            mvarColumnIsMust(intCount) = !blnIsMust
            If !blnIsFixed Then
                 mvarFixColumns = mvarFixColumns + 1
            End If
            mvarColumnIsFind(intCount) = !blnIsFind
            mvarColumnFieldID(intCount) = .rdoColumns("lngViewFieldID")
            mvarColumnFieldType(intCount) = !strFieldType
            mvarColumnFieldSize(intCount) = !bytFieldSize
            mvarColumnCombine(intCount) = Trim(IIf(IsNull(!strCombine), "", !strCombine))
            
            .MoveNext
       Next intCount
   End With
End Function

'取当前帐表设置
Public Function GetReportSet(ByVal lngReportID As Long, ByVal ReportViewID As Long) As String
   Dim rstChoosed As rdoResultset
   Dim strSql As String
   Dim strCond As String, strOrder As String, strCondVersion As String
   Dim intCount As Integer, lngWidth As Long
   Dim bytVersion As Byte
   
   strCondVersion = " And (Mod(ViewField.bytVersion," & gVersionType * 2 & ")>=" & gVersionType & ")"
   
   If mlngPaperID = 0 Then
        strSql = "Select * from ViewField,Report,ReportField Where ViewField.lngViewFieldID=ReportField.lngViewFieldID " & _
                 "And Report.lngReportID=ReportField.lngReportID And Report.lngReportID=" & lngReportID & _
                 " And ReportField.blnIsChoosed=1 " & strCondVersion
        strOrder = " Order By lngReportFieldNO"
        Set rstChoosed = gclsBase.BaseDB.OpenResultset(strSql & strOrder, rdOpenStatic)
        With rstChoosed
            If .EOF Then
               GetReportSet = ""
               Exit Function
            End If
            .MoveLast
            .MoveFirst
            
            If ViewId = 0 Then
                 ViewId = ReportViewID
                 ReportID = lngReportID
            End If
            Columns = .RowCount
            
            mvarFixColumns = 0
            mvarGridTop = !intGridTop
            mintDirect = !intDirection
            Select Case mvarViewID
                Case 2, 4, 360
                   mintDirect = 1
                Case 359
                   mintDirect = -1
            End Select
            For intCount = 1 To .RowCount
                 mvarColumnDesc(intCount) = !strReportFieldDesc
                 mbytFormat(intCount) = IIf(IsNull(!bytFormat), 0, !bytFormat)
                 mbytFomular(intCount) = IIf(IsNull(!bytFormula), 0, !bytFormula)
                 mvarColumnFieldName(intCount) = IIf(IsNull(!strFieldName), "", !strFieldName)
                 
                 If !lngDisplayWidth = 0 Or IsNull(!lngDisplayWidth) Then
                     lngWidth = Utility.GetDisplayWidth(!strViewFieldDesc, !bytFieldSize)
                 Else
                     lngWidth = !lngDisplayWidth
                 End If
                 mvarColumnWidth(intCount) = lngWidth
                 
                 mvarColumnOrderType(intCount) = !bytsort
                 mvarColumnIsFix(intCount) = !blnIsFixed
                 mvarColumnIsMust(intCount) = !blnIsMust
                 If !blnIsFixed Then
                      mvarFixColumns = mvarFixColumns + 1
                 End If
                 mvarColumnIsFind(intCount) = !blnIsFind
                 mvarColumnFieldID(intCount) = .rdoColumns("lngViewFieldID")
                 mvarColumnFieldType(intCount) = !strFieldType
                 mvarColumnFieldSize(intCount) = !bytFieldSize
                 mvarColumnCombine(intCount) = Trim(IIf(IsNull(!strCombine), "", !strCombine))
                 
                 .MoveNext
            Next intCount
        End With
   Else
        GetReportTdSet
   End If
   
   strSql = "Select bytCodeShow,intAlign,bytHead,lngDisplayTop,lngDisplayLeft,lngDisplayHeight,lngDisplayWidth," & _
            "intTitleTop,intTitleLeft,intTitleWidth,intTitleHeight," & _
            "ReportField.lngViewFieldID As ID,ViewField.strViewFieldDesc As Name " & _
            "From ViewField,Report,ReportField Where ViewField.lngViewFieldID=ReportField.lngViewFieldID " & _
            "And Report.lngReportID=ReportField.lngReportID And Report.lngReportID=" & lngReportID & _
            " And ReportField.blnIsHeaded=1 " & strCondVersion
   strOrder = " Order By lngReportFieldNO"
   Set rstChoosed = gclsBase.BaseDB.OpenResultset(strSql & strOrder, rdOpenStatic)
   With rstChoosed
        If Not .EOF Then
             .MoveLast
             .MoveFirst
             HeadFields = .RowCount
             mvarHeadTop(0) = IIf(IsNull(!intTitleTop), 0, !intTitleTop)
             mvarHeadLeft(0) = IIf(IsNull(!intTitleLeft), 0, !intTitleLeft)
             mvarHeadWidth(0) = IIf(IsNull(!intTitleWidth), 0, !intTitleWidth)
             mvarHeadHeight(0) = IIf(IsNull(!intTitleHeight), 0, !intTitleHeight)
             For intCount = 1 To .RowCount
                 mvarHeadFieldId(intCount) = !ID
                 mvarHeadFieldName(intCount) = !Name
                 mvarHeadTop(intCount) = !lngdisplaytop
                 mvarHeadLeft(intCount) = !lngDisplayLeft
                 mvarHeadHeight(intCount) = !lngDisplayHeight
                 mvarHeadWidth(intCount) = !lngDisplayWidth
                 mvarHeadType(intCount) = !bytHead
                 mvarHeadAlign(intCount) = !intAlign
                 mbytCodeShowType(intCount) = !bytCodeShow
                 .MoveNext
             Next intCount
        Else
             strSql = "Select intTitleTop,intTitleLeft,intTitleWidth,intTitleHeight From Report Where lngReportID=" & lngReportID
             Set rstChoosed = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
             With rstChoosed
                If Not .EOF Then
                    HeadFields = 0
                    mvarHeadTop(0) = IIf(IsNull(!intTitleTop), 0, !intTitleTop)
                    mvarHeadLeft(0) = IIf(IsNull(!intTitleLeft), 0, !intTitleLeft)
                    mvarHeadWidth(0) = IIf(IsNull(!intTitleWidth), 0, !intTitleWidth)
                    mvarHeadHeight(0) = IIf(IsNull(!intTitleHeight), 0, !intTitleHeight)
                End If
             End With
        End If
   End With
   
   mvarSelect = GetSelect
   GetReportSet = "Select " & mvarSelect & mvarFrom
End Function

Private Sub GetHeadColumn()
  Dim strSql As String, strOrder As String
  Dim rstHead As rdoResultset
  
   strSql = "Select * from ViewField,Report,ReportField Where ViewField.lngViewFieldID=ReportField.lngViewFieldID " & _
            "And Report.lngReportID=ReportField.lngReportID And Report.lngReportID=" & mvarReportID & _
            " And bytHead>0"
   strOrder = " Order By bytHead"
   Set rstHead = gclsBase.BaseDB.OpenResultset(strSql & strOrder, rdOpenStatic)

End Sub

'显示向导
Public Function ShowReportSet(ByVal lngReportID As Long, ByVal ReportViewID As Long, Optional ParentId As Long = 0, Optional ParentLevel As Integer = 0, Optional clsFormCond As FormCond = Nothing, Optional blnIsNew As Boolean = True, Optional HeadChange As Boolean) As Boolean
  Dim frmWizard As New frmAcntBookWizard
   
   If mlngParentID = 0 Then
        mlngParentID = ParentId
        mintParentLevel = ParentLevel
   End If
   
   If mvarViewID = 0 Then
       GetReportSet lngReportID, ReportViewID
   End If
   
   ShowReportSet = frmWizard.SetReport(Me, clsFormCond, HeadChange)
   If ShowReportSet = True Then
       mvarSelect = GetSelect
       
       '由向导新生成了一张帐表(还未存到数据库)
       If blnIsNew Then
           Report.ShowAcntBook 0, 0, Me, clsFormCond
       End If
   End If
End Function

'取 SELECT 子句
Public Function GetSelect(Optional blnSubBook As Boolean = False) As String
  Dim intCount As Integer, intNo As Integer
  Dim strSelect As String, strFieldFat As String
  Dim rstViewField As rdoResultset
  Dim strQuanFat As String, strPriceFat As String, strRateFat As String, strName As String
  Dim strNatureFat As String, strCurrFat As String, strSumFunc As String
  Dim blnSum As Boolean, blnSumNull As Boolean
  Dim strQ As String, strY As String
  Dim strInt As String, strQuanCond As String, strQuan As String, strTemp As String
  
  '显示格式 0=其他 1=数量 2=单价 3=原币 4=汇率 5=本币 6=日期
     mlngColType = 0
     strPriceFat = gclsBase.GetSqlFormat(gclsBase.PriceDec)
     strQuanFat = gclsBase.GetSqlFormat(gclsBase.QuantityDec)
     strNatureFat = gclsBase.GetSqlFormat(gclsBase.NaturalCurDec)
     strPriceFat = strReplace(strPriceFat, ",", "")
     strQuanFat = strReplace(strQuanFat, ",", "")
     strNatureFat = strReplace(strNatureFat, ",", "")
     For intCount = 1 To mvarColumns
        strName = mvarColumnFieldName(intCount)
        strFieldFat = ""
        blnSum = False
        If mvarColumnDesc(intCount) <> "" And mvarColumnDesc(intCount) <> "年" Then
            If InStr(1, UCase(strName), "SUM") <> 0 Or InStr(1, UCase(strName), "FIRST") <> 0 _
                Or InStr(1, UCase(strName), "LAST") <> 0 Or InStr(1, UCase(strName), "MAX") <> 0 _
                Or InStr(1, UCase(strName), "MIN") <> 0 Then
                blnSum = True
            End If
            If mvarReportType = msgTotal Then
                blnSum = True
            End If
            Select Case mbytFormat(intCount)
               Case 1
                  strFieldFat = "'" & strQuanFat & "'"
                  mlngColType = mlngColType Or 1
               Case 2
                  strFieldFat = "'" & strPriceFat & "'"
               Case 3
                  If blnSum Then
                     strFieldFat = "'999999999999999990.' || String1(MAX(" & mstrCurTable & ".bytCurrencyDec),'0')"
                  Else
                     strFieldFat = "'999999999999999990.' || String1(" & mstrCurTable & ".bytCurrencyDec,'0')"
                  End If
                  mlngColType = mlngColType Or 2
               Case 4
                  If blnSum Then
                     strFieldFat = "'999999999999999990.' || String1(MAX(" & mstrCurTable & ".bytRateDec),'0')"
                  Else
                     strFieldFat = "'999999999999999990.' || String1(" & mstrCurTable & ".bytRateDec,'0')"
                  End If
               Case 5
                  strFieldFat = "'" & strNatureFat & "'"
                  mlngColType = mlngColType Or 4
               Case 6
                  'strFieldFat = "'YYYY-MM-DD'"
            End Select
            blnSumNull = True
            If mvarReportType = msgTotal Then
               If (UCase(mvarColumnFieldType(intCount)) = "INTEGER" Or UCase(mvarColumnFieldType(intCount)) = "LONG" _
                  Or UCase(mvarColumnFieldType(intCount)) = "DOUBLE" Or UCase(mvarColumnFieldType(intCount)) = "CURRENCYS") _
                  And mbytFomular(intCount) <> 0 Then
                  strSumFunc = "Sum"
                  blnSumNull = False
               Else
                  '年、月、日
                  If mbytFormat(intCount) >= 20 And mbytFormat(intCount) <= 22 Then
                     strSumFunc = "Max"
                     blnSumNull = False
                  End If
               End If
            End If
            If strFieldFat <> "" Then
               If mvarReportType = msgTotal Then
                  strFieldFat = "To_Char(" & strSumFunc & "(" & strName & ")," & strFieldFat & ")"
               Else
                  strFieldFat = "To_Char(" & strName & "," & strFieldFat & ")"
               End If
            Else
               '** IF 2 **
               If mvarReportType = msgTotal Then
                  Select Case mbytFormat(intCount)
                  '商品数量
                  Case 7
                     intNo = 1
                     strQuanCond = GetNoXString(strName, intNo, "$")
                     strQuan = GetNoXString(strName, intNo + 1, "$")
                     Do While strQuan <> ""
                        strQ = "Abs(Sum(DECODE(" & strQuanCond & ",1," & strQuan & ",0)))"
                        strY = "MAX(ItemUnit.dblFactor)"
                        'strInt = "CEIL(" & strQ & "/" & strY & "-1)"
                        strInt = "Decode(CEIL(" & strQ & "/" & strY & ")-" & strQ & "/" & strY & ",0," & strQ & "/" & strY & ",CEIL(" & strQ & "/" & strY & "-1))"
                        strTemp = "SIGN(Sum(" & strQuan & "))*" & "(" & strInt & "+(" & strQ & "-" & strInt & "*" & strY & ")/" & "Power(10,Decode(MAX(ItemUnit.dblFactor),1,0,Length(RTrim(" & strY & "-1)))))"
                        strFieldFat = strFieldFat & "+" & strTemp
                        intNo = intNo + 2
                        strQuanCond = GetNoXString(strName, intNo, "$")
                        strQuan = GetNoXString(strName, intNo + 1, "$")
                     Loop
                  Case Else
                     strFieldFat = strSumFunc & "(" & strName & ")"
                  End Select
               '** ELSE OF IF 2 **
               Else
                  Select Case mbytFormat(intCount)
                  '商品数量
                  Case 7
                     
                     intNo = 1
                     strQuanCond = GetNoXString(strName, intNo, "$")
                     strQuan = GetNoXString(strName, intNo + 1, "$")
                     Do While strQuan <> ""
                        strQ = "Abs(" & strQuan & ")"
                        strY = "ItemUnit.dblFactor"
                        strInt = "Decode(CEIL(" & strQ & "/" & strY & ")-" & strQ & "/" & strY & ",0," & strQ & "/" & strY & ",CEIL(" & strQ & "/" & strY & "-1))"
                        strTemp = "SIGN(" & strQuan & ")*" & "(" & strInt & "+(" & strQ & "-" & strInt & "*" & strY & ")/" & "Power(10,Decode(ItemUnit.dblFactor,1,0,Length(RTrim(" & strY & "-1)))))"
                        strTemp = "DECODE(" & strQuanCond & ",1," & strTemp & ",0)"
                        strFieldFat = strFieldFat & "+" & strTemp
                        intNo = intNo + 2
                        strQuanCond = GetNoXString(strName, intNo, "$")
                        strQuan = GetNoXString(strName, intNo + 1, "$")
                     Loop
                  Case Else
                     strFieldFat = strName
                  End Select
               '** END OF IF 2 **
               End If
            End If
            If blnSumNull And mvarReportType = msgTotal Then
                If mvarColumnDesc(intCount) = "摘要" And blnSubBook Then
                   strFieldFat = "Max(strVoucherTypeName) || Decode(strVolume,'00','合计','第' || strVolume || '册合计')"
                Else
                   strFieldFat = "''"
                End If
            End If
            If strSelect = "" Then
                strSelect = strFieldFat & " As " & """" & mvarColumnDesc(intCount) & """"
            Else
                strSelect = strSelect & "," & strFieldFat & " As " & """" & mvarColumnDesc(intCount) & """"
            End If
        End If
     Next intCount
     GetSelect = strSelect
     
End Function

Private Sub Class_Terminate()
    Erase mvarColumnWidth()
    Erase mvarColumnOrderType()
    Erase mvarColumnIsFix()
    Erase mvarColumnIsMust()
    Erase mvarColumnIsFind()
    Erase mvarColumnFieldID()
    Erase mvarColumnFieldName()
    Erase mvarColumnDesc()
    Erase mvarColumnFieldType()
    Erase mvarColumnFieldSize()
    Erase mvarColumnCombine()
End Sub