report.bas

金算盘软件代码

Attribute VB_Name = "Report"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  帐表模块
'  作者：魏然
'  日期：1998.05.30
'
'  ShowBookManage               显示帐表资源管理器
'  ShowAcntBook                 显示三栏帐
'  ShowMultiAcntBook            显示多栏帐
'  ShowStandardReport           显示标准表
'  ShowCrossReport              显示交叉表
'  ShowListReport               显示列表
'  ShowAgeReport                显示帐龄分析表
'  ShowFinanceReport            显示财务分析表
'  ShowBookWizard               显示帐册向导(三栏)
'  ShowMultiBookWizard          显示多栏帐向导
'  ShowStandardWizard           显示标准表向导
'  ShowCrossWizard              显示交叉表向导
'  ShowListWizard               显示列表向导
'  ShowFinanceWizard            显示财务分析表向导
'  ShowAgeWizard                显示帐龄分析表向导
'
'  DelReportInfo                删除表的附加信息
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Public Enum CodeType
     ctAccount = 1                '科目
     ctcustomer = 2               '单位
     ctDepartment = 4             '部门
     ctEmployee = 8               '职员
     ctJob = 16                   '工程
     ctClass1 = 32                '统计
     ctClass2 = 64                '项目
     ctItem = 128                 '商品
     ctFixed = 256                '固定资产
     ctCurrency = 512             '币种
     ctOperator = 1024            '操作员
     ctPosition = 2048            '货位
     ctCustom0 = 4096             '自定义项目0
     ctCustom1 = 8192             '自定义项目1
     ctCustom2 = 32768            '自定义项目2
     ctCustom3 = 65536            '自定义项目3
     ctCustom4 = 131072           '自定义项目4
     ctCustom5 = 262144           '自定义项目5
     ctTerm = 524288              '付款条件
     ctSalaryTable = 1048576      '工资表
     ctVoucherType = 2097152      '凭证类型
     ctItemArea = 4194304
     ctItemType = 8388608
End Enum

Public Enum ReportType
    rtDudgetDetail = 1     '工程预算批复明细表
    rtContract = 2         '合同汇总表
    rtRatifyDetail = 3     '批复明细表
    rtPayDetail = 4        '合同付款明细表
    rtPayPlan = 5          '合同付款计划明细表
End Enum

Public Enum AcntBookType
    msgNot = 0
    msgDay = 1                              '日记帐
    msgDetail = 2                           '明细帐
    msgTotal = 3                            '总帐
End Enum

Public gcolContract As New Collection
Public glngContract As Long

'取套打时年份的位置
Public Function GetYearPos(ByVal PaperID As Long, lngTop As Long, lngLeft As Long, lngWidth As Long, lngHeight As Long)
  Dim strSql As String, rstPos As rdoResultset
     strSql = "Select lngDisplayTop,lngDisplayLeft,lngDisplayHeight,lngDisplayWidth From ReportPaper Where lngPaperID=" & PaperID
     Set rstPos = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
     With rstPos
        If Not .EOF Then
           lngTop = !lngdisplaytop
           lngLeft = !lngDisplayLeft
           lngWidth = !lngDisplayWidth
           lngHeight = !lngDisplayHeight
        End If
     End With
End Function

'新建帐套时更新建表日期
Public Sub ReSetReportDate()
  Dim strSql As String
     On Error Resume Next
     strSql = "Update Report Set strDate='" & Format(gclsBase.BeginDate, "YYYY-MM-DD") & "'"
     gclsBase.BaseDB.Execute strSql
End Sub

'帐表名称是否包含非法字符
'CludeBracket:括号是否作为非法字符
Public Function NameIsErr(ByVal TName As String, Optional ErrString As String = "", Optional CludeBracket As Boolean = True) As Boolean
   Dim strErr As String
   Dim intCount As Integer
   
   If CludeBracket Then
      strErr = " ~!,#'()[]+*/?\.`|·="
   Else
      strErr = " ~!,#'[]+*/?\.`|·="
   End If
   For intCount = 1 To Len(TName)
      If InStr(1, strErr, Mid(TName, intCount, 1)) > 0 Then
        NameIsErr = True
        ErrString = Mid(TName, intCount, 1)
        Exit Function
      End If
   Next intCount
End Function

'显示快捷帐册
Public Sub ShowQuickBook(Optional ByVal BookType As AcntBookType = msgDetail, Optional ByVal AccountID As Long = 0)
   On Error Resume Next
   ShowAcntBook 122, 5, , , BookType, AccountID
End Sub

'现金日记帐
Public Sub ShowCashDaily(Optional ByVal BookType As AcntBookType = msgDetail, Optional ByVal AccountID As Long = 0)
   On Error Resume Next
   If UserRight.IsCanDo(49, gclsBase.OperatorID) Then
        ShowAcntBook 198, 4, , , BookType, AccountID
   End If
End Sub

'显示银行存款日记帐
Public Sub ShowBankDaily(Optional ByVal BookType As AcntBookType = msgDetail, Optional ByVal AccountID As Long = 0)
   On Error Resume Next
    If UserRight.IsCanDo(49, gclsBase.OperatorID) Then
        ShowAcntBook 199, 360, , , BookType, AccountID
    End If
End Sub

'显示应收帐款
Public Sub ShowReceiveBook(Optional ByVal BookType As AcntBookType = msgDetail, Optional ByVal CustomerID As Long = 0)
   On Error Resume Next
   If UserRight.IsCanDo(37, gclsBase.OperatorID) Then
        ShowAcntBook 125, 2, , , BookType, , CustomerID
   End If
End Sub

'显示应付帐款
Public Sub ShowPayBook(Optional ByVal BookType As AcntBookType = msgDetail, Optional ByVal CustomerID As Long = 0)
   On Error Resume Next
   If UserRight.IsCanDo(40, gclsBase.OperatorID) Then
        ShowAcntBook 126, 359, , , BookType, , CustomerID
   End If
End Sub

'显示库存商品帐
Public Sub ShowStockBook(Optional ByVal BookType As AcntBookType = msgDetail, Optional ByVal CustomerID As Long = 0)
   On Error Resume Next
        ShowAcntBook 127, 100, , , BookType, , CustomerID
End Sub

'显示委托加工商品帐
Public Sub ShowMakeBook(Optional ByVal BookType As AcntBookType = msgDetail, Optional ByVal CustomerID As Long = 0)
   On Error Resume Next
        ShowAcntBook 166, 176, , , BookType, , CustomerID
End Sub

'显示委托代销商品帐
Public Sub ShowReSaleBook(Optional ByVal BookType As AcntBookType = msgDetail, Optional ByVal CustomerID As Long = 0)
   On Error Resume Next
        ShowAcntBook 197, 178, , , BookType, , CustomerID
End Sub

'显示受托代销商品帐
Public Sub ShowTrustSaleBook(Optional ByVal BookType As AcntBookType = msgDetail, Optional ByVal CustomerID As Long = 0)
   On Error Resume Next
   ShowAcntBook 161, 174, , , BookType, , CustomerID
End Sub

'显示分期付款发生商品帐
Public Sub ShowPeriodBook(Optional ByVal BookType As AcntBookType = msgDetail, Optional ByVal CustomerID As Long = 0)
   On Error Resume Next
   ShowAcntBook 163, 175, , , BookType, , CustomerID
End Sub

'显示帐表资源管理器
Public Sub ShowBookManage(ByVal strKey As String)
   On Error Resume Next
   frmResManage.Show
   frmResManage.SetMnuIndex strKey
   If frmResManage.WindowState = vbMinimized Then
       frmResManage.WindowState = vbNormal
   End If
   frmResManage.ZOrder
End Sub

'显示三栏帐
Public Sub ShowAcntBook(ByVal lngReportID As Long, ByVal ViewId As Long, Optional clsReportSet As ReportSet = Nothing, Optional clsFormCond As FormCond, Optional ByVal BookType As AcntBookType = msgNot, Optional ByVal AccountID As Long = 0, _
                        Optional ByVal CustomerID As Long = 0, Optional DirectPrint As Boolean = False)
   Dim frmBook As New frmAcountBook
   
   If ViewId = 0 Then
      Screen.MousePointer = vbHourglass
      frmBook.ShowAcntBook lngReportID, ViewId, clsReportSet, clsFormCond, BookType, AccountID, CustomerID, DirectPrint
   Else
      If ReportRight(lngReportID, ViewId) Then
           Screen.MousePointer = vbHourglass
           frmBook.ShowAcntBook lngReportID, ViewId, clsReportSet, clsFormCond, BookType, AccountID, CustomerID, DirectPrint
      End If
   End If
End Sub

'显示多栏帐
Public Sub ShowMultiAcntBook(ByVal lngReportID As Long, ByVal ViewId As Long, Optional clsMultiReportSet As MultiReportSet = Nothing, Optional clsFormCond As FormCond)
  Dim frmBook As New frmMultiAccountBook
   
   If ViewId = 0 Then
      Screen.MousePointer = vbHourglass
      frmBook.ShowAcntBook lngReportID, ViewId, clsMultiReportSet, clsFormCond
   Else
      If ReportRight(lngReportID, ViewId) Then
           Screen.MousePointer = vbHourglass
           frmBook.ShowAcntBook lngReportID, ViewId, clsMultiReportSet, clsFormCond
      End If
   End If
End Sub

'显示标准表
Public Sub ShowStandardReport(ByVal lngReportID As Long, ByVal ViewId As Long, Optional clsReportSet As StandardReportSet = Nothing, Optional clsCrossSet As CrossSet = Nothing, Optional clsFromCond As FormCond)
    Dim frmBook As New frmStandardBook
    If ReportRight(lngReportID, ViewId) Then
         frmBook.ShowAcntBook lngReportID, ViewId, True, clsReportSet, clsCrossSet, clsFromCond
    End If
End Sub

'显示汇总表
Public Sub ShowSumReport(ByVal lngReportID As Long, ByVal ViewId As Long, Optional clsReportSet As ReportSumSet = Nothing, Optional clsFromCond As FormCond)
    Dim frmBook As New frmReportSumBook
    If ReportRight(lngReportID, ViewId) Then
        frmBook.ShowAcntBook lngReportID, ViewId, clsReportSet, clsFromCond
    End If
End Sub
'显示配款表
Public Sub ShowQuota(ByVal lngReportID As Long, ByVal ViewId As Long, Optional clsReportSet As QuotaSet = Nothing, Optional clsFromCond As FormCond)
  Dim frmBook As New frmQuotaBook
  If ReportRight(lngReportID, ViewId) Then
      frmBook.ShowAcntBook lngReportID, ViewId, clsReportSet, clsFromCond
  End If
End Sub

'显示余额表、科目汇总表、试算平衡表
Public Sub ShowBalance(ByVal lngReportID As Long, ByVal ViewId As Long, Optional clsReportSet As banreport = Nothing, Optional clsFromCond As FormCond, Optional ByVal CustomerID As Long = 0)
  Dim frmBook As New frmBanReport
  If ReportRight(lngReportID, ViewId) Then
      frmBook.ShowAcntBook lngReportID, ViewId, clsReportSet, clsFromCond, , , CustomerID
  End If
End Sub


'显示交叉表
Public Sub ShowCrossReport(ByVal lngReportID As Long, ByVal ViewId As Long, Optional clsReportSet As StandardReportSet = Nothing, Optional clsCrossSet As CrossSet = Nothing, Optional clsFromCond As FormCond)
  Dim frmBook As New frmStandardBook
  If ReportRight(lngReportID, ViewId) Then
       frmBook.ShowAcntBook lngReportID, ViewId, False, clsReportSet, clsCrossSet, clsFromCond
  End If
End Sub
'显示列表
Public Sub ShowListReport(ByVal lngReportID As Long, ByVal ViewId As Long, Optional clsReportSet As CrossSet = Nothing, Optional clsFromCond As FormCond)
  
End Sub


'显示帐龄分析表
Public Sub ShowAgeReport(ByVal lngReportID As Long, ByVal ViewId As Long, Optional clsAgeSet As Age = Nothing)
  Dim frmBook As New frmAgeReport
  If ReportRight(lngReportID, ViewId) Then
    frmBook.ShowAcntBook lngReportID, ViewId, clsAgeSet
  End If
End Sub

'显示财务分析表
Public Sub ShowFinanceReport(ByVal lngReportID As Long, ByVal ViewId As Long, Optional clsReportSet As FinanceReportWizard = Nothing, Optional clsFilter As FormCond = Nothing)
  Dim frmReport As New frmFinanceBook
   If ReportRight(lngReportID, ViewId) Then
        frmReport.ShowFinanceReport lngReportID, ViewId, clsReportSet, clsFilter
  End If
End Sub

'显示帐册向导(三栏)
'ParentId, ParentLevel 用于传递新增帐表时父节点的 ID、层次
Public Sub ShowBookWizard(ByVal lngReportID As Long, ByVal ViewId As Long, Optional ParentId As Long = 0, Optional ParentLevel As Integer = 0)
   Dim clsReportSet As New ReportSet
   
   If ReportRight(lngReportID, ViewId) Then
        Screen.MousePointer = vbHourglass
        clsReportSet.ShowReportSet lngReportID, ViewId, ParentId, ParentLevel
   End If
End Sub

'显示多栏帐向导
'ParentId, ParentLevel 用于传递新增帐表时父节点的 ID、层次
Public Sub ShowMultiBookWizard(ByVal lngReportID As Long, ByVal ViewId As Long, Optional ParentId As Long = 0, Optional ParentLevel As Integer = 0)
   Dim clsMultiReportSet As New MultiReportSet
   
   If ReportRight(lngReportID, ViewId) Then
        Screen.MousePointer = vbHourglass
        clsMultiReportSet.ShowMultiReportSet lngReportID, ViewId, ParentId, ParentLevel
   End If
End Sub
'显示配款表向导
Public Sub ShowQuotaWizard(ByVal lngReportID As Long, ByVal ViewId As Long, Optional ParentId As Long = 0, Optional ParentLevel As Integer = 0)
    Dim clsStandardReport As New QuotaSet
    If ReportRight(lngReportID, ViewId) Then
        clsStandardReport.ShowWizard lngReportID, ParentId, ParentLevel
    End If
End Sub
'显示标准表向导
Public Sub ShowStandardWizard(ByVal lngReportID As Long, ByVal ViewId As Long, Optional ParentId As Long = 0, Optional ParentLevel As Integer = 0)
    Dim clsStandardReport As New StandardReportSet
    clsStandardReport.ShowWizard lngReportID, ParentId, ParentLevel
End Sub

'显示汇总表向导
Public Sub ShowSumWizard(ByVal lngReportID As Long, ByVal ViewId As Long, Optional ParentId As Long = 0, Optional ParentLevel As Integer = 0)
   Dim clsStandardReport As New ReportSumSet
   clsStandardReport.ShowWizard lngReportID, ParentId, ParentLevel
End Sub

'显示交叉表向导
Public Sub ShowCrossWizard(ByVal lngReportID As Long, ByVal ViewId As Long, Optional ParentId As Long = 0, Optional ParentLevel As Integer = 0)