multireportset.cls

金算盘软件代码

  'Del Old SubColumn
  strSql = "Delete ReportMultiColumn WHERE lngReportID =" & mvarReportID
    
  gclsBase.ExecSQL strSql
  
  'Save Now Choosed Field
  strSql = "Select * from ReportMultiColumn where lngReportID=-1"
  Set rstSub = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
  For intCount = 1 To mvarSubColumns
    'Add List
    With rstSub
       .AddNew
          !lngReportID = ReportID
          !lngReportMultiNO = intCount
          !strReportFieldDesc = mvarSubDesc(intCount)
          !strMultiCond = mvarSubCond(intCount)
          !strMultiCode = mvarSubCode(intCount)
          !blnIsAmount = IIf(mvarSubData(intCount) And 1 <> 0, 1, 0)
          !blnIsQuantity = IIf((mvarSubData(intCount) And 2) <> 0, 1, 0)
          !blnIsCurrency = IIf((mvarSubData(intCount) And 4) <> 0, 1, 0)
          !lngAmountWidth = mvarSubAmountWidth(intCount)
          !lngQuantityWidth = mvarSubQuantityWidth(intCount)
          !lngCurrencyWidth = mvarSubCurrencyWidth(intCount)
          !intDirect = mvarSubDirect(intCount)
          !strContent = mvarContent
          !lngReportMultiID = BillPublic.GetNewID("ReportMultiColumn")
       .Update
    End With
  Next intCount
End Sub

'套打纸GridTop
Public Function GetGridTop()
  Dim strSql As String
  Dim rstTop As rdoResultset
    strSql = "Select lngGridTop From ReportPaper Where lngPaperID=" & mlngPaperID
    Set rstTop = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rstTop
       If Not .EOF Then
          GetGridTop = !lngGridTop
          mvarGridTop = !lngGridTop
       End If
    End With
End Function

'取当前帐表套打设置
Public Function GetReportTdSet() 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
   
   strSql = "Select * from ViewField,Report,ReportField,ReportOnlyData Where ViewField.lngViewFieldID=ReportField.lngViewFieldID And ViewField.lngViewFieldID=ReportOnlyData.lngViewFieldID " & _
            "And Report.lngReportID=ReportField.lngReportID And Report.lngReportID=" & mvarReportID & _
             strCondVersion & " And ReportOnlyData.lngPaperID=" & mlngPaperID
   strOrder = " Order By lngOrder"
   Set rstChoosed = gclsBase.BaseDB.OpenResultset(strSql & strOrder, rdOpenStatic)
   With rstChoosed
       If .EOF Then
          GetReportTdSet = ""
          Exit Function
       End If
       .MoveLast
       .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) = 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
   
   If ViewId = 0 Then
        ViewId = ReportViewID
        ReportID = lngReportID
   End If
   
   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
            
            Columns = .RowCount
            
            mvarFixColumns = 0
            mvarGridTop = !intGridTop
            mintDirect = !intDirection
            For intCount = 1 To .RowCount
                 mvarColumnDesc(intCount) = !strReportFieldDesc
                 mvarColumnFieldName(intCount) = IIf(IsNull(!strFieldName), "", !strFieldName)
                 
                 lngWidth = Utility.GetDisplayWidth(!strViewFieldDesc, !bytFieldSize)
                 lngWidth = IIf(lngWidth > !lngDisplayWidth, lngWidth, !lngDisplayWidth)
                 mvarColumnWidth(intCount) = lngWidth
                 
                 mvarColumnOrderType(intCount) = !bytsort
                 mvarColumnIsFix(intCount) = !blnIsFixed
                 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
   End If
   
   strSql = "Select * from ReportMultiColumn Where lngReportID=" & lngReportID
   strOrder = " Order By lngReportMultiNO"
   Set rstChoosed = gclsBase.BaseDB.OpenResultset(strSql & strOrder, rdOpenStatic)
   With rstChoosed
       If Not .EOF Then
            .MoveLast
            .MoveFirst
            mvarContent = !strContent
            SubColumns = .RowCount
            For intCount = 1 To .RowCount
                On Error Resume Next
                mvarSubDesc(intCount) = !strReportFieldDesc
                mvarSubCond(intCount) = !strMultiCond
                mvarSubCode(intCount) = !strMultiCode
                mvarSubData(intCount) = 0
                If !blnIsAmount Then
                    mvarSubData(intCount) = mvarSubData(intCount) + 1
                End If
                If !blnIsQuantity Then
                    mvarSubData(intCount) = mvarSubData(intCount) + 2
                End If
                If !blnIsCurrency Then
                    mvarSubData(intCount) = mvarSubData(intCount) + 4
                End If
                mvarSubAmountWidth(intCount) = !lngAmountWidth
                mvarSubQuantityWidth(intCount) = !lngQuantityWidth
                mvarSubCurrencyWidth(intCount) = !lngCurrencyWidth
                mvarSubDirect(intCount) = !intDirect
                .MoveNext
            Next intCount
       End If
   End With
   
   strSql = "Select bytCodeShow,intAlign,bytHead,lngDisplayTop,lngDisplayLeft,lngDisplayHeight,lngDisplayWidth," & _
            "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
             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
        End If
   End With
   
   mvarSelect = GetSelect
   mvarWhere = GetWhere
   GetReportSet = "Select " & mvarSelect & mvarFrom & IIf(mvarWhere <> "", " Where " & mvarWhere, "")
End Function

'显示栏目设置窗口
Public Function ShowMultiReportSet(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 frmMultiWizard As New frmMultiBookWizard
   
   If mlngParentID = 0 Then
        mlngParentID = ParentId
        mintParentLevel = ParentLevel
   End If
   
   If mvarViewID = 0 Then
       GetReportSet lngReportID, ReportViewID
   End If
   
   ShowMultiReportSet = frmMultiWizard.SetMultiReport(Me, clsFormCond, HeadChange)
   If ShowMultiReportSet = True Then
       mvarSelect = GetSelect
       mvarWhere = GetWhere

       '由向导新生成了一张帐表(还未存到数据库)
       If blnIsNew Then
           Report.ShowMultiAcntBook 0, 0, Me, clsFormCond
       End If
   End If
End Function

'取 SELECT 子句
Public Function GetSelect()
  Dim intCount As Integer
  Dim strSelect As String, strFieldName As String
  Dim strFieldFat As String, blnSum As Boolean
    
     If mvarReportType = msgTotal Then
        blnSum = True
     Else
        blnSum = False
     End If
     For intCount = 1 To Columns
            If Trim(ColumnFieldName(intCount)) <> "" And Trim(ColumnDesc(intCount)) <> "年" Then
               If ColumnDesc(intCount) = "汇率" Then
                  If blnSum Then
                     strFieldFat = "'9999999990.' || String1(Max(Currencys.bytRateDec),'0')"
                  Else
                     strFieldFat = "'9999999990.' || String1(Currencys.bytRateDec,'0')"
                  End If
               Else
                  strFieldFat = ""
               End If
               If blnSum Then
                  If ColumnDesc(intCount) = "摘要" Then
                    strFieldName = "Max(strVoucherTypeName) || Decode(strVolume,'00','合计','第' || strVolume || '册合计')"
                  Else
                    If strFieldFat = "" Then
                       strFieldName = "Max(" & ColumnFieldName(intCount) & ")"
                    Else
                       strFieldName = "To_Char(Max(" & ColumnFieldName(intCount) & ")," & strFieldFat & ")"
                    End If
                  End If
               Else
                  If strFieldFat = "" Then
                     strFieldName = ColumnFieldName(intCount)
                  Else
                     strFieldName = "To_Char(" & ColumnFieldName(intCount) & "," & strFieldFat & ")"
                  End If
               End If
               If ColumnDesc(intCount) <> "年" And ColumnDesc(intCount) <> "月" And ColumnDesc(intCount) <> "日" And mvarReportType = msgTotal Then
                  If ColumnDesc(intCount) <> "摘要" Then
                     strFieldName = "' '"
                  End If
               End If
               If strSelect = "" Then
                   strSelect = strFieldName & " As " & ColumnDesc(intCount)
               Else
                   strSelect = strSelect & "," & strFieldName & " As " & ColumnDesc(intCount)
               End If
            End If
     Next intCount
     
     GetSelect = strSelect
End Function

Private Function ArrHaveData(arr As Variant) As Boolean
  Dim lngCount As Long
  On Error GoTo ErrHandle
     lngCount = UBound(arr)
     ArrHaveData = True
     Exit Function
ErrHandle:
End Function

'取 Where 子句
Public Function GetWhere() As String
  Dim strField As String
  Dim intCount As Integer
  Dim strCond As String
    
'    GetWhere = Filter.GetInitWhere(mvarReportID, 2)
'
'    If ArrHaveData(mvarSubCond) Then
'         Select Case mvarContent
'              Case "科目"
'                  strField = "Account.lngAccountId"
'         End Select
'         For intCount = 1 To UBound(mvarSubCond)
'              If Trim(mvarSubCond(intCount)) <> "" Then
'                    If strCond = "" Then
'                          strCond = strField & " In (" & mvarSubCond(intCount) & ")"
'                    Else
'                          strCond = strCond & " Or " & strField & " In (" & mvarSubCond(intCount) & ")"
'                    End If
'              End If
'         Next intCount
'         If strCond <> "" Then
'             If GetWhere <> "" Then
'                  GetWhere = GetWhere & " Or " & strCond
'             Else
'                  GetWhere = strCond
'             End If
'         End If
'    End If
End Function

'释放数组
Private Sub Class_Terminate()
    Erase mvarColumnWidth()
    Erase mvarColumnOrderType()
    Erase mvarColumnIsFix()
    Erase mvarColumnIsFind()
    Erase mvarColumnFieldID()
    Erase mvarColumnFieldName()
    Erase mvarColumnDesc()
    Erase mvarColumnFieldType()
    Erase mvarColumnFieldSize()
    Erase mvarColumnCombine()
    
    Erase mvarSubDesc()
    Erase mvarSubCond()
    Erase mvarSubData()
    Erase mvarSubDirect()
    Erase mvarSubAmountWidth()
    Erase mvarSubQuantityWidth()
    Erase mvarSubCurrencyWidth()
End Sub