reportsumset.cls

金算盘软件代码

            mvarColumnFieldDesc(intCount) = IIf(IsNull(!strFieldName), "", !strViewFieldDesc)
            mvarGroupName(intCount) = IIf(IsNull(!strFieldName), "", Trim(!strGroup))
            mvarColumnFieldCombin(intCount) = IIf(IsNull(!strFieldName), "", Trim(!strCombine))
            mvarColumnFieldType(intCount) = IIf(IsNull(!strFieldName), "Double", !strFieldType)
            mvarColumnFieldSize(intCount) = IIf(IsNull(!strFieldName), 12, !bytFieldSize)
            mvarColumnFixed(intCount) = IIf(IsNull(!strFieldName), 0, !blnIsFixed)
            mvarColumnFieldHead(intCount) = IIf(IsNull(!strFieldName), 0, !bytHead)
            mvarColumnFieldFormula(intCount) = IIf(IsNull(!strFieldName), 0, !bytFormula)
            mvarColumnDecimal(intCount) = IIf(IsNull(!strFieldName), 0, !bytFieldDec)
            
                If mvarColumnChoosed(intCount) = 1 And mvarColumnFieldHead(intCount) = 0 Then
                    intChoosed = intChoosed + 1
                End If
                If mvarColumnStyle(intCount) = 6 Then
                    '列表框
                    intList = intList + 1
                End If
                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
           ListColumns = intList
          intList = 0
          intChoosed = 0
          intGroup = 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=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
End Sub

'对汇总表加过滤条件
Public Sub AddHaving(strHaving As String)
Dim strCond As String, strSql As String
Dim intCount As Integer, intLoc As Integer
Dim rstRec As rdoResultset

    If mvarViewID = 1193 Then Exit Sub
    strSql = "SELECT strUser FROM VIEW1 WHERE lngViewid=" & mvarViewID
    Set rstRec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rstRec!strUser <> "王佥" Then
        Exit Sub
    End If
    strCond = "0"
    If strCount(strHaving, " And ") >= 39 Then Exit Sub
    For intCount = 0 To mvarChoosedColumns - 1
        intLoc = mvarChoosedLoc(intCount)
        If UCase(mvarColumnFieldType(intLoc)) = "DOUBLE" Then
            strCond = strCond & " + DECODE(" & mvarColumnFieldName(intLoc) & ",'',0,Abs(" & mvarColumnFieldName(intLoc) & "))"
        End If
    Next intCount
    If strCond <> "0" Then
        strCond = strCond & ">0"
        If strHaving = "" Then
            strHaving = strCond
        Else
            strHaving = strCond & " And " & strHaving
        End If
    End If
End Sub
Public Sub SetSQL()
    SetSelect
    SetGroup
    SetOrder
End Sub
Private Sub SetSelect()
  Dim intCount As Integer
     mstrSelect = ""
     '已选栏目
     Select Case mvarViewID
     Case 1193     '处理付款方实际支付金额
        Dim strTemp As String
        For intCount = 0 To mvarChoosedColumns - 1
            If mvarColumnFieldDesc(mvarChoosedLoc(intCount)) = "实际支付" Then
                strTemp = ""
            Else
                strTemp = " As """ & mvarColumnDesc(mvarChoosedLoc(intCount)) & """"
            End If
            If mstrSelect = "" Then
                mstrSelect = mvarColumnFieldName(mvarChoosedLoc(intCount)) & strTemp
            Else
                mstrSelect = mstrSelect & "," & mvarColumnFieldName(mvarChoosedLoc(intCount)) & strTemp
            End If
        Next intCount
     Case Else
        For intCount = 0 To mvarChoosedColumns - 1
            If Trim(mvarColumnFieldName(mvarChoosedLoc(intCount))) <> "" Then
               If mstrSelect = "" Then
                   mstrSelect = mvarColumnFieldName(mvarChoosedLoc(intCount)) & " As """ & mvarColumnDesc(mvarChoosedLoc(intCount)) & """"
               Else
                   mstrSelect = mstrSelect & "," & mvarColumnFieldName(mvarChoosedLoc(intCount)) & " As """ & mvarColumnDesc(mvarChoosedLoc(intCount)) & """"
               End If
            Else
               If mstrSelect = "" Then
                   mstrSelect = "0" & " As """ & mvarColumnDesc(mvarChoosedLoc(intCount)) & """"
               Else
                   mstrSelect = mstrSelect & "," & "0" & " As """ & mvarColumnDesc(mvarChoosedLoc(intCount)) & """"
               End If
            End If
         Next intCount
    End Select

    mstrSelect = "SELECT " & mstrSelect
End Sub


Private Sub SetGroup()
'得到分组子句
    Dim intCount As Integer, intGroup As Integer
    Dim strSort As String, strGroup As String
    strGroup = ""
    For intCount = 0 To mvarChoosedColumns - 1
        strSort = Trim(mvarGroupName(mvarChoosedLoc(intCount)))
        If strSort <> "" Then
            If strGroup = "" Then
                strGroup = strSort
            Else
                strGroup = strGroup & "," & strSort
            End If
        End If
    Next intCount
    If strGroup <> "" Then
        mstrGroup = " Group BY " & strGroup
    Else
        mstrGroup = ""
    End If
End Sub
Private Sub SetOrder()
'得到排序子句
    Dim intCount As Integer, intGroup As Integer
    Dim strSort As String, strOrder As String
  
    strOrder = ""
    If mvarSortColumns > 0 Then
    For intCount = 0 To mvarSortColumns - 1
        intGroup = mvarSortLoc(intCount)
        If mvarSortMethod(intCount) = 1 Then
         strSort = "ASC"
        Else
         strSort = "DESC"
        End If
         If strOrder = "" Then
              strOrder = mvarColumnFieldName(intGroup) & Space(1) & strSort
         Else
               strOrder = strOrder & ", " & mvarColumnFieldName(intGroup) & Space(1) & strSort
         End If
    Next intCount
    End If
    If strOrder <> "" Then
        mstrOrder = " ORDER BY " & strOrder
    Else
        mstrOrder = ""
    End If
End Sub

'保存类到数据库
'保存标准表修改结果
Public Function SaveStandard(Optional blnSaveAs As Boolean = False) As Boolean
    On Error GoTo clsErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
    
    If blnSaveAs Then
        AddReport
        mvarReportPrep = 2
    Else
        EditUpdate False
    End If
    gclsBase.BaseWorkSpace.CommitTrans
    SaveStandard = True
    Exit Function
clsErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
    SaveStandard = False
End Function
'按用户ID重新保存一份标准表
Private Sub AddReport()
  Dim rstReport As rdoResultset
  Dim strSql As String
  Dim lngReportID As Long
   
'    On Error GoTo ErrHandle
'    If mvarSaveErr Then Exit Sub
'    gclsBase.BaseDB.BeginTrans
    
    '关闭表触发器
    strSql = "Alter Table Report Disable All Triggers"
    gclsBase.BaseDB.Execute (strSql)
    
    mvarPrintSetID = StandardReport.GetPrintSetupID(8, mvarReportID)
    strSql = "Select * from Report"
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    With rstReport
       .AddNew
          lngReportID = BillPublic.GetNewID("Report")
          !lngViewId = mvarViewID
          !bytGroup = mvarGroupNo
          !strReportName = mvarReportName
          !lngOperatorID = gclsBase.OperatorID
          !bytPrep = 2
          !bytWizard = 8
          !lngParentId = mvarParentID
          !strExtraCond = IIf(mvarReportCond = "", " ", mvarReportCond)
          !lngPrintSetupID = mvarPrintSetID
          !intLevel = mvarLevel + 1
          !blnIsDetail = 1
          !strDate = Format(gclsBase.BaseDate, "YYYY-MM-DD")
          !lngReportID = lngReportID
       .Update
    End With
    
    '打开表触发器
    strSql = "Alter Table Report Enable All Triggers"
    gclsBase.BaseDB.Execute (strSql)
'    gclsBase.BaseDB.CommitTrans
    
    Set rstReport = Nothing
    CopyReportField (lngReportID)
    mvarReportID = lngReportID
    EditUpdate
'    Exit Sub
'
'ErrHandle:
'    gclsBase.BaseDB.RollBacktrans
'    Set rstReport = Nothing
'    Utility.ShowMsg frmMain.hwnd, Err.Description, vbCritical + vbOKOnly, App.title
'    mvarSaveErr = True
End Sub

'复制所有报表字段
Private Sub CopyReportField(ByVal lngReportID As Long)
  Dim strSql As String
  Dim intCount As Integer, intLoc As Integer
  Dim rstSource As rdoResultset, rstDesc As rdoResultset
  Dim lngFieldID As Long
  Dim fldReportField As rdoColumn
  Dim colFieldID As Collection
     
'     On Error GoTo ErrHandle
'     If mvarSaveErr Then Exit Sub
'     gclsBase.BaseDB.BeginTrans
      
     Set colFieldID = New Collection
     For intCount = 0 To UBound(mvarReportFieldID)
        If mvarReportFieldID(intCount) > 0 Then
            colFieldID.Add intCount + 1, CStr(mvarReportFieldID(intCount))
        End If
     Next intCount
     strSql = "Select * from ReportField Where lngReportId=" & mvarReportID
     Set rstSource = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
     
     strSql = "Select * from ReportField Where lngReportId=" & lngReportID
     Set rstDesc = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
     
     '关闭表触发器
    strSql = "Alter Table ReportField Disable All Triggers"
    gclsBase.BaseDB.Execute (strSql)
    
     With rstSource
         intCount = 0
         Do While Not .EOF
            rstDesc.AddNew
            For Each fldReportField In .rdoColumns
                If UCase(fldReportField.Name) = UCase("lngReportId") Then
                    rstDesc!lngReportID = lngReportID
                Else
                     If UCase(fldReportField.Name) <> UCase("lngReportFieldId") Then
                         rstDesc.rdoColumns(fldReportField.Name).Value = fldReportField.Value
                     Else
                         lngFieldID = BillPublic.GetNewID("reportField")
                         rstDesc.rdoColumns(fldReportField.Name).Value = lngFieldID
                         On Error Resume Next
                         intLoc = -1
                         intLoc = colFieldID(CStr(fldReportField.Value))
                         If intLoc > 0 Then
                            mvarReportFieldID(intLoc - 1) = lngFieldID
                         End If
                         On Error GoTo 0
                     End If
                End If