standardreportset.cls

金算盘软件代码

            mvarCondHeight = 330
       End If
    End With
    Set rstReport = Nothing
    
     '处理工资报表
    Select Case mvarViewID
    Case 593, 637
         DealSalaryField  'OldDealSalary
    Case Else
    End Select
End Sub
'得到字段内容
Public Sub GetField()
    Dim intCount As Integer
    Dim intGroup As Integer, intSort As Integer
    Dim intList As Integer, intChoosed As Integer
    Dim strSql As String
    Dim rstReport As rdoResultset
    Dim strCondVersion As String, strCondHospital As String
    Dim arrFormula(4) As Integer
    #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 mvarViewID
    Case 593, 637          '工资报表加特殊条件
        If mvarSalFieldID <> "" Then
            strCondVersion = strCondVersion & " And (Upper(ViewField.strFieldType)<>'DOUBLE' OR " _
                        & " Upper(ViewField.strFieldType)='DOUBLE' AND ViewField.lngViewFieldID IN (" & mvarSalFieldID & "))"
        End If
    Case Else
    End Select
    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
      intGroup = 0: intList = 0
      intSort = 0: intCount = 0
      intChoosed = 0
      mvarCustomFields = 0
      Set mcolFieldID = New Collection
      mstrInField = ""
      Do While Not .EOF
        mvarColumnID(intCount) = !lngViewFieldID   '.rdoColumns("ReportField.lngViewFieldID")
        mvarColumnDesc(intCount) = !strReportFieldDesc
        mvarColumnWidth(intCount) = !lngDisplayWidth
        mvarColumnHeight(intCount) = !lngDisplayHeight
        mvarColumnLeft(intCount) = !lngDisplayLeft
        mvarColumnTop(intCount) = !lngdisplaytop
        mvarColumnAlign(intCount) = !intAlign
        mvarColumnStyle(intCount) = !bytReportFieldType
        mvarColumnSort(intCount) = !bytsort
        mvarColumnSortNO(intCount) = !intSortNo
        mvarColumnNO(intCount) = !lngReportFieldNO
        mvarColumnGroup(intCount) = !dblDistance
        mvarColumnChoosed(intCount) = !blnIsChoosed
        mvarCustomFormula(intCount) = Trim(!strFomular)
        mvarCodeName(intCount) = !bytCodeShow
        mvarReportFieldID(intCount) = !lngReportFieldID
        
        If mstrInField = "" Then
            mstrInField = mvarReportFieldID(intCount)
        Else
            mstrInField = mstrInField & "," & mvarReportFieldID(intCount)
        End If
        If mvarColumnID(intCount) > 0 Then
            mcolFieldID.Add intCount, CStr(mvarColumnID(intCount))
        End If
        
        mvarColumnFieldName(intCount) = IIf(IsNull(!strFieldName), "", !strFieldName)
        mvarColumnFieldDesc(intCount) = IIf(IsNull(!strViewFieldDesc), "", !strViewFieldDesc)
        mvarColumnFieldCombin(intCount) = IIf(IsNull(!strCombine), "", Trim(!strCombine))
        mvarColumnFieldType(intCount) = IIf(IsNull(!strFieldType), "Double", !strFieldType)
        mvarColumnFieldSize(intCount) = IIf(IsNull(!bytFieldSize), 12, !bytFieldSize)
        mvarColumnFieldHead(intCount) = IIf(IsNull(!bytHead), 0, !bytHead)
        mvarColumnFormat(intCount) = IIf(IsNull(!bytFormat), 0, !bytFormat)
        mvarColumnFixed(intCount) = IIf(IsNull(!blnIsFixed), 0, !blnIsFixed)
        mvarColumnFieldFormula(intCount) = IIf(IsNull(!bytFormula), 0, !bytFormula)
        mvarColumnDecimal(intCount) = IIf(IsNull(!strFieldName), 0, !bytFieldDec)
        
            If mvarColumnChoosed(intCount) = 1 And mvarColumnFieldHead(intCount) = 0 Then
                intChoosed = intChoosed + 1
            End If
            Select Case mvarColumnStyle(intCount)
            Case 1        '分组
                intGroup = intGroup + 1
            Case 6        '列表框
                intList = intList + 1
            End Select
            If Trim(!strFomular) <> "" Then
                arrFormula(mvarCustomFields) = intCount + 1            '位置加一
                mvarCustomFields = mvarCustomFields + 1
            End If
        .MoveNext
        intCount = intCount + 1
      Loop
      
      '转换自定义栏目公式
         For intCount = 0 To 4
            If arrFormula(intCount) > 0 Then                               '减一还原位置
                FormulaToSql mvarCustomFormula(arrFormula(intCount) - 1), mvarColumnFieldName(arrFormula(intCount) - 1)
            End If
         Next intCount
         
          ChoosedColumns = intChoosed
          GroupColumns = intGroup
          ListColumns = intList
          intList = 0
          intChoosed = 0
          For intCount = 0 To mvarColumns - 1
                If mvarColumnChoosed(intCount) = 1 And mvarColumnFieldHead(intCount) = 0 Then
                    mvarChoosedLoc(intChoosed) = intCount
                    intChoosed = intChoosed + 1
                End If
                If mvarColumnStyle(intCount) = 6 Then
                    mvarColumnListLoc(intList) = intCount
                    intList = intList + 1
                End If
          Next intCount
    End With

    '得到排序字段
    strSql = "SELECT ReportField.lngViewFieldID,ReportField.bytsort FROM  ReportField,ViewField " & _
            " WHERE ReportField.lngViewFieldID = ViewField.lngViewFieldID(+) " & _
            " And ReportField.blnIsChoosed=1 And ReportField.bytReportFieldType in (1,2) " & _
            " And ReportField.intSortNO>0 And ReportField.lngReportID =" & mvarReportID & strCondVersion & _
            " ORDER BY ReportField.intSortNo"
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rstReport
        If .EOF Then
           SortColumns = 0
        Else
            .MoveLast
            .MoveFirst
            SortColumns = .RowCount
            intSort = 0
            Do While Not .EOF
                 SortID(intSort) = !lngViewFieldID '.rdocolumns("ReportField.lngViewFieldID")
                 mvarSortMethod(intSort) = !bytsort
                 intSort = intSort + 1
                .MoveNext
            Loop
        End If
    End With
    Set rstReport = Nothing
    
    '处理工资字段小数位数
    Select Case mvarViewID
    Case 593, 637
        DealSalaryDec
    Case Else
    End Select
End Sub

 '得到ReportGroup表内容
Private Sub GetReportGroup()
    Dim intCount As Integer
    Dim intGroup As Integer
    Dim l As Long
    Dim rstReport As rdoResultset
    Set rstReport = gclsBase.BaseDB.OpenResultset("SELECT  ReportGroup.* FROM  ReportGroup" _
            & " WHERE   lngReportID =" & mvarReportID & " And lngReportGroupFieldID In (" & mstrInField _
            & ") And lngReportSumFieldID In (" & mstrInField & ")  ORDER BY bytReportGroupNO ", rdOpenStatic)
    If rstReport.EOF Then
        Exit Sub
    End If
    On Error Resume Next
    With rstReport
      .MoveLast
      .MoveFirst
      intCount = -1
      Do Until .EOF
      If intCount = -1 Or ColumnGroupID(intCount * conSumCount + intGroup) <> !lngReportGroupFieldID Then
            intCount = intCount + 1
            intGroup = 1
            ColumnGroupID(intCount * conSumCount + intGroup) = !lngReportGroupFieldID
            ColumnSumID(intCount * conSumCount + intGroup) = !lngReportSumFieldID
            ColumnSumMethod(intCount * conSumCount + intGroup) = !bytSumMethod
       Else
            intGroup = intGroup + 1
            ColumnGroupID(intCount * conSumCount + intGroup) = !lngReportGroupFieldID
            ColumnSumID(intCount * conSumCount + intGroup) = !lngReportSumFieldID
            ColumnSumMethod(intCount * conSumCount + intGroup) = !bytSumMethod
       End If
      .MoveNext
      Loop
    End With
    Set rstReport = Nothing
End Sub

Public Sub SetSQL()
    SetSelect
    SetOrder
End Sub

Private Sub SetSelect()
  Dim intCount As Integer
  Dim strName As String
     mstrSelect = ""
     '已选栏目
     For intCount = 0 To mvarChoosedColumns - 1
        strName = Trim(mvarColumnFieldName(mvarChoosedLoc(intCount)))
        strName = FormatFieldName(strName, mvarColumnFormat(mvarChoosedLoc(intCount)))

        If mstrSelect = "" Then
            mstrSelect = strName & " As """ & mvarColumnDesc(mvarChoosedLoc(intCount)) & """"
        Else
            mstrSelect = mstrSelect & "," & strName & " As """ & mvarColumnDesc(mvarChoosedLoc(intCount)) & """"
        End If
      Next intCount
End Sub
'对字段格式化
Private Function FormatFieldName(ByVal strName As String, bytFormat As Byte) As String
Dim intLen As Integer
Dim strFormat As String
    Select Case mvarViewID
    Case 593, 637
        FormatFieldName = strName
    Case Else
        Select Case bytFormat
        Case 0
            FormatFieldName = strName
        Case 1       '数量
            FormatFieldName = "Sign(" & strName & ")*(Trunc(Abs(" & strName & ")/ItemUnit.dblFactor)+(Abs(" & strName & ")-Trunc(Abs(" & strName & ")/ItemUnit.dblFactor)*ItemUnit.dblFactor)/Power(10,Length(ItemUnit.dblFactor-1)))"
        Case 2       '单价
            intLen = gclsBase.PriceDec
            If intLen > 0 Then
                strFormat = "999999999990." & String(intLen, "0")
            Else
                strFormat = "999999999999"
            End If
            FormatFieldName = "Ltrim(To_Char(" & strName & ",'" & strFormat & "'))"
        Case 3       '原币
            FormatFieldName = "Ltrim(Decode(Sign(Currencys.bytCurrencyDec),1,To_Char(" & strName & ",'999999999990.' || String1(Currencys.bytCurrencyDec,'0')),To_Char(" & strName & ",'999999999')))"
        Case 4       '汇率
            FormatFieldName = "Ltrim(Decode(Sign(Currencys.bytRateDec),1,To_Char(" & strName & ",'999999999990.'|| String1(Currencys.bytRateDec,'0')),To_Char(" & strName & ",'999999999')))"
        Case 5       '本币
            intLen = gclsBase.NaturalCurDec
            If intLen > 0 Then
                strFormat = "999999999990." & String(intLen, "0")
            Else
                strFormat = "999999999999"
            End If
            FormatFieldName = "Ltrim(To_Char(" & strName & ",'" & strFormat & "'))"
        Case 7       '委托加工对照表发出数量
            FormatFieldName = "Sign(" & strName & ")*(Trunc(Abs(" & strName & ")/Item1Unit.dblFactor)+(Abs(" & strName & ")-Trunc(Abs(" & strName & ")/Item1Unit.dblFactor)*Item1Unit.dblFactor)/Power(10,Length(Item1Unit.dblFactor-1)))"
        Case Else
            FormatFieldName = strName
        End Select
    End Select
End Function

'处理工资字段小数位数
Private Sub DealSalaryDec()
Dim intCount As Integer, intDec As Integer
Dim strFormat As String
    For intCount = 0 To mvarColumns - 1
        If UCase(mvarColumnFieldType(intCount)) = "DOUBLE" Then
            intDec = mvarColumnDecimal(intCount)
            If intDec > 0 Then
                strFormat = "999999999990." & String(intDec, "0")
            Else
                strFormat = "999999999999"
            End If
            mvarColumnFieldName(intCount) = "Ltrim(To_Char(" & mvarColumnFieldName(intCount) & ",'" & strFormat & "'))"
        End If
    Next intCount
End Sub

 
'得到排序子句
Private Sub SetOrder()
    Dim intCount As Integer, intGroup As Integer
    Dim strSort As String
    
    mstrOrder = ""
    If mvarGroupColumns > 0 Then
    For intCount = 0 To mvarGroupColumns - 1
      intGroup = mvarColumnGroupLoc(intCount * conSumCount + 1)
      If mvarColumnGroup(intGroup) >= 0 Then
            Select Case mvarColumnSort(intGroup)
            Case 0, 1
              strSort = "ASC"
            Case Else
              strSort = "DESC"
            End Select
         If mstrOrder = "" Then
          mstrOrder = mvarColumnFieldName(intGroup) & Space(1) & strSort
         Else
          mstrOrder = mstrOrder & ", " & mvarColumnFieldName(intGroup) & Space(1) & strSort
         End If
      End If
    Next intCount
    End If
    If mvarSortColumns > 0 Then
    For intCount = 0 To mvarSortColumns - 1