multireportset.cls

金算盘软件代码

    Columns = mvarColumns
End Property

'多栏帐展开方式
Public Property Let ExpandStyle(ByVal vData As Integer)
    mvarExpandStyle = vData
End Property

Public Property Get ExpandStyle() As Integer
    ExpandStyle = mvarExpandStyle
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

'子栏目数
Public Property Let SubColumns(ByVal vData As Integer)
    mvarSubColumns = vData
    ReDim mvarSubDesc(mvarSubColumns)
    ReDim mvarSubCond(mvarSubColumns)
    ReDim mvarSubCode(mvarSubColumns)
    ReDim mvarSubData(mvarSubColumns)
    ReDim mvarSubDirect(mvarSubColumns)
    ReDim mvarSubAmountWidth(mvarSubColumns)
    ReDim mvarSubQuantityWidth(mvarSubColumns)
    ReDim mvarSubCurrencyWidth(mvarSubColumns)
End Property

Public Property Get SubColumns() As Integer
    SubColumns = mvarSubColumns
End Property

'子栏目金额宽度
Public Property Let SubAmountWidth(ByVal ColumnIndex As Integer, ByVal vData As Long)
    mvarSubAmountWidth(ColumnIndex) = vData
End Property

Public Property Get SubAmountWidth(ByVal ColumnIndex As Integer) As Long
    SubAmountWidth = mvarSubAmountWidth(ColumnIndex)
End Property

'子栏目数量宽度
Public Property Let SubQuantityWidth(ByVal ColumnIndex As Integer, ByVal vData As Long)
    mvarSubQuantityWidth(ColumnIndex) = vData
End Property

Public Property Get SubQuantityWidth(ByVal ColumnIndex As Integer) As Long
    SubQuantityWidth = mvarSubQuantityWidth(ColumnIndex)
End Property

'子栏目外币宽度
Public Property Let SubCurrencyWidth(ByVal ColumnIndex As Integer, ByVal vData As Long)
    mvarSubCurrencyWidth(ColumnIndex) = vData
End Property

Public Property Get SubCurrencyWidth(ByVal ColumnIndex As Integer) As Long
    SubCurrencyWidth = mvarSubCurrencyWidth(ColumnIndex)
End Property

'子栏目说明
Public Property Let SubDesc(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarSubDesc(ColumnIndex) = vData
End Property

Public Property Get SubDesc(ByVal ColumnIndex As Integer) As String
    SubDesc = mvarSubDesc(ColumnIndex)
End Property

'子栏目条件(ID)
Public Property Let SubCond(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarSubCond(ColumnIndex) = vData
End Property

Public Property Get SubCond(ByVal ColumnIndex As Integer) As String
    SubCond = mvarSubCond(ColumnIndex)
End Property

'子栏目条件(Code)
Public Property Let SubCode(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarSubCode(ColumnIndex) = vData
End Property

Public Property Get SubCode(ByVal ColumnIndex As Integer) As String
    SubCode = mvarSubCode(ColumnIndex)
End Property

'子栏目数据类型
Public Property Let SubData(ByVal ColumnIndex As Integer, ByVal vData As Byte)
    mvarSubData(ColumnIndex) = vData
End Property

Public Property Get SubData(ByVal ColumnIndex As Integer) As Byte
    SubData = mvarSubData(ColumnIndex)
End Property

'子栏目方向
Public Property Let SubDirect(ByVal ColumnIndex As Integer, ByVal vData As Integer)
    mvarSubDirect(ColumnIndex) = vData
End Property

Public Property Get SubDirect(ByVal ColumnIndex As Integer) As Integer
    SubDirect = mvarSubDirect(ColumnIndex)
End Property

'取 WHERE 子句
Public Property Get WhereOfSql() As String
    WhereOfSql = mvarWhere
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 From View1 Where lngViewId=" & mvarViewID, rdOpenStatic)
    If Not rstView.EOF Then
        mvarViewName = rstView!strViewName
        mvarFrom = " From " & rstView!strViewSQL
        mstrUnionWhere = rstView.rdoColumns("strViewWhere").GetChunk(2048)
    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,strReportName,bytAccountType,bytPrep,bytGroup,intLevel,bytExpandStyle,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
        mlngPaperID = IIf(IsNull(rstReport!lngPaperID), 0, rstReport!lngPaperID)
        If mlngParentID = 0 Then
            mlngParentID = rstReport!lngParentId
            mintParentLevel = rstReport!intLevel
            mvarExpandStyle = rstReport!bytExpandStyle
        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 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
  Dim lngReportID As Long
  Dim clsFormat As ClsFormatset

    '关闭表触发器
    strSql = "Alter Table Report Disable All Triggers"
    gclsBase.BaseDB.Execute (strSql)
    
    'Add List
    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 = 2
          !lngParentId = mlngParentID
          !intLevel = mintParentLevel + 1
          !blnIsDetail = 1
          !bytExpandStyle = mvarExpandStyle
          !bytAccountType = mvarReportType
          !bytGroup = mbytGroup
          !intGridTop = mvarGridTop
          !strDate = Format(gclsBase.BaseDate, "YYYY-MM-DD")
          Set clsFormat = New ClsFormatset
          !lngPrintSetupID = GetPrintSetupID(1, mvarReportID)
          mlngPrintSetID = !lngPrintSetupID
          !bytVersion = gVersionType
          !intDirection = mintDirect
          !lngPaperID = mlngPaperID
   .Update
    End With
    
    '打开表触发器
    strSql = "Alter Table Report Enable All Triggers"
    gclsBase.BaseDB.Execute (strSql)
    
    CopyReportField (lngReportID)
    SaveSub 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)
                    Else
                        If UCase(fldReportField.Name) = UCase("blnIsChoosed") Then
                           'Stop
                        End If
                        If UCase(fldReportField.Name) = UCase("strReportFieldDesc") Then
                           'Stop
                        End If
                        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 SaveWidth(arrWidth As Variant) As Boolean
  Dim strSql As String
  Dim intCount As Integer
  
    strSql = "Delete  From ReportSpecialColumn Where lngReportID=" & mvarReportID
    gclsBase.BaseDB.Execute strSql
    For intCount = 1 To UBound(arrWidth)
       strSql = "Insert Into ReportSpecialColumn (lngReportID,intColumndNo,lngColumndWidth) VALUES (" & mvarReportID & "," & intCount & "," & arrWidth(intCount) & ")"
       gclsBase.BaseDB.Execute strSql
    Next intCount
End Function

'保存列表修改结果
Public Function SaveMulti(Optional ByVal IsSaveAs As Boolean = False) As Boolean
    #If conDebug = 0 Then
       MsgForm.PleaseWait "正在保存数据，请稍候．．．"
    #End If
    If mbytPrep = 0 Or IsSaveAs Then
        AddReport
        mbytPrep = 2
    Else
        EditUpdate
        SaveSub mvarReportID
    End If
    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 & ",strReportName='" & _
           mvarReportName & "',intDirection=" & mintDirect & ",bytExpandStyle=" & mvarExpandStyle & _
           ",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

'保存子栏目设置
Private Sub SaveSub(ByVal ReportID As Long)
  Dim strSql As String
  Dim intCount As Integer
  Dim rstSub As rdoResultset