frmitemnaturelistcard.frm

金算盘软件代码

            Else
                lblTitle(6).Enabled = False
                lstNature(4).Text = ""
                lstNature(4).BackColor = &H80000004
                lstNature(4).Enabled = False
                lstNature(5).Text = ""
                lstNature(5).BackColor = &H80000004
                lstNature(5).Enabled = False
                lblTitle(7).Enabled = False
            End If
        #Else
            #If conVersionType = 2 Then
            #Else
                lblTitle(6).Enabled = False
                lstNature(4).Text = ""
                lstNature(4).BackColor = &H80000004
                lstNature(4).Enabled = False
                lstNature(5).Text = ""
                lstNature(5).BackColor = &H80000004
                lstNature(5).Enabled = False
                lblTitle(7).Enabled = False
            #End If
        #End If
    Else
        If cboNature(0).ListIndex > 0 Then
            InitMethodBox
            lblTitle(2).Enabled = False
            cboNature(1).Enabled = False
'            If mbytCostMethod > 0 Then cboNature(1).ListIndex = 0
            cboNature(1).BackColor = &H80000004
            lstNature(3).Text = ""
            lstNature(3).BackColor = &H80000004
            lstNature(3).Enabled = False
            lblTitle(5).Enabled = False
        Else
            lblTitle(2).Enabled = True
            cboNature(1).Enabled = True
            cboNature(1).BackColor = &H80000005
            lstNature(3).BackColor = &H80000005
            lstNature(3).Enabled = True
            lblTitle(5).Enabled = True
        
            lblTitle(6).Enabled = False
            lstNature(4).Text = ""
            lstNature(4).BackColor = &H80000004
            lstNature(4).Enabled = False
            lstNature(5).Text = ""
            lstNature(5).BackColor = &H80000004
            lstNature(5).Enabled = False
            lblTitle(7).Enabled = False
        End If
        If cboNature(0).ListIndex > 1 Then
'            lstNature(3).Text = ""
'            lstNature(3).BackColor = &H80000004
'            lstNature(3).Enabled = False
'            lblTitle(5).Enabled = False
'            If cboNature(0).ListIndex = 3 Then
'                lstNature(1).Text = ""
'                lstNature(1).BackColor = &H80000004
'                lstNature(1).Enabled = False
'                LblTitle(3).Enabled = False
'            Else
'                lstNature(1).BackColor = &H80000005
'                lstNature(1).Enabled = True
'                LblTitle(3).Enabled = True
'            End If
'            If cboNature(0).ListIndex = 2 Then
'                lstNature(2).Text = ""
'                lstNature(2).BackColor = &H80000004
'                lstNature(2).Enabled = False
'                LblTitle(4).Enabled = False
'            Else
'                lstNature(2).BackColor = &H80000005
'                lstNature(2).Enabled = True
'                LblTitle(4).Enabled = True
'            End If
        Else
            lstNature(1).BackColor = &H80000005
            lstNature(1).Enabled = True
            lblTitle(3).Enabled = True
            lstNature(2).BackColor = &H80000005
            lstNature(2).Enabled = True
            lblTitle(4).Enabled = True
        End If
    End If
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub lstNature_AddNew(Index As Integer)
    Dim lngID As Long
    
    Select Case Index
        Case 0
             lngID = frmItemTax.AddCard(lstNature(0).Text, vbModal)
             If lngID <> 0 Then mlngLstID(0) = lngID
        Case 1, 2, 5
             lngID = frmAccountCard.AddCard(lstNature(Index).Text, , vbModal)
             If lngID <> 0 Then mlngLstID(Index) = lngID
        Case 3, 4
             lngID = frmAccountCard.AddCard(lstNature(Index).Text, , vbModal, 5)
             If lngID <> 0 Then mlngLstID(Index) = lngID
    End Select
    If lngID = 0 Then
        lstNature(Index).Text = ""
    Else
        mlngLstID(Index) = lngID
    End If
    RefershList lstNature(Index), Index
    mblnIsChanged = True
End Sub

Private Sub lstNature_Change(Index As Integer)
    If ContainErrorChar(lstNature(Index).Text, "`~!@#$^&*=+'"";:,.?|") Then BKKEY lstNature(Index).hwnd
End Sub

Private Sub lstNature_Delete(Index As Integer)
    Select Case Index
        Case 0
            If frmItemTax.DelCard(mlngLstID(0), Me.hwnd) Then mlngLstID(0) = 0
        Case 1, 2, 3, 4, 5
            If frmAccountCard.DelCard(mlngLstID(Index), Me.hwnd) Then mlngLstID(Index) = 0
    End Select
    RefershList lstNature(Index), Index
End Sub

Private Sub lstNature_Edit(Index As Integer)
    If Index = 0 Then
        frmItemTax.EditCard mlngLstID(0), vbModal ', lstNature(0).Text
    Else
        frmAccountCard.EditCard mlngLstID(Index), vbModal ', lstNature(Index).Text
    End If
    RefershList lstNature(Index), Index
'    lstNature(Index).TextMatrix(lstNature(Index).ReferRow, 1) = mlngListIDBuffer(Index)
End Sub

'当第一次进入列表框时，设置它的选项
Private Sub lstnature_GotFocus(Index As Integer)
    If mblnIsNew Then
        cmdOKCancel(2).Default = False
    Else
        cmdOKCancel(0).Default = False
    End If
    If lstNature(Index).Referrows <= 1 Then
        RefershList lstNature(Index), Index
    End If
End Sub

'设置列表框选项
Public Sub RefershList(lstSetting As ListText, Index As Integer)

    If Index = 0 Then
        setlistbox lstSetting, 15, mlngLstID(0)
    Else
        setlistbox lstSetting, 0, mlngLstID(Index)
    End If

End Sub

'根据列表框选择结果来调用卡片或存储调用卡片的参数
Private Sub lstnature_Choose(Index As Integer)
    If lstNature(Index).Text <> "" Then
        mlngLstID(Index) = lstNature(Index).TextMatrix(lstNature(Index).ReferRow, 1)
    Else
        mlngLstID(Index) = 0
    End If
    mblnIsChanged = True
End Sub

Private Sub cmdokcancel_Click(Index As Integer)
    
    Select Case Index
        Case 0
            If SaveCard Then Unload Me
        Case 1    '取消
            Unload Me
        Case 2    '下一个
            If SaveCard Then
                mblnIsNew = True
                mblnIsChanged = True
                InitCard
                txtInput.SetFocus
            End If
    End Select
End Sub

Private Function LstIsValid() As Boolean
    Dim recAcnt As rdoResultset, Strsql As String

    LstIsValid = False
    If Not ItemIsValid("Tax", "lngTaxID", mlngLstID(0), , False) Then
        ShowMsg hwnd, "税率应该是末级，您选择的“" & lstNature(0).Text _
            & "”无效，请重新选择！", vbExclamation, Caption
        lstNature(0).SetFocus
        Exit Function
    End If
    If mlngLstID(1) <> 0 Then
        Strsql = "SELECT * FROM Account WHERE lngAccountID=" & mlngLstID(1) _
            & " AND (blnIsInActive=1 OR blnIsDetail=0 OR blnIsQuantity=1" _
            & " OR blnIsAllCurrency=1 OR blnIsMultCurrency=1)"
        Set recAcnt = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenForwardOnly)
        If Not recAcnt.EOF Then
            ShowMsg hwnd, "收入科目必须是没有停用的末级科目,并且不能有数量核算和外币核算属性，" _
                & "您选择的“" & lstNature(1).Text & "”无效，请重新选择！", _
                vbExclamation, Caption
            recAcnt.Close
            lstNature(1).SetFocus
            Exit Function
        End If
    End If
    If mlngLstID(2) <> 0 Then
        Strsql = "SELECT * FROM Account WHERE lngAccountID=" & mlngLstID(2) _
            & " AND (blnIsInActive=1 OR blnIsDetail=0 OR blnIsQuantity=1" _
            & " OR blnIsAllCurrency=1 OR blnIsMultCurrency=1)"
        Set recAcnt = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenForwardOnly)
        If Not recAcnt.EOF Then
            ShowMsg hwnd, "成本科目必须是没有停用的末级科目,并且不能有数量核算和外币核算属性，" _
                & "您选择的“" & lstNature(2).Text & "”无效，请重新选择！", _
                vbExclamation, Caption
            recAcnt.Close
            lstNature(2).SetFocus
            Exit Function
        End If
    End If
    If mlngLstID(3) <> 0 Then
        If Not AccountIsValid(mlngLstID(3), 5) Then
            ShowMsg hwnd, "存货科目必须是没有停用的末级科目,并且科目性质必须为存货，" _
                & "您选择的“" & lstNature(3).Text & "”无效，请重新选择！", _
                vbExclamation, Caption
            lstNature(3).SetFocus
            Exit Function
        End If
    End If
    If mlngLstID(4) <> 0 Then
        If Not AccountIsValid(mlngLstID(4), 5) Then
            ShowMsg hwnd, "差异科目必须是没有停用的末级科目,并且科目性质必须为存货，" _
                & "您选择的“" & lstNature(4).Text & "”无效，请重新选择！", _
                vbExclamation, Caption
            lstNature(4).SetFocus
            Exit Function
        End If
    End If
    If mlngLstID(5) <> 0 Then
        If Not AccountIsValid(mlngLstID(5), 5) Then
            ShowMsg hwnd, "待实现销项税科目必须是没有停用的末级科目,并且科目性质必须为存货，" _
                & "您选择的“" & lstNature(5).Text & "”无效，请重新选择！", _
                vbExclamation, Caption
            lstNature(5).SetFocus
            Exit Function
        End If
    End If
    LstIsValid = True
End Function

'通过事务处理完成对数据库的操作
Private Function SaveCard() As Boolean
    Dim recItemNature As rdoResultset, Strsql As String
    Dim strCostMethod As String
    
    SaveCard = False
    On Error GoTo ErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
    If Not mblnIsChanged Then
        SaveCard = True
        GoTo ErrHandle
    End If
    
    If Trim(txtInput.Text) = "" Then
        ShowMsg hwnd, "商品性质名称不能为空！", vbExclamation, Caption
        txtInput.SetFocus
        GoTo ErrHandle
    End If
    Strsql = "SELECT * FROM ItemNature WHERE strItemNatureName='" _
        & txtInput.Text & "' AND lngItemNatureID<>" _
        & IIf(mblnIsNew, 0, mlngItemNatureID)
    Set recItemNature = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenForwardOnly)
    If Not recItemNature.EOF Then
        ShowMsg hwnd, "商品性质名称不能为重复,请重新录入！“", vbExclamation, Caption
        txtInput.SetFocus
        recItemNature.Close
        txtInput.SetFocus
        GoTo ErrHandle
    Else
        recItemNature.Close
    End If
    If cboNature(0).Text = "" Then
        ShowMsg hwnd, "商品类别不能为空！", vbExclamation, Caption
        cboNature(0).SetFocus
        GoTo ErrHandle
    End If
    GetLstValue
    If Not LstIsValid Then GoTo ErrHandle
    strCostMethod = cboNature(1).ListIndex + 1
    #If conVersionType = 8 Then
        If strCostMethod = 6 Then strCostMethod = 8
    #ElseIf conVersionType = 16 Then
        strCostMethod = 2
    #End If
    If mblnIsNew Then
        mlngItemNatureID = GetNewID("ItemNature")
        Strsql = "INSERT INTO ItemNature(lngItemNatureID,strItemNatureName," _
            & "strItemCategory," & "lngSaleAccountID,lngCostAccountID,lngStockAccountID," _
            & "lngDiffAccountID,lngStockTaxAccountID,lngTaxID," _
            & "strCostMethod) VALUES(" & mlngItemNatureID & ",'" & txtInput.Text & "'," _
            & cboNature(0).ListIndex + 1 & "," & mlngLstID(1) & "," & mlngLstID(2) _
            & "," & mlngLstID(3) & "," & mlngLstID(4) & "," & mlngLstID(5) & "," _
            & mlngLstID(0) & "," & strCostMethod & ")"
        If Not gclsBase.ExecSQL(Strsql) Then GoTo ErrHandle
    Else
        Strsql = "UPDATE ItemNature SET strItemNatureName='" & txtInput.Text _
            & "',strItemCategory=" & cboNature(0).ListIndex + 1 & ",lngSaleAccountID=" _
            & mlngLstID(1) & ",lngCostAccountID=" & mlngLstID(2) & ",lngStockAccountID=" _
            & mlngLstID(3) & ",lngDiffAccountID=" & mlngLstID(4) & ",lngStockTaxAccountID=" _
            & mlngLstID(5) & ",lngTaxID=" & mlngLstID(0) & ",strCostMethod=" _
            & strCostMethod & " WHERE lngItemNatureID=" & mlngItemNatureID
        If Not gclsBase.ExecSQL(Strsql) Then GoTo ErrHandle
    End If
    gclsBase.BaseWorkSpace.CommitTrans
    mblnIsChanged = False
    SaveCard = True
    gclsSys.SendMessage CStr(Me.hwnd), Message.msgItemNature
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollbackTrans
End Function
'根据列表框输入信息来调用卡片
Private Sub lstNature_ItemNotExist(Index As Integer)

    If Index = 0 Then
        If frmMsgAdd.MsgAddShow("税率不存在", "税率列表中没有“" _
            & lstNature(Index).Text & "”！") = vbCancel Then
            lstNature(Index).Text = ""
            Exit Sub
        End If
    Else
        If frmMsgAdd.MsgAddShow("科目不存在", "科目列表中没有“" _
            & lstNature(Index).Text & "”！") = vbCancel Then
            lstNature(Index).Text = ""
            Exit Sub
        End If
    End If
    lstNature_AddNew Index
End Sub

Private Sub lstNature_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
'    If KeyCode = vbKeyReturn Then SendKeys "{TAB}"
End Sub

Private Sub lstNature_LostFocus(Index As Integer)
    If mblnIsNew Then
        cmdOKCancel(2).Default = True
    Else
        cmdOKCancel(0).Default = True
    End If
End Sub

Private Sub GetLstValue()
    Dim i As Integer
    
    For i = 0 To 5
        If Trim(lstNature(i).Text) = "" Then mlngLstID(i) = 0
    Next i
End Sub

Private Sub mclsMainControl_ChildActive()
    gclsSys.CurrFormName = Me.hwnd
End Sub

Private Sub mclsMainControl_EditShowList()
    ShowRelationList
End Sub

Private Sub txtInput_Change()
    If mblnIsInit Then Exit Sub
    If ContainErrorChar(txtInput.Text) Then BKKEY txtInput.hwnd
    mblnIsChanged = True
End Sub