recordclass.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 = "RecordClass"
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"
'--------------------------
'     记录集 类
'
'       王兴元
'--------------------------
Private intItem() As enumTabType
Private intTabItem As enumTabType
Private lngID As Long
Private lngItUnitID As Long
Private 商品ID As Long
Private 商品明细ID As Long
Private lngSalesReveiveStockPaymentID As Long   '如果是采购付款/销售收款，则此值不为0，否则为0
Private strEmployeeCondition As String          '职员条件字符串
Private lngEmployeeCondition As Long          '职员条件
Private blnIsMutiCurrencys As Boolean

'入口参数：
'           Item   表名枚举
'           lngID   单位中的标志ID（-1  购货类，1  销货类）
'                   商品中的商品ID (详见下面的注释)
'                   科目中的标志ID（0  所有科目，1 应收/应付科目，2  现金/银行科目）
'                   币种中的科目ID（0  所有的币种，<> 0  指定科目的币种）
'                   货位中的商品ID（为-100时是标志，为0时是所有的货位，>0时将显示出对应商品的货位余额
'                   汇率中的币种ID
'
'           ItemID  当进行货位参照时，如果转入的LNGID 为-100时，它有效，表示商品ID
'           ItemDetailID   当进行货位参照时，如果转入的LNGID 为-100时，它有效，表示商品明细ID
'           lngItemUnitID  当进行货位参照时，如果转入的LNGID > 0时，它有效，表示商品计量单位ID
'出口参数：
'           rdoresultset
Public Property Get RecordSQL(ByVal Item As enumTabType, Optional ByVal lngID As Long = 0, Optional ItemID As Long, Optional ByVal ItemDetailID As Long, Optional ByVal lngItemUnitID As Long = 0, Optional ByVal intEmpCond As Integer) As String
    If Item = xEmployee Then
        strEmployeeCondition = GetEmployeeCondition(intEmpCond)     '存贮职员条件字符串
    End If
    RecordSQL = GetSQL(Item, lngID, ItemID, ItemDetailID, lngItemUnitID)
End Property

Public Property Get RecordCon(ByVal Item As enumTabType, Optional ByVal lngID As Long = 0, Optional ItemID As Long, Optional ByVal ItemDetailID As Long, Optional ByVal lngItemUnitID As Long = 0, Optional ByVal intEmpCond As Integer) As rdoResultset
    Dim strSQL As String
    
    If Item = xEmployee Then
        lngEmployeeCondition = intEmpCond
        strEmployeeCondition = GetEmployeeCondition(intEmpCond)     '存贮职员条件字符串
    End If
    
    Select Case Item
        Case 1 To 9
            strSQL = GetSQL(Item, lngID, ItemID, ItemDetailID, lngItemUnitID)
        Case 10 'Position
            If lngID = 0 Then
                strSQL = ""
            ElseIf lngID = -100 Then
                 商品ID = ItemID
                 商品明细ID = ItemDetailID
                 Set RecordCon = GetPositionList("新货位批次", ItemID, ItemDetailID)
                 If Not RecordCon.EOF Then RecordCon.MoveLast
                 Exit Property
            Else
                Set RecordCon = GetPositionList("", lngID, 0, lngItemUnitID)
                If Not RecordCon.EOF Then RecordCon.MoveLast
                Exit Property
            End If
        Case 11 To 39
            strSQL = GetSQL(Item, lngID, ItemID, ItemDetailID, lngItemUnitID)
        Case Else
            strSQL = "xx"
    End Select
'====================  Execute SQL ====================
    If StrLen(strSQL) = 0 Then  'Public
        Set RecordCon = Utility.GetListRecordSet(Item)
    ElseIf strSQL = "xx" Then   'Else
        Set RecordCon = Nothing
    Else                        'Private
        Set RecordCon = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
        If Not (RecordCon.BOF And RecordCon.EOF) Then
            RecordCon.MoveLast
        End If
    End If
End Property
'----------------------------------------------------------------
'----------------------  Customer表中  lngItemID 参数说明：------
'   -1..........购货类
'    1..........销货类
'----------------------AdjustItem表中  lngItemID 参数说明：------
'   -1 .........存货
'   -2 .........非存货
'   -3 .........劳务
'   -4 .........费用
'  -10..........非受托
'   -11.........非受托存货
'   -12.........'非费用类
'   -13..........非配比类
'   -14..........非费用受托类商品
'   -15..........非费用非受托类商品
'   -16 .........非受托非配比类
'   -17 .........非受托非存货类
'   -18 .........加工费用或费用类商品
'   10..........受托
'    8 .........调价单
'    9 .........调拔单
'    1 .........组件商品
'   20..........售价核算商品
'   21..........计划价核算商品
'   22..........进价核算商品
'   23..........售价核算受托商品
'   24..........计划价核算受托商品
'   25..........进价核算受托商品
'   26..........售价核算非费用商品
'   27..........计划价核算非费用商品
'   28..........进价核算非费用商品
'   29..........售价核算非受托商品
'   30..........计划核算非受托商品
'   31..........进价核算非受托商品
'   32..........受托存货类

'----------------Currencys表中  lngItemID 参数说明：--------------
'   对采购单等单据，如果ID号小于0时默认为全币种核算
'
Private Function GetSQL(ByVal Item As enumTabType, Optional ByVal lngItemID As Long = 0, Optional ByVal ItemID As Long, Optional ByVal ItemDetailID As Long, Optional ByVal lngItemUnitID As Long = 0) As String
    Dim strSQL As String
    Dim blnI As Boolean
    Dim i As Integer
    Dim strTmp As String
    Static intI As Integer
    
    On Error Resume Next
    For i = 0 To UBound(intItem) - 1
        If intItem(i) <> Item Then
            blnI = True
        End If
    Next i
    If blnI Then
        intItem(intI) = Item
        intI = intI + 1
        ReDim Preserve intItem(0 To intI)
    End If
    intTabItem = Item '保存当前的表参照，以便在进行参照内容刷新时能定位到当前的参照的某一行
    lngID = lngItemID '保存当前的ID号，以便在进行参照内容刷新时能定位到当前的参照的某一行

    Select Case Item
        Case 1  'Customer
            If lngItemID = 0 Then
                strSQL = ""
            ElseIf lngItemID = -1 Then  '购货类(应付，应收/应付)
                strSQL = "SELECT lngCustomerID,strCustomerCode,strCustomerName FROM Customer WHERE (strCategory = '2' or strCategory = '3' or strCategory = '4') AND blnIsInActive=0 AND strCustomerCode<>' ' ORDER BY strCustomerCode ASC"
            ElseIf lngItemID = 1 Then    '供货类（应收，应收/应付）
                strSQL = "SELECT lngCustomerID,strCustomerCode,strCustomerName FROM Customer WHERE (strCategory = '1' or strCategory = '3' or strCategory = '4') AND blnIsInActive=0 AND strCustomerCode<>' ' ORDER BY strCustomerCode ASC"
            Else
                strSQL = ""
            End If
        Case 7  'Account
            strSQL = ""
        Case 10 'Position
            If lngItemID = 0 Then
                strSQL = ""
            ElseIf lngItemID = -100 Then
                 商品ID = ItemID
                 商品明细ID = ItemDetailID
                 strSQL = GetPositionListSQL("新货位批次", ItemID, ItemDetailID)
            Else
                lngItUnitID = lngItemUnitID
                strSQL = GetPositionListSQL("", lngItemID, 0, lngItemUnitID)
            End If
        Case 3  'Employee
            strSQL = "SELECT lngEmployeeID,strEmployeeCode,strEmployeeName FROM Employee  WHERE blnIsInActive=0 "
            If lngItemID <> 0 Then
                strSQL = strSQL & " AND lngDepartmentID=" & lngItemID
            End If
            
            If LTrim(strEmployeeCondition) <> "" Then
                strSQL = strSQL & strEmployeeCondition
            End If
            
            strSQL = strSQL & " ORDER BY strEmployeeCode"
        Case 2, 4, 6, 8, 9, 11, 12, 13, 14, 15, 16, 17, 19, 20, 26, 27
            strSQL = ""
        Case 5  'Currencys
            blnIsMutiCurrencys = False
            If lngItemID <= 0 Then
            '对采购单等单据，如果ID号小于0时默认为全币种核算
                strSQL = "SELECT Currencys.lngCurrencyID, Currencys.strCurrencyCode, Currencys.strCurrencyName " _
                & "From Currencys WHERE (blnIsInActive=0) AND Currencys.strCurrencyCode<>' ' ORDER BY Currencys.strCurrencyCode"
                GoTo WndProc
            End If
            strSQL = "SELECT blnIsMultCurrency,blnIsAllCurrency FROM Account WHERE lngAccountID=" & lngItemID & " AND blnIsInActive=0"
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
            If recTmp Is Nothing Then
                '本位币
                strSQL = "SELECT Currencys.lngCurrencyID, Currencys.strCurrencyCode, Currencys.strCurrencyName " _
                & "From Currencys WHERE Currencys.lngCurrencyID=1 AND (blnIsInActive=0) AND Currencys.strCurrencyCode<>' '  ORDER BY Currencys.strCurrencyCode"
                GoTo WndProc
            ElseIf recTmp.RowCount = 0 Then
                recTmp.Close
                '本位币
                strSQL = "SELECT Currencys.lngCurrencyID, Currencys.strCurrencyCode, Currencys.strCurrencyName " _
                & "From Currencys WHERE Currencys.lngCurrencyID=1 AND (blnIsInActive=0) AND Currencys.strCurrencyCode<>' ' ORDER BY Currencys.strCurrencyCode"
                GoTo WndProc
            End If

            If recTmp!blnIsAllCurrency Then
                '全币种查询
                strSQL = "SELECT Currencys.lngCurrencyID, Currencys.strCurrencyCode, Currencys.strCurrencyName " _
                   & "FROM Currencys WHERE (blnIsInActive=0) AND Currencys.strCurrencyCode<>' ' ORDER BY Currencys.strCurrencyCode"
            ElseIf recTmp!blnIsMultCurrency Then
                '多币种查询
                blnIsMutiCurrencys = True
                strSQL = "SELECT Currencys.lngCurrencyID, Currencys.strCurrencyCode, Currencys.strCurrencyName " _
                    & "FROM Currencys ,AccountCurrency, Account " _
                    & "WHERE AccountCurrency.lngCurrencyID=Currencys.lngCurrencyID AND Account.lngAccountID=AccountCurrency.lngAccountID AND Account.blnIsMultCurrency=1 And Account.lngAccountID=" & lngItemID & " AND Currencys.blnIsInActive=0 AND Currencys.strCurrencyCode<>' ' ORDER BY Currencys.strCurrencyCode"
                    '-------------IF 0 -------------
                    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
                    If recTmp Is Nothing Then
                        '本位币
                        strSQL = "SELECT Currencys.lngCurrencyID, Currencys.strCurrencyCode, Currencys.strCurrencyName " _
                        & "From Currencys WHERE Currencys.lngCurrencyID=1 AND blnIsInActive=0 AND Currencys.strCurrencyCode<>' ' ORDER BY Currencys.strCurrencyCode"
                        GoTo WndProc
                    ElseIf recTmp.RowCount = 0 Then
                        recTmp.Close
                        '本位币
                        strSQL = "SELECT Currencys.lngCurrencyID, Currencys.strCurrencyCode, Currencys.strCurrencyName " _
                        & "From Currencys WHERE Currencys.lngCurrencyID=1 AND blnIsInActive=0 AND Currencys.strCurrencyCode<>' ' ORDER BY Currencys.strCurrencyCode"
                        GoTo WndProc
                    End If
                    recTmp.Close
                    '-----------END IF -------------
                Else
                '本位币查询
                strSQL = "SELECT Currencys.lngCurrencyID, Currencys.strCurrencyCode, Currencys.strCurrencyName " _
                    & "From Currencys WHERE Currencys.lngCurrencyID=1 AND blnIsInActive=0 AND Currencys.strCurrencyCode<>' ' ORDER BY Currencys.strCurrencyCode"
            End If
        Case 18 'Rate
            strSQL = "SELECT lngCurrencyID, dblRate " _
             & "From Rate " _
             & "WHERE lngCurrencyID =" & lngItemID
        Case 21 'Template
            lngSalesReveiveStockPaymentID = ItemID
            If ItemID <> 0 Then
                strSQL = "SELECT lngTemplateID, strTemplateName From Template WHERE (lngReceiptTypeID=" & lngItemID _