age.cls

金算盘软件代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Age"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'*******************************************************************************************
'*******                   帐龄分析查询向导类模块                               ************
'
'作者： 周成坤
'时间： 1998-07-03
'
'       金额计算公式： （原币金额 - 原币付款金额 [- 原币付款折扣]）× 原币汇率
'
'接口：
'
' 1.Public Function ShowWizard(ByVal lngReportId As Long, ByVal lngViewId As Long,
'                                    Optional lngParentId As Long = 0,
'                                    Optional intParentLevel As Integer = 0) As Boolean
'   功    能：  调用帐龄分析查询向导对类模块的属性进行设置或修改
'   参数说明：  lngReportId :   报表ID
'               lngViewId   :   报表对应视图ID，为 2 则是应收查询，为 3 则是应付查询
'               lngParentId :   父节点ID
'               intParentLevel: 父节点层次
'   返   回：   True    :   确认向导的设置
'               False   :   取消向导的设置
'
'
' 2.Public Function GetAgeReportSet(ByVal lngReportId As Long, ByVal ReportViewID As Long)
'                               As String
'
'   功    能：  返回已保存帐龄分析报表的条件、栏目和 SQL 语句
'   参数说明：  lngReportId     :   报表ID
'               ReportViewID    :   报表对应视图ID
'   返    回：  SQL 语句
'
'
' 3.Public Function SaveWizard() As Boolean
'
'   功    能：  保存当前报表的名称、分析日期和截止日期条件、帐龄区间、显示栏目等
'   返    回：  True    :   保存成功
'               False   :   保存不成功
'
' 4.Public Function GetReportSQL() As Boolean
'   功    能：  仅修改了“分析日期”或“截止日期”时重置 SQL 语句，在报表显示窗体中调用
'
'*********************************************************************************************
'*********************************************************************************************

Option Explicit

'属性
Private mvarReportVersionNumber As Byte '总的版本号
Private mvarAgeReportID As Long         '报表ID
Private mvarAgeViewID As Integer        '报表视图ID
Private mvarAgeName As String           '报表名称
Private mvarSQLString As String         'SQL 语句
Private mvarParentID As Long            '父节点ID
Private mvarParentLevel As Integer      '父节点层次

Private mvarColDesc() As String         '栏目字段描述
Private mvarColTable() As String        '栏目字段所在表名
Private mvarColName() As String         '栏目字段名称
Private mvarColType() As Byte           '栏目字段类型
Private mvarColNumber As Integer        '栏目数
Private mvarColIsChoosed() As Boolean   '栏目选择标志
Private mvarColWidth() As Long          '栏目显示宽度
Private mvarColOrderType() As Byte      '栏目排序方式
Private mvarColIsFixed() As Boolean     '是否固定栏目
Private mvarColFieldID() As Long        '栏目视图ID
Private mvarColGrouped() As Boolean     '栏目是否分组排序
Private mvarColFieldSize() As Byte      '栏目字段宽度
Private mvarColVersionType() As Byte    '字段版本号
Private mvarIsGrouped As Boolean        '合计汇总标志
Private mvarColGroup As String          '合计汇总列

'Private mvarIsCleared As Boolean        '分析未两清往来明细
Private mvarDataType As Long            '分析数据范围 0:所有 1:未核销 2:多付款

Private mvarAgeStartDate As String      '分析日期
Private mvarAgeEndDate As String        '截止日期
Private mvarAgeDateDesc As String       '分析日期描述

Private mvarPeriodName() As String      '帐龄区间名称
Private mvarPeriodDay() As Integer      '帐龄区间天数
Private mvarPeriodNumber As Integer     '帐龄区间数目

Private mvarYearMonth() As String       '选应收帐龄天数后，计算期间的集合
Private mvarYearMonthNumber As Integer  '选应收帐龄天数后，计算期间数
Private mHaveChooseZLTS As Boolean      '是否已选应收帐龄天数，
                                        '仅当应收帐龄汇总表

Dim mlngID As Long
Dim blnIsNew, blnPeriodIsInited As Boolean
Dim mbytPrep As Byte

'SQL语句组成：SELECT1 + FROM1 + WHERE1 + GROUPBY

Dim mstrSelect1 As String                          'SELECT 子句
Dim mstrFrom1 As String       'FROM 子句
Dim mstrWhere1 As String, mstrWhere As String     'WHERE 子句
Dim mstrWhereJoin As String    'WHERE 子句中的连结字句
Dim mstrChinseseWhere As String    '汉语条件子句
Dim mstrGroupBy1 As String                         'GROUP BY 子句
Dim mstrOrderBy As String                           'ORDER BY 子句

Dim mblnOnlyDateChanged As Boolean                  '仅有时间条件被修改

'显示格式
Private mvarDivide As Boolean                       '除以1000标志
Private mvarShowCent As Boolean                     '显示小数标志
Private mvarShowZero As Boolean                     '显示0标志
Private mvarShowNegivate As Byte                    '负数处理

'打印设置
Private mvarPrintOrient As Long                     '打印方向
Private mvarPrintID As Long                         '打印ID
Private mvarPrintLength As Long                     '纸张长度
Private mvarPrintWidth As Long                      '纸张宽度

Private mvarHeadColumns As Integer                    '已选表头栏目数
Private mvarHeadDesc() As String                      '表头栏目说明
Private mvarHeadFuncIndex() As Integer                '表头栏目涵数索引
Private mvarHeadWidth() As Long                       '表头栏目宽度
Private mvarHeadHeight() As Long                      '表头栏目高度
Private mvarHeadLeft() As Long                        '表头栏目左间距
Private mvarHeadTop() As Long                         '表头栏目上间距
Private mvarHeadAlign() As Integer                    '表头栏目对齐方式
Private mvarTailColumns As Integer                    '已选表尾栏目数
Private mvarTailDesc() As String                      '表尾栏目说明
Private mvarTailFuncIndex() As Integer                '表尾栏目涵数索引
Private mvarTailWidth() As Long                       '表尾栏目宽度
Private mvarTailHeight() As Long                      '表尾栏目高度
Private mvarTailLeft() As Long                        '表尾栏目左间距
Private mvarTailTop() As Long                         '表尾栏目上间距
Private mvarTailAlign() As Integer                    '表尾栏目对齐方式
Private mvarTitleWidth As Long                        '报表标题宽度
Private mvarTitleHeight As Long                       '报表标题高度
Private mvarTitleLeft As Long                         '报表标题左间距
Private mvarTitleTop As Long                          '报表标题上间距
Private mvarTitleAlign As Integer                     '报表标题对齐方式

Private mvarIsNewWizard As Boolean                      '新建报表
Private mvarGroupNo As Byte                             '报表组号
Private mvarGridTop As Integer                          '数据区顶点
Private mvarPre As Long                                 '预置表号
Private strCondVersionField As String                   '版本号条件
Private mstrAmount As String                            '原币或者本位币字段名(dblAmount or dblCurrAmount
Private mbytExpandStyle As Byte                         '币种ID号,1:本位币
Private mblnIsARR As Boolean                            '应收帐表标志
Private mintDataColumns As Integer                      '可选栏目中的非固定列数目
Private mblnIsHeadCol() As Boolean                      '可选栏目中的非固定列标志

Public Property Let IsHeadCol(ByVal intColumnIndex As Integer, ByVal vData As Boolean)
    mblnIsHeadCol(intColumnIndex) = vData
End Property
Public Property Get IsHeadCol(ByVal intColumnIndex As Integer) As Boolean
    IsHeadCol = mblnIsHeadCol(intColumnIndex)
End Property

Public Property Let DataColumns(ByVal vData As Integer)
    mintDataColumns = vData
End Property
Public Property Get DataColumns() As Integer
    DataColumns = mintDataColumns
End Property


Public Property Get HaveChooseZLTS() As Boolean
    HaveChooseZLTS = mHaveChooseZLTS
End Property
Public Property Get YearMonthNumber() As Long
    YearMonthNumber = mvarYearMonthNumber
End Property

Public Property Let CurrencyID(ByVal vData As Byte)
    mbytExpandStyle = vData
End Property

Public Property Get CurrencyID() As Byte
    CurrencyID = IIf(mbytExpandStyle <= 0, 0, mbytExpandStyle)
    If CurrencyID = 0 Or CurrencyID = 1 Then
        If mvarDataType = 1 Then
            mstrAmount = "dblAmount-dblPaymentAmount"
        ElseIf mvarDataType = 2 Then
            mstrAmount = IIf(mblnIsARR, "Decode(blnIsDebit,1,1,0)*", "Decode(blnIsDebit,1,0,1)*") & "(dblAmount-dblPaymentAmount)"
        Else
            mstrAmount = "dblAmount"
        End If
    Else
        If mvarDataType = 1 Then
            mstrAmount = "dblCurrAmount-dblCurrPaymentAmount"
        ElseIf mvarDataType = 2 Then
            mstrAmount = IIf(mblnIsARR, "decode(blnIsDebit,1,1,0)*", "Decode(blnIsDebit,1,0,1)*") & "(dblCurrAmount-dblCurrPaymentAmount)"
        Else
            mstrAmount = "dblCurrAmount"
        End If
    End If
'    CurrencyID = IIf(mbytExpandStyle <= 0, 0, mbytExpandStyle)
'    If CurrencyID = 0 Or CurrencyID = 1 Then
'        If IsCleared = True Then
'            mstrAmount = "dblAmount-dblPaymentAmount"
'        Else
'            mstrAmount = "dblAmount"
'        End If
'    Else
'        If IsCleared = True Then
'            mstrAmount = "dblCurrAmount-dblCurrPaymentAmount"
'        Else
'            mstrAmount = "dblCurrAmount"
'        End If
'    End If
End Property
Public Property Let Currencys(ByVal vData As String)
    mstrAmount = vData
End Property

Public Property Get Currencys() As String
    Currencys = mstrAmount
End Property
Public Property Get ChineseCond() As String
    ChineseCond = mstrChinseseWhere
End Property

'数据区顶点
Public Property Let GridTop(ByVal vData As Integer)
    mvarGridTop = vData
End Property

Public Property Get GridTop() As Integer
    GridTop = mvarGridTop
End Property

'报表组号
Public Property Let GroupNo(ByVal vData As Byte)
    mvarGroupNo = vData
End Property

Public Property Get GroupNo() As Byte
    GroupNo = mvarGroupNo
End Property

'是否新建报表
Public Property Let IsNewWizard(ByVal vData As Boolean)
    mvarIsNewWizard = vData
End Property


Public Property Get IsNewWizard() As Boolean
    IsNewWizard = mvarIsNewWizard
End Property


'已选表头栏目数
Public Property Let HeadColumns(ByVal vData As Integer)
    mvarHeadColumns = vData
    If mvarHeadColumns = 0 Then Exit Property
    ReDim Preserve mvarHeadDesc(mvarHeadColumns - 1)
    ReDim Preserve mvarHeadFuncIndex(mvarHeadColumns - 1)
    ReDim Preserve mvarHeadWidth(mvarHeadColumns - 1)
    ReDim Preserve mvarHeadHeight(mvarHeadColumns - 1)
    ReDim Preserve mvarHeadLeft(mvarHeadColumns - 1)
    ReDim Preserve mvarHeadTop(mvarHeadColumns - 1)
    ReDim Preserve mvarHeadAlign(vData - 1)
End Property

Public Property Get HeadColumns() As Integer
    HeadColumns = mvarHeadColumns
End Property

'表头栏目说明
Public Property Let HeadDesc(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarHeadDesc(ColumnIndex) = vData
End Property

Public Property Get HeadDesc(ByVal ColumnIndex As Integer) As String
    HeadDesc = mvarHeadDesc(ColumnIndex)
End Property

'表头栏目涵数索引
Public Property Let HeadFuncIndex(ByVal ColumnIndex As Integer, ByVal vData As Integer)
    mvarHeadFuncIndex(ColumnIndex) = vData
End Property

Public Property Get HeadFuncIndex(ByVal ColumnIndex As Integer) As Integer
    HeadFuncIndex = mvarHeadFuncIndex(ColumnIndex)
End Property

'表头栏目宽度
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 HeadHeight(ByVal ColumnIndex As Integer, ByVal vData As Long)
    mvarHeadHeight(ColumnIndex) = vData
End Property

Public Property Get HeadHeight(ByVal ColumnIndex As Integer) As Long
    HeadHeight = mvarHeadHeight(ColumnIndex)
End Property

'表头栏目左间距
Public Property Let HeadLeft(ByVal ColumnIndex As Integer, ByVal vData As Long)
    mvarHeadLeft(ColumnIndex) = vData
End Property

Public Property Get HeadLeft(ByVal ColumnIndex As Integer) As Long
    HeadLeft = mvarHeadLeft(ColumnIndex)
End Property

'表头栏目上间距
Public Property Let HeadTop(ByVal ColumnIndex As Integer, ByVal vData As Long)
    mvarHeadTop(ColumnIndex) = vData
End Property

Public Property Get HeadTop(ByVal ColumnIndex As Integer) As Long
    HeadTop = mvarHeadTop(ColumnIndex)
End Property
'表头栏目对齐方式
Public Property Let HeadAlign(ByVal ColumnIndex As Integer, ByVal vData As Integer)
    mvarHeadAlign(ColumnIndex) = vData
End Property

Public Property Get HeadAlign(ByVal ColumnIndex As Integer) As Integer
    HeadAlign = mvarHeadAlign(ColumnIndex)
End Property

'已选表尾栏目数
Public Property Let TailColumns(ByVal vData As Integer)
    mvarTailColumns = vData
    If mvarTailColumns = 0 Then Exit Property
    ReDim Preserve mvarTailDesc(mvarTailColumns - 1)
    ReDim Preserve mvarTailFuncIndex(mvarTailColumns - 1)
    ReDim Preserve mvarTailWidth(mvarTailColumns - 1)
    ReDim Preserve mvarTailHeight(mvarTailColumns - 1)
    ReDim Preserve mvarTailLeft(mvarTailColumns - 1)
    ReDim Preserve mvarTailTop(mvarTailColumns - 1)
    ReDim Preserve mvarTailAlign(vData - 1)
End Property

Public Property Get TailColumns() As Integer
    TailColumns = mvarTailColumns
End Property

'表尾栏目说明
Public Property Let TailDesc(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarTailDesc(ColumnIndex) = vData
End Property