frmitemnaturecard.frm

金算盘软件代码

      Width           =   1350
   End
End
Attribute VB_Name = "frmItemNatureCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  商品性质卡片
'  作者：苏涛
'  日期：1998.07.08
'
'  功能：完成商品性质表的增、删、改操作
'
'  接口： AddCard   增加商品性质记录。
'                   参数：intModal 显示模式，strName 用户输入值
'         EditCard  修改商品性质记录。
'                   参数： lngRecordID 被修改的记录的ID，intModal 显示模式
'         DelCard   删除商品性质记录。
'                   参数： lngRecordID 被删除的记录的ID
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Option Compare Text

Private mblnIsNew As Boolean
Private mblnIsList As Boolean
Private mblnIsExist As Boolean
Private mblnIsRefer As Boolean
Private mblnIsInit As Boolean
Private mblnIsChanged As Boolean
Private mbytCostMethod As Byte
Private mlngItemNatureID As Long
Private mlngLstID(5) As Long

'引入商品性质
Public Function AddItemNature(ByVal strNature As String) As Integer
    Dim lngSaleAccountID As Long, lngCostAccountID As Long
    Dim lngStockAccountID As Long, lngDiffAccountID As Long
    Dim lngStockTaxAccountID As Long, lngTaxID As Long
    Dim strName As String, strItemCategory As String
    Dim strCostMethod As String, strTemp As String
    
    On Error GoTo ErrHandle
    AddItemNature = 0
    If Not GetString(strNature, strName, 1) Then GoTo ErrHandle
    If Not GetString(strNature, strItemCategory, 2) Then GoTo ErrHandle
    If Not GetString(strNature, strTemp, 3) Then GoTo ErrHandle
    lngTaxID = CLng(strTemp)
    If Not GetString(strNature, strTemp, 4) Then GoTo ErrHandle
    lngSaleAccountID = CLng(strTemp)
    If Not GetString(strNature, strTemp, 5) Then GoTo ErrHandle
    lngCostAccountID = CLng(strTemp)
    If Not GetString(strNature, strTemp, 6) Then GoTo ErrHandle
    lngStockAccountID = CLng(strTemp)
    If Not GetString(strNature, strTemp, 7) Then GoTo ErrHandle
    lngDiffAccountID = CLng(strTemp)
    If Not GetString(strNature, strTemp, 8) Then GoTo ErrHandle
    lngStockTaxAccountID = CLng(strTemp)
    If Not GetString(strNature, strCostMethod, 9) Then GoTo ErrHandle
    
    If strName = "" Then GoTo ErrHandle
    If strItemCategory < "1" Or strItemCategory > "4" Then GoTo ErrHandle
    If strCostMethod < "0" Or strCostMethod > "8" Then GoTo ErrHandle
    If ItemIsExist("Tax", "lngTaxID", lngTaxID) Then
        mlngLstID(0) = lngTaxID
    Else
        GoTo ErrHandle
    End If
    If ItemIsExist("Account", "lngAccountID", lngSaleAccountID) Then
        mlngLstID(1) = lngSaleAccountID
    Else
        mlngLstID(1) = 0
    End If
    If ItemIsExist("Account", "lngAccountID", lngCostAccountID) Then
        mlngLstID(2) = lngCostAccountID
    Else
        mlngLstID(2) = 0
    End If
    If ItemIsExist("Account", "lngAccountID", lngStockAccountID) Then
        mlngLstID(3) = lngStockAccountID
    Else
        mlngLstID(3) = 0
    End If
    If ItemIsExist("Account", "lngAccountID", lngDiffAccountID) Then
        mlngLstID(4) = lngDiffAccountID
    Else
        mlngLstID(4) = 0
    End If
    If ItemIsExist("Account", "lngAccountID", lngStockTaxAccountID) Then
        mlngLstID(5) = lngStockTaxAccountID
    Else
        mlngLstID(5) = 0
    End If
    
    txtInput.Text = strName
    cboNature(0).AddItem "存货", 0
    cboNature(0).AddItem "非存货", 1
    cboNature(0).AddItem "劳务", 2
    cboNature(0).AddItem "费用", 3
    InitMethodBox
    cboNature(0).ListIndex = CInt(strItemCategory) - 1
    cboNature(1).ListIndex = CInt(strCostMethod) - 1
    mblnIsNew = True
    If Not SaveCard(True) Then GoTo ErrHandle
    AddItemNature = 1
ErrHandle:
End Function

Public Property Get getID() As Long
    getID = mlngItemNatureID
End Property

'进入新增商品性质
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0, _
    Optional ByVal IsList As Boolean = False) As Long
    mlngItemNatureID = 0
    mblnIsNew = True
    mblnIsChanged = True
    Caption = "新增商品性质"
    cmdOKCancel(2).Visible = True
    mblnIsList = IsList
    InitCard strName
    Show intModal
    AddCard = mlngItemNatureID
End Function

Private Function GetTaxName(ByVal lngID As Long) As String
    Dim recTax As rdoResultset, strSql As String
    
    strSql = "SELECT * FROM Tax WHERE blnIsInActive=0 AND lngTaxID=" & lngID
    Set recTax = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTax.EOF Then
        GetTaxName = recTax!strTaxName
        mlngLstID(0) = lngID
    Else
        GetTaxName = "零税率"
        mlngLstID(0) = 1
    End If
    recTax.Close
End Function

Private Sub InitCard(Optional strName As String = "", Optional ByVal _
    blnFixCostMethod As Boolean = False)
    Dim i As Integer, recItemNature As rdoResultset, strSql As String
    
    mblnIsInit = True
    InitMethodBox
    If mblnIsNew Then
        For i = 1 To 5
            mlngLstID(i) = 0
            lstNature(i).Text = ""
        Next i
'        mlngLstID(0) = 2
        lstNature(0).Text = GetTaxName(2)
        lstNature(0).SeekId mlngLstID(0)
        txtInput.Text = Trim(strName)
        mbytCostMethod = 0
        #If conVersionType = 16 Then
            cboNature(0).ListIndex = 1
        #Else
            cboNature(0).ListIndex = 0
        #End If
        cboNature(1).ListIndex = 0
        lstNature(4).Enabled = False
        lstNature(5).Enabled = False
    Else
        strSql = "SELECT * FROM ITEMNATUREVIEW WHERE lngItemNatureID=" & mlngItemNatureID
        Set recItemNature = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        With recItemNature
        txtInput.Text = !strItemNatureName
        mlngLstID(0) = !lngTaxID
        lstNature(0).Text = Format(!strTaxName, "@;;")
'        #If conVersionType = 16 Then
'            mlngLstID(1) = !lngStockAccountID
'            mlngLstID(2) = !lngSaleAccountID
'            lstNature(1).Text = Trim(Format(!strStockAccountCode, "@;;")) & " " _
'                & Trim(Format(!strStockAccountName, "@;;"))
'            lstNature(2).Text = Trim(Format(!strSaleAccountCode, "@;;")) & " " _
'                & Trim(Format(!strSaleAccountName, "@;;"))
'        #Else
            mlngLstID(1) = !lngSaleAccountID
            mlngLstID(2) = !lngCostAccountID
            mlngLstID(3) = !lngStockAccountID
            mlngLstID(4) = !lngDiffAccountID
            mlngLstID(5) = !lngStockTaxAccountID
            lstNature(1).Text = Trim(Format(!strSaleAccountCode, "@;;")) & " " _
                & Trim(Format(!strSaleAccountName, "@;;"))
            lstNature(2).Text = Trim(Format(!strCostAccountCode, "@;;")) & " " _
                & Trim(Format(!strCostAccountName, "@;;"))
            lstNature(3).Text = Trim(Format(!strStockAccountCode, "@;;")) & " " _
                & Trim(Format(!strStockAccountName, "@;;"))
            lstNature(4).Text = Trim(Format(!strDiffAccountCode, "@;;")) & " " _
                & Trim(Format(!strDiffAccountName, "@;;"))
            lstNature(5).Text = Trim(Format(!strStockTaxAccountCode, "@;;")) & " " _
                & Trim(Format(!strStockTaxAccountName, "@;;"))
'        #End If
        #If conVersionType = 8 Then
            If !strCostMethod = 8 Then
                 mbytCostMethod = 6
            Else
                mbytCostMethod = CByte(!strCostMethod)
            End If
        #Else
            #If conVersionType = 4 Then
                mbytCostMethod = 1
            #Else
                mbytCostMethod = CByte(!strCostMethod)
            #End If
        #End If
        cboNature(0).ListIndex = CInt(!strItemCategory) - 1
        If mbytCostMethod > 0 Then
            cboNature(1).ListIndex = mbytCostMethod - 1
        End If
        If blnFixCostMethod Or mbytCostMethod = 0 Then
            lblTitle(2).Enabled = False
            cboNature(1).Enabled = False
            If blnFixCostMethod Then
                lblTitle(1).Enabled = False
                cboNature(0).Enabled = False
            End If
        Else
            lblTitle(2).Enabled = True
            cboNature(1).Enabled = True
        End If
        End With
        recItemNature.Close
    End If
    mblnIsInit = False
End Sub

Private Sub InitMethodBox()
    cboNature(1).Clear
    #If conVersionType = 1 Then
        cboNature(1).AddItem "全月平均", 0
        cboNature(1).AddItem "移动平均", 1
        cboNature(1).AddItem "先进先出", 2
        cboNature(1).AddItem "后进先出", 3
        cboNature(1).AddItem "个别计价", 4
        cboNature(1).AddItem "计划价", 5
        cboNature(1).AddItem "进销差价率", 6
        cboNature(1).AddItem "最后进价法", 7
    #Else
        #If conVersionType = 2 Then
        #Else
            #If conVersionType = 8 Then
                cboNature(1).AddItem "全月平均", 0
                cboNature(1).AddItem "移动平均", 1
                cboNature(1).AddItem "先进先出", 2
                cboNature(1).AddItem "后进先出", 3
                cboNature(1).AddItem "个别计价", 4
                cboNature(1).AddItem "最后进价法", 5
            #Else
                cboNature(1).AddItem "移动平均", 0
            #End If
        #End If
    #End If
    
End Sub

'进入修改商品性质
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
    Optional strItemNature As String)
    Dim blnFixCostMethod As Boolean
    Dim recItemNature As rdoResultset, strSql As String
    Dim strMess As String
    
    If Not CheckIDUsed("ItemNature", "lngItemNatureID", lngID) Then
        If Trim(strItemNature) <> "" Then
            strMess = "“" & strItemNature & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "商品性质不存在,不能进行编辑!", _
            vbExclamation + MB_TASKMODAL, "修改商品性质"
        Unload Me
    Else
        strSql = "SELECT * FROM Item WHERE lngItemNatureID=" & lngID
        Set recItemNature = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        With recItemNature
        Do Until .EOF
            If frmItemCard.ItemIsUsed(!lngItemID) Then Exit Do
            .MoveNext
        Loop
        If .EOF Then
            blnFixCostMethod = False
        Else
            blnFixCostMethod = True
        End If
        .Close
        End With
        mlngItemNatureID = lngID
        mblnIsNew = False
        mblnIsChanged = False
        Caption = "修改商品性质"
        cmdOKCancel(2).Visible = False
        InitCard , blnFixCostMethod
        Show intModal
    End If
End Sub

'进入删除商品性质表，判断记录是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngID As Long, Optional lnghWnd As Long = 0) As Boolean
    Dim recItemNature As rdoResultset, strSql As String
    
    DelCard = False
    strSql = "SELECT * FROM ItemNature WHERE lngItemNatureID=" & lngID
    Set recItemNature = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recItemNature.EOF Then
        DelCard = True
        recItemNature.Close
        Exit Function
    Else