clstag.cls

VB开发的ERP系统

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsTag"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'*********************************************************************
'*    模 块 名 称 :基本指标分析类模块
'*    功 能 描 述 :
'*    程序员姓名  :白石军
'*    最后修改人  :
'*    最后修改时间:2002/1/21
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'*
'*********************************************************************

Option Explicit
'------------------------------------------------------------------
Private Const compDate = &H100              '比较期
Private Const baseDate = &H200              '本期
Private Const firstDate = &H300             '年初
Private Enum FLAG_DATE
    COMP_DATE = compDate
    BASE_DATE = baseDate
    FIRST_DATE = firstDate
End Enum

Private myDate As FLAG_DATE                 '期间标识（年初，比较期，本期）
'-----------------------------------------------------------------
Private clsmyBal As New clsBal              '资产负债表类
Private clsmyInc As New clsInc              '损益表类
'-----------------------------------------------------------------
Private SumRs As New ADODB.Recordset        '科目总帐表记录集
Private CodeRs As New ADODB.Recordset       '科目表记录集
Private BalRs As New ADODB.Recordset        '报表设置中的资产负债表
Private IncRs As New ADODB.Recordset        '报表设置中的损益表
Private TagRs As New ADODB.Recordset        '指标设置表
'------------------------------------------------------------------
Private iThisYear As Integer                '本年
Private iCompYear As Integer                '比较期年

Private iThisMonthBegin As Integer          '本期间首月
Private iThisMonthEnd As Integer            '本期间尾月

Private iCompMonthBegin As Integer          '比较期间首月
Private iCompMonthEnd As Integer            '比较期间尾月
'----------------------------------------------------------------
Private iYear As Integer                    '查询年
Private iMonthBegin As Integer              '查询月
Private iMonthEnd As Integer                '查询月
'------------------------------------------------------------------

Private strSubExp As String                 '当前资产负债表公式，用来保存用户设定的公式
Public iRecordCount As Integer              '数组记录条数
Private codeColl As New Collection          '公式中的科目集合

'----------股票数据--------------------
Private lrTextVal(5) As Single
'-----------------------------

Private Sub Class_Initialize()
    If DEBUG_FLAG = False Then On Error Resume Next
    Set CodeRs = Cw_DataEnvi.DataConnect.Execute("select * from Cwzz_AccCode") '科目表记录集
    Set BalRs = Cw_DataEnvi.DataConnect.Execute("select * from cwfx_BalanceInitial") '报表设置中的资产负债表
    Set IncRs = Cw_DataEnvi.DataConnect.Execute("select * from cwfx_IncomeCostInitial") '报表设置中的损益表
    Set TagRs = Cw_DataEnvi.DataConnect.Execute("select * from cwfx_TagInital where Selected=1") '指标设置表
    Call GetParm
    clsmyBal.Init Cw_DataEnvi.DataConnect
    clsmyInc.Init Cw_DataEnvi.DataConnect
End Sub

Private Sub GetParm()
    '得到查询参数
    If DEBUG_FLAG = False Then On Error Resume Next
    With Zbfx_BaseGuideLineSeach
        Select Case .Combo_Type.ListIndex
        Case 0                              '按年
            iThisYear = Xtyear                                                         '本年
            If .Combo_SelYear.ListIndex <> -1 And .Combo_SelYear.ListIndex <> 0 Then
                iCompYear = .Combo_SelYear.Text                                        '比较期年
            End If
            iThisMonthBegin = 1                                                        '本期间首月
            iThisMonthEnd = 12                                                         '本期间尾月
            
            iCompMonthBegin = 1                                                        '比较期间首月
            iCompMonthBegin = 12                                                       '比较期间尾月
        Case 1                              '按月
            iThisYear = Xtyear              '本年
            iThisMonthBegin = CInt(Right(.Combo_BaseDate.Text, 2))  '本期间首月
            iThisMonthEnd = iThisMonthBegin                         '本期间尾月
            If .Combo_CompDate.ListIndex <> -1 And .Combo_CompDate.Enabled = True Then
                iCompYear = .Combo_SelYear.Text                     '比较期年
                iCompMonthBegin = CInt(Right(.Combo_CompDate.Text, 2)) '比较期间首月
                iCompMonthEnd = iCompMonthBegin                     '比较期间尾月
            End If
        Case 2                              '按季
            iThisYear = Xtyear              '本年
            iThisMonthBegin = CInt(Mid(.Combo_BaseDate.Text, 6, 2)) '本期间首月
            iThisMonthEnd = CInt(Right(.Combo_BaseDate.Text, 2))    '本期间尾月
            If .Combo_CompDate.ListIndex <> -1 And .Combo_CompDate.Enabled = True Then
                iCompYear = .Combo_SelYear.Text
                iCompMonthBegin = CInt(Mid(.Combo_CompDate.Text, 6, 2)) '比较期间首月
                iCompMonthEnd = CInt(Right(.Combo_CompDate.Text, 2)) '比较期间尾月
            End If
        End Select
        
                                            '股票数据
        Dim i As Integer
        For i = .lrText.LBound To .lrText.UBound
            lrTextVal(i) = Val(.lrText(i).Text)
        Next
        
    End With
End Sub

Public Function MakeData() As Boolean
    '此过程为公共接口
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim i As Integer
    iRecordCount = TagRs.RecordCount - 1
    If iRecordCount < 0 Then
        MakeData = False
        Exit Function
    End If
    ReDim TagArry(iRecordCount)
    
    For i = 0 To iRecordCount
        With TagRs
            TagArry(i).strType = Trim(!RatioType)
            TagArry(i).strName = Trim(!RatioName)
            TagArry(i).strUnit = Trim(!Unit)
            
            '------------------------------------------------------------------------
            myDate = BASE_DATE              '本期
            iYear = iThisYear
            iMonthBegin = iThisMonthBegin
            iMonthEnd = iThisMonthEnd
            
            TagArry(i).sigCurrentV = MakeFormula(Trim(!RatioName))
            '------------------'比较期------------------------------------------------------
            If Zbfx_BaseGuideLineSeach.Combo_SelYear.ListIndex <> -1 And Zbfx_BaseGuideLineSeach.Combo_SelYear.ListIndex <> 0 Then '比较期
                iYear = iCompYear
                iMonthBegin = iCompMonthBegin
                iMonthEnd = iCompMonthEnd
                
                TagArry(i).sigComPareV = MakeFormula(Trim(!RatioName))
                
                If TagArry(i).sigComPareV <> 0 And TagArry(i).sigCurrentV <> 0 Then
                    TagArry(i).strTagAdd2 = ((TagArry(i).sigCurrentV - TagArry(i).sigComPareV) * 100 / TagArry(i).sigComPareV)
                End If
            End If
            '---------------------------------------------------------------------------
            myDate = FIRST_DATE             '年初
            TagArry(i).sigYearBeginV = MakeFormula(Trim(!RatioName))
            
            If TagArry(i).sigYearBeginV <> 0 And TagArry(i).sigCurrentV <> 0 Then
                TagArry(i).strTagAdd1 = ((TagArry(i).sigCurrentV - TagArry(i).sigYearBeginV) * 100 / TagArry(i).sigYearBeginV)
            End If
            '------------------------------------------------------------------------------
            .MoveNext
        End With
    Next
    MakeData = True
End Function

Private Function MakeFormula(ByVal strItem As String) As Double
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim dbl_TemValue As Double
    Select Case strItem
    Case "流动比率"
        dbl_TemValue = GetPeriodValue("流动负债合计", False)
        If dbl_TemValue <> 0 Then
            MakeFormula = GetPeriodValue("流动资产合计", False) / dbl_TemValue
        End If
    Case "速动比率"
        dbl_TemValue = GetPeriodValue("流动负债合计", False)
        If dbl_TemValue <> 0 Then
            MakeFormula = (GetPeriodValue("流动资产合计", False) - GetPeriodValue("存货", False)) / dbl_TemValue
        End If
    Case "存货周转率"
        dbl_TemValue = GetPeriodValue("存货", True)
        If dbl_TemValue <> 0 Then
            MakeFormula = GetPeriodValueInc("产品销售成本", False) / dbl_TemValue
        End If
    Case "存货周转天数"
        dbl_TemValue = GetPeriodValueInc("产品销售成本", False)
        If dbl_TemValue <> 0 Then
            With Zbfx_BaseGuideLineSeach
                Select Case .Combo_Type.ListIndex
                Case 0
                    MakeFormula = (360 / dbl_TemValue) * GetPeriodValue("存货", True)
                Case 1
                    MakeFormula = (360 / dbl_TemValue) * GetPeriodValue("存货", True)
                Case 2
                    MakeFormula = (360 / dbl_TemValue) * GetPeriodValue("存货", True)
                End Select
            End With
        Else
            MakeFormula = 0
        End If
    Case "应收账款周转率"
        dbl_TemValue = GetPeriodValue("应收账款净额", True) + GetPeriodValue("应收票据", True)
        If dbl_TemValue <> 0 Then
            MakeFormula = GetPeriodValueInc("产品销售收入", False) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "应收账款周转天数"