reportset.cls

金算盘软件代码

Public Property Let HeadWidth(ByVal ColumnIndex As Integer, ByVal vData As Long)
    mvarHeadWidth(ColumnIndex) = vData
End Property

Public Property Get HeadWidth(ByVal ColumnIndex As Integer) As Long
    HeadWidth = mvarHeadWidth(ColumnIndex)
End Property

'表头栏目类型
Public Property Let HeadType(ByVal ColumnIndex As Integer, ByVal vData As Long)
    mvarHeadType(ColumnIndex) = vData
End Property

Public Property Get HeadType(ByVal ColumnIndex As Integer) As Long
    HeadType = mvarHeadType(ColumnIndex)
End Property

'栏目合并列名
Public Property Let ColumnCombine(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarColumnCombine(ColumnIndex) = vData
End Property

Public Property Get ColumnCombine(ByVal ColumnIndex As Integer) As String
    ColumnCombine = mvarColumnCombine(ColumnIndex)
End Property

'栏目数
Public Property Let Columns(ByVal vData As Integer)
    mvarColumns = vData
    
    ReDim mvarColumnTop(mvarColumns)
    ReDim mvarColumnLeft(mvarColumns)
    ReDim mvarColumnHeight(mvarColumns)
    ReDim mvarColumnWidth(mvarColumns)
    
    ReDim mvarColumnOrderType(mvarColumns)
    ReDim mvarColumnIsFix(mvarColumns)
    ReDim mvarColumnIsMust(mvarColumns)
    ReDim mvarColumnIsFind(mvarColumns)
    ReDim mvarColumnFieldID(mvarColumns)
    ReDim mvarColumnFieldName(mvarColumns)
    ReDim mvarColumnDesc(mvarColumns)
    ReDim mvarColumnFieldType(mvarColumns)
    ReDim mvarColumnFieldSize(mvarColumns)
    ReDim mvarColumnCombine(mvarColumns)
    ReDim mbytFormat(mvarColumns)
    ReDim mbytFomular(mvarColumns)
End Property

Public Property Get Columns() As Integer
    Columns = mvarColumns
End Property

'固定栏目数
Public Property Let FixColumns(ByVal vData As Integer)
    mvarFixColumns = vData
End Property

Public Property Get FixColumns() As Integer
    FixColumns = mvarFixColumns
End Property

'取 FROM 子句
Public Property Get FromOfSql() As String
    FromOfSql = mvarFrom
End Property

'取 SELECT 子句
Public Property Get SelectOfSql() As String
    SelectOfSql = mvarSelect
End Property

'帐表对应的视图ID
Public Property Let ViewId(ByVal vData As Long)
  Dim rstView As rdoResultset
    mvarViewID = vData
    Set rstView = gclsBase.BaseDB.OpenResultset("Select strViewWhere,strViewName,strViewSQL,blnIsUnion,strCurTable from View1 Where lngViewId=" & mvarViewID, rdOpenStatic)
    If Not rstView.EOF Then
        mvarViewName = rstView!strViewName
        mvarFrom = " From " & rstView!strViewSQL
        mstrCurTable = IIf(IsNull(rstView!strCurTable), "", rstView!strCurTable)
        mstrUnionWhere = rstView.rdoColumns("strViewWhere").GetChunk(4096)
    End If
End Property

Public Property Get ViewId() As Long
    ViewId = mvarViewID
End Property

'帐表ID
Public Property Let ReportID(ByVal vData As Long)
  Dim rstReport As rdoResultset
    mvarReportID = vData
    Set rstReport = gclsBase.BaseDB.OpenResultset("Select lngPaperID,lngPrintSetupID,bytGroup,strReportName,bytAccountType,bytPrep,intLevel,lngParentID from Report Where lngReportId=" & mvarReportID, rdOpenStatic)
    If Not rstReport.EOF Then
        mvarReportName = rstReport!strReportName
        mvarReportType = rstReport!bytAccountType
        mbytPrep = rstReport!bytPrep
        mbytGroup = rstReport!bytGroup
        mlngPrintSetID = rstReport!lngPrintSetupID
        If mlngParentID = 0 Then
            mlngParentID = rstReport!lngParentId
            mintParentLevel = rstReport!intLevel
        End If
        mlngPaperID = IIf(IsNull(rstReport!lngPaperID), 0, rstReport!lngPaperID)
        If mlngPaperID = 0 Then
           mblnOnlyData = False
        Else
           mblnOnlyData = True
        End If
    End If
End Property

Public Property Get ReportID() As Long
    ReportID = mvarReportID
End Property

'帐表名称
Public Property Let ReportName(ByVal vData As String)
    mvarReportName = vData
End Property

Public Property Get ReportName() As String
    ReportName = mvarReportName
End Property

'帐表大类
Public Property Let ReportStyle(ByVal vData As Byte)
    mvarReportStyle = vData
End Property

Public Property Get ReportStyle() As Byte
    ReportStyle = mvarReportStyle
End Property

'帐表类型
Public Property Let ReportType(ByVal vData As AcntBookType)
    mvarReportType = vData
End Property

Public Property Get ReportType() As AcntBookType
    ReportType = mvarReportType
End Property

'帐表对应的视图名称
Public Property Get ViewName() As String
    ViewName = mvarViewName
End Property

'表间连接条件
Public Property Get UnionWhere() As String
    UnionWhere = mstrUnionWhere
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''
'                列表设置类方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''

'按用户ID重新保存一份列表
Private Sub AddReport()
  Dim rstReport As rdoResultset
  Dim strSql As String, strFixCond As String
  Dim lngReportID As Long
  Dim clsFormat As ClsFormatset

    strSql = "Select strExtraCond From Report Where lngReportID=" & mvarReportID
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rstReport
       If Not .EOF Then
          strFixCond = Trim(IIf(IsNull(!strExtraCond), "", !strExtraCond))
       End If
    End With
    Set rstReport = Nothing
    
    '关闭表触发器
    strSql = "Alter Table Report Disable All Triggers"
    gclsBase.BaseDB.Execute (strSql)
    
    strSql = "Select * from Report"
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    With rstReport
       .AddNew
          lngReportID = BillPublic.GetNewID("Report")
          !lngReportID = lngReportID
          
          !lngViewId = mvarViewID
          !strReportName = mvarReportName
          !lngOperatorID = gclsBase.OperatorID
          !bytPrep = 2
          !bytWizard = 1
          !lngParentId = mlngParentID
          !intLevel = mintParentLevel + 1
          !blnIsDetail = 1
          !bytAccountType = mvarReportType
          !bytGroup = mbytGroup
          !intGridTop = mvarGridTop
          !strDate = Format(gclsBase.BaseDate, "yyyy-mm-dd")
          Set clsFormat = New ClsFormatset
          !lngPrintSetupID = StandardReport.GetPrintSetupID(1, mvarReportID)
          mlngPrintSetID = !lngPrintSetupID
          !bytVersion = gVersionType
          !intDirection = mintDirect
          !strExtraCond = IIf(strFixCond = "", " ", strFixCond)
          !lngPaperID = mlngPaperID
          
       .Update
    End With
    
    '打开表触发器
    strSql = "Alter Table Report Enable All Triggers"
    gclsBase.BaseDB.Execute (strSql)
    
    CopyReportField (lngReportID)
    mvarReportID = lngReportID
    EditUpdate
End Sub

'Copy All ListField
Private Sub CopyReportField(lngReportID As Long)
  Dim strSql As String
  Dim rstSource As rdoResultset, rstDesc As rdoResultset
  Dim fldReportField As rdoColumn
  Dim colNo As Collection
  Dim intCount As Integer
     
     Set colNo = New Collection
     For intCount = 1 To mvarColumns
        colNo.Add intCount, mvarColumnDesc(intCount)
     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)
     
     With rstSource
         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("lngReportFieldNO") Then
                        On Error Resume Next
                        rstDesc!lngReportFieldNO = colNo.Item(!strReportFieldDesc)
                        On Error GoTo 0
                    Else
                        If UCase(fldReportField.Name) <> UCase("lngReportFieldId") Then
                            rstDesc.rdoColumns(fldReportField.Name).Value = fldReportField.Value
                        Else
                            rstDesc.rdoColumns(fldReportField.Name).Value = BillPublic.GetNewID("ReportField")
                        End If
                    End If
                End If
            Next
            rstDesc.Update
            .MoveNext
         Loop
     End With
     Set rstDesc = Nothing
     Set rstSource = Nothing
     Set colNo = Nothing
End Sub

'保存列表修改结果
Public Function SaveList(Optional ByVal IsSaveAs As Boolean = False) As Boolean
    MsgForm.PleaseWait "正在保存数据，请稍候．．．"
    If mbytPrep = 0 Or IsSaveAs Then
        AddReport
        mbytPrep = 2
    Else
        EditUpdate
    End If
    SaveList = True
    Unload MsgForm
End Function

'更新用户自定义帐表的修改
Private Sub EditUpdate()
  Dim strSql As String
  Dim intCount As Integer
  
  'Update Report
  strSql = "UPDATE Report Set intGridTop=" & mvarGridTop & ", bytAccountType=" & mvarReportType & _
           ",intDirection=" & mintDirect & ",strReportName='" & mvarReportName & _
           "',lngPaperID=" & mlngPaperID & _
           " WHERE lngReportID =" & mvarReportID
    
  gclsBase.ExecSQL strSql
  
  
  'Set All Choosed Flag to False
  strSql = "UPDATE ReportField Set blnIsChoosed=0,blnIsHeaded=0 WHERE lngReportID =" & mvarReportID
    
  gclsBase.ExecSQL strSql
  
  'Save Now Choosed Field
  For intCount = 1 To mvarColumns
      strSql = "Update ReportField" & " Set lngReportFieldNO=" & intCount & ",strReportFieldDesc='" & mvarColumnDesc(intCount) & _
                        "',lngDisplayWidth=" & mvarColumnWidth(intCount) & _
                        ",bytSort=" & mvarColumnOrderType(intCount) & _
                        ",blnIsChoosed=1 Where lngReportId=" & mvarReportID & " And lngViewFieldId=" & mvarColumnFieldID(intCount)
      gclsBase.ExecSQL strSql
  Next intCount
  
  For intCount = 1 To mvarHeadFields
      strSql = "Update ReportField" & " Set blnIsHeaded=1" & _
               ",lngDisplayTop=" & mvarHeadTop(intCount) & _
               ",lngDisplayLeft=" & mvarHeadLeft(intCount) & _
               ",lngDisplayHeight=" & mvarHeadHeight(intCount) & _
               ",bytCodeShow=" & mbytCodeShowType(intCount) & _
               ",lngDisplayWidth=" & mvarHeadWidth(intCount) & ",intAlign=" & mvarHeadAlign(intCount) & _
               " Where lngReportId=" & mvarReportID & " And lngViewFieldId=" & mvarHeadFieldId(intCount)
      gclsBase.ExecSQL strSql
  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