clsite.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 = "clsIte"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'*********************************************************************
'*    模 块 名 称 :项目毛利率分析类模块
'*    功 能 描 述 :
'*    程序员姓名  :白石军
'*    最后修改人  :
'*    最后修改时间:2002/1/21
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'*
'*********************************************************************

Option Explicit

Private Const costCode = &H100
Private Const comeInCode = &H200
Private Enum FLAG_CODE
    COST_CODE = costCode
    COMEIN_CODE = comeInCode
End Enum

Private SumAssiRs As New ADODB.Recordset '科目总帐表记录集
Private IteRs As New ADODB.Recordset '产品

Private iCompYear As Integer '比较期年
Private iCompMonth As Integer  '比较期月
Private iThisMonth As Integer '本年月

Private iThisThreeMonthBegin As Integer '本年查询季开始
Private iThisThreeMonthEnd As Integer '本年查询季结束

Private myCode As FLAG_CODE

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

Private Sub Class_Initialize()
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim SqlStr As String
    SqlStr = "SELECT A.*,B.ItemName,C.ItemClassName FROM cwfx_ItemGrossProfitSet A,Cwzz_Item B,Cwzz_ItemClass C where A.ItemCode=B.ItemCode and A.ItemClassCode=B.ItemClassCode and C.ItemClassCode=A.ItemClassCode"
    Set IteRs = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    'Call GetParm
End Sub

Public Function GetParm(nIndex As Integer, sText As String)
    '得到查询参数
    If DEBUG_FLAG = False Then On Error Resume Next
    
        Select Case nIndex
        Case 0 '按年
            
        Case 1 '按月
            iThisMonth = CInt(Right(sText, 2))
        Case 2 '按季
            iThisThreeMonthBegin = Mid(sText, 6, 2)
            iThisThreeMonthEnd = CInt(Right(sText, 2))
        End Select
    
End Function

Public Function MakeData(nIndex As Integer) As Boolean
    '此过程为公共接口
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim i As Integer
    iRecordCount = IteRs.RecordCount - 1
    If iRecordCount < 0 Then
        MakeData = False
        Exit Function
    End If
    ReDim IteArry(iRecordCount)
    
    For i = 0 To iRecordCount
        With IteRs
            IteArry(i).strItemClass = Trim(!ItemClassName) '项目大类
            IteArry(i).strItemName = Trim(!ItemName)
            myCode = COMEIN_CODE '设置标志：收入科目
            IteArry(i).lngInCome = GetVal(Trim(!ItemCode), Trim(!ItemClasscode), nIndex)
            myCode = COST_CODE '设置标志：成本科目
            IteArry(i).lngCost = GetVal(Trim(!ItemCode), Trim(!ItemClasscode), nIndex)
            IteArry(i).lngMaoLi = IteArry(i).lngInCome - IteArry(i).lngCost
            If IteArry(i).lngInCome <> 0 Then
                IteArry(i).lngMaoLiLv = (IteArry(i).lngMaoLi / IteArry(i).lngInCome) * 100
            Else
                IteArry(i).lngMaoLiLv = 0
            End If
            .MoveNext
        End With
    Next
    MakeData = True
End Function

Private Function GetVal(ByVal strItem As String, ByVal strItemClass As String, nIndex As Integer) As Long
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim sigReturn As Long '返回数
    Dim strTem As String
    Dim iLen As Integer
    Dim iWordBegin As Integer
    Dim iWordEnd As Integer
    Dim i As Integer
    Dim j As Integer
    Dim strSql As String
    
    If SumAssiRs.State = adStateOpen Then SumAssiRs.Close
    strSql = MakeSQL(strItem, strItemClass, nIndex)
    Set SumAssiRs = Cw_DataEnvi.DataConnect.Execute(strSql)
    If Not (SumAssiRs.EOF And SumAssiRs.BOF) Then
        '如果是收入则(此处可进一步优化，即同时查出成本和收入，同时累加到数据对象中)
        If myCode = COMEIN_CODE Then
            sigReturn = sigReturn + IIf(IsNull(SumAssiRs!dje), 0, SumAssiRs!dje)
        ElseIf myCode = COST_CODE Then  '是成本则
            sigReturn = sigReturn + IIf(IsNull(SumAssiRs!jje), 0, SumAssiRs!jje)
        End If
    End If
    
    GetVal = sigReturn
End Function

Private Function MakeSQL(ByVal strItem As String, ByVal strItemClass As String, nIndex As Integer) As String
    '根据查询条件，生成SQL语句
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim strTemSql As String
    '---------------------------------------------------------------------------
    strTemSql = ""
    If myCode = COMEIN_CODE Then
        strTemSql = "SELECT Sum(Mdje) as dje FROM Cwzz_AccSumAssi o ,Cwzz_AccCode m  WHERE o.cCode=m.cCode AND m.BalanceOri='贷' and  o.ItemCode='" & strItem & "' AND o.ItemClassCode='" & strItemClass & "' "
    ElseIf myCode = COST_CODE Then  '是成本则
        strTemSql = "SELECT Sum(Mjje) as jje FROM Cwzz_AccSumAssi o ,Cwzz_AccCode m  WHERE o.cCode=m.cCode AND m.BalanceOri='借' and  o.ItemCode='" & strItem & "' AND o.ItemClassCode='" & strItemClass & "' "
    End If
    Select Case nIndex
    Case 0 '按年
        strTemSql = strTemSql & " AND  Year=" & Xtyear
    Case 1 '按月
        strTemSql = strTemSql & " AND Period=" & iThisMonth & " AND Year=" & Xtyear
    Case 2 '按季
        strTemSql = strTemSql & " AND Period  Between " & iThisThreeMonthBegin & " AND " & iThisThreeMonthEnd & " AND Year=" & Xtyear
    End Select
    '-----------------------------------------------------------------------------
    MakeSQL = strTemSql
End Function

Private Sub Class_Terminate()
    If DEBUG_FLAG = False Then On Error Resume Next
    If SumAssiRs.State = adStateOpen Then SumAssiRs.Close
    If IteRs.State = adStateOpen Then IteRs.Close
    
    Set SumAssiRs = Nothing
    Set IteRs = Nothing
    
    Set codeColl = Nothing
    
End Sub