frmitemtaxlistcard.frm

金算盘软件代码

'          strSql = "select * from Account where lngAccountID=" & lngID & " and blnIsQuantity=true"
'          Set recAccount = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenForwardOnly)
'          If Not recAccount.EOF Then
'             ShowMsg 0, "税种税率中的进，销项税科目不能有数量核算属性，请重新选择会计科目！", _
'                      vbExclamation + MB_TASKMODAL, Me.Caption
'             lstTxtItemTax(Index).SelStart = 0
'             lstTxtItemTax(Index).SelLength = strLen(lstTxtItemTax(0).Text)
'             lstTxtItemTax(Index).SetFocus
'             Exit Sub
'          End If
'          recAccount.Close
'       End If
    End If
    
    mblnIsEditAdd = False
    If Me.Caption = "修改商品税率" Then
       cmdItemTax(0).Default = True
       cmdItemTax(2).Default = False
    Else
       cmdItemTax(0).Default = False
       cmdItemTax(2).Default = True
    End If
End Sub
Private Function DesineAccount(ByVal lngAccountID As Long, ByVal mindex As Integer) As Boolean
    Dim lngID As Long
    Dim strSql As String
    Dim recAccount As rdoResultset
    
       DesineAccount = False
       lngID = lngAccountID
       If lngID > 0 Then
          strSql = "select * from Account where lngAccountID=" & lngID & " and blnIsDetail=1"
          Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
          If recAccount.EOF Then
             ShowMsg 0, "“" & lstTxtItemTax(mindex).Text & "“会计科目不是末级科目，请重新选择会计科目！", _
                      vbExclamation + MB_TASKMODAL, Me.Caption
             lstTxtItemTax(mindex).SelStart = 0
             lstTxtItemTax(mindex).SelLength = strLen(lstTxtItemTax(mindex).Text)
             lstTxtItemTax(mindex).SetFocus
             Exit Function
          End If
          recAccount.Close
          
          strSql = "select * from Account where lngAccountID=" & lngID & " and blnIsQuantity=1"
          Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
          If Not recAccount.EOF Then
             ShowMsg 0, "税种税率中的进，销项税科目不能有数量核算属性，请重新选择会计科目！", _
                      vbExclamation + MB_TASKMODAL, Me.Caption
             lstTxtItemTax(mindex).SelStart = 0
             lstTxtItemTax(mindex).SelLength = strLen(lstTxtItemTax(mindex).Text)
             lstTxtItemTax(mindex).SetFocus
             Exit Function
          End If
          recAccount.Close
       End If
       DesineAccount = True
End Function

Private Sub lstTxtItemTax_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
 mblnIsChanged = True
End Sub

Private Sub txtItemTax_Change(Index As Integer)
    Dim intCount As Integer
    Dim i As Integer
    
   
    If mblnChangeIsFirst = True Then Exit Sub
    Select Case Index
            Case 0
                If ContainErrorChar(txtItemTax(0).Text, "'|") Then
                   SendKeys "{BS}"
                   Exit Sub
                End If
                mstrTaxName = txtItemTax(Index).Text
            Case 1
                If Not ChickIsRight(txtItemTax(Index).Text) Then Exit Sub
                If Val(txtItemTax(1).Text) > 100 Then
                   SendKeys "{BS}"
                   Exit Sub
                End If
                If Not IsNbite(txtItemTax(1).Text, 2) Then
                   SendKeys "{BS}"
                   Exit Sub
                End If
                mdblPurchaseTaxRate = Val(txtItemTax(1).Text)
                If txtItemTax(1).Text = 0 Or Len(Trim(txtItemTax(1).Text)) = 0 Then
                   lstTxtItemTax(0).Text = ""
                   lstTxtItemTax(0).Enabled = False
                   lstTxtItemTax(0).BackColor = &H80000004
                   
                   lblItemTax(3).Enabled = False
                Else
                   lstTxtItemTax(0).Enabled = True
                   lstTxtItemTax(0).BackColor = &H80000005
                   lblItemTax(3).Enabled = True
                End If
            Case 2
                If Not ChickIsRight(txtItemTax(Index).Text) Then Exit Sub
                If Val(txtItemTax(2).Text) > 100 Then
                   SendKeys "{BS}"
                   Exit Sub
                End If
                If Not IsNbite(txtItemTax(Index).Text) Then
                   SendKeys "{BS}"
                   Exit Sub
                End If
                mdblSaleTaxRate = Val(txtItemTax(Index).Text)
                If txtItemTax(2).Text = 0 Or Len(Trim(txtItemTax(2).Text)) = 0 Then
                   lstTxtItemTax(1).Text = ""
                   lstTxtItemTax(1).Enabled = False
                   lstTxtItemTax(1).BackColor = &H80000004
                   lstTxtItemTax(1).TabStop = False
                   lblItemTax(4).Enabled = False
                Else
                   lstTxtItemTax(1).Enabled = True
                   lstTxtItemTax(1).BackColor = &H80000005
                   lstTxtItemTax(1).TabStop = True
                   lblItemTax(4).Enabled = True
                End If
    End Select
End Sub


Private Sub txtItemTax_GotFocus(Index As Integer)
    txtItemTax(Index).SelStart = 0
    txtItemTax(Index).SelLength = strLen(txtItemTax(Index).Text)
End Sub

Private Sub txtItemTax_KeyPress(Index As Integer, KeyAscii As Integer)
     mblnIsChanged = True
    If KeyAscii = vbKeySpace Then   '控制空格键的输入
       SendKeys "{BS}"
       Exit Sub
    End If
    If KeyAscii = 13 Then SendKeys "{TAB}"    '对输入回车键的处理
    
End Sub

Private Sub txtItemTax_LostFocus(Index As Integer)
        
         If Index = 1 Or Index = 2 Then
            If Len(Trim(txtItemTax(Index).Text)) = 0 Then txtItemTax(Index).Text = 0
         End If
End Sub

Private Function AddRecord() As Boolean
    Dim strSql As String
    Dim strName As String
    Dim rectemp As rdoResultset
    
    AddRecord = False
    
    If Trim(txtItemTax(0).Text) = "" Then
        ShowMsg 0, "税率名称不能为空！", vbExclamation + MB_TASKMODAL, Caption
        txtItemTax(0).SetFocus
        Exit Function
    Else
       mstrTaxName = Trim(txtItemTax(0).Text)
    End If
    If Not IsNumeric(txtItemTax(1).Text) Then
       ShowMsg 0, "进项税税率必须为数字型！", vbExclamation + MB_TASKMODAL, Caption
       txtItemTax(1).SelStart = 0
       txtItemTax(1).SelLength = strLen(txtItemTax(1).Text)
       txtItemTax(1).SetFocus
       Exit Function
    End If
    If txtItemTax(1).Text <> 0 Then
       If Trim(lstTxtItemTax(0).Text) = "" Then
          ShowMsg 0, "进项税科目不能为空！", vbExclamation + MB_TASKMODAL, Caption
          SendKeys "%A"
          Exit Function
       Else
          mlngPurchaseTaxAccountID = lstTxtItemTax(0).TextMatrix(lstTxtItemTax(0).ReferRow, 1)
          If Not DesineAccount(mlngPurchaseTaxAccountID, 0) Then
              Exit Function
           End If
       End If
       mdblPurchaseTaxRate = Val(txtItemTax(1).Text)
    Else
       mdblPurchaseTaxRate = 0
       mlngPurchaseTaxAccountID = 0
    End If
             
    If Not IsNumeric(txtItemTax(2).Text) Then
       ShowMsg 0, "销项税税率必须为数字！", vbExclamation + MB_TASKMODAL, Caption
       txtItemTax(2).SelStart = 0
       txtItemTax(2).SelLength = strLen(txtItemTax(2).Text)
       txtItemTax(2).SetFocus
       Exit Function
    End If
    If txtItemTax(2).Text <> 0 Then
       If Trim(lstTxtItemTax(1).Text) = "" Then
          ShowMsg 0, "销项税科目不能为空！", vbExclamation + MB_TASKMODAL, Caption
          SendKeys "%C"
          Exit Function
       Else
           mlngSaleTaxAccountID = lstTxtItemTax(1).TextMatrix(lstTxtItemTax(1).ReferRow, 1)
           If Not DesineAccount(mlngSaleTaxAccountID, 1) Then
              Exit Function
           End If
       End If
       mdblSaleTaxRate = Val(txtItemTax(2).Text)
    Else
       mlngSaleTaxAccountID = 0
       mdblSaleTaxRate = 0
    End If
    
    If mblnIsChanged = False Then
       Unload Me
       Exit Function
    End If
    strName = txtItemTax(0).Text
    strSql = "SELECT * FROM tax WHERE strTaxName= '" & strName & "'"
    Set rectemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rectemp.EOF = False Then
        ShowMsg 0, "已有同名税率名称存在!", vbExclamation + MB_TASKMODAL, Caption
        txtItemTax(0).SetFocus
        Exit Function
    End If
    
    mblnIsInActive = chkStop.Value
    strSql = "INSERT INTO Tax (strTaxName,blnIsInActive,dblPurchaseTaxRate,dblSaleTaxRate,lngPurchaseTaxAccountID,lngSaleTaxAccountID) VALUES ( '" _
            & mstrTaxName & "'," & IIf(mblnIsInActive, 1, 0) & "," & mdblPurchaseTaxRate & "," & mdblSaleTaxRate & "," & mlngPurchaseTaxAccountID & "," & mlngSaleTaxAccountID & ")"
    gclsBase.BaseDB.Execute strSql
    
    AddRecord = True
    mblnIsChanged = False
    gclsSys.SendMessage CStr(Me.hwnd), Message.msgTax
End Function

Private Function EditRecord() As Boolean
    Dim strSql As String
    Dim rectemp As rdoResultset
    Dim strName As String
    
    EditRecord = False
    If Trim(txtItemTax(0).Text) = "" Then
        ShowMsg 0, "税率名称不能为空！", vbExclamation + MB_TASKMODAL, Caption
        txtItemTax(0).SetFocus
        Exit Function
    Else
       mstrTaxName = Trim(txtItemTax(0).Text)
    End If
    
    If Not IsNumeric(txtItemTax(1).Text) Then
       ShowMsg 0, "进项税税率必须为数字型！", vbExclamation + MB_TASKMODAL, Caption
       txtItemTax(1).SelStart = 0
       txtItemTax(1).SelLength = strLen(txtItemTax(1).Text)
       txtItemTax(1).SetFocus
       Exit Function
    End If
    If txtItemTax(1).Text <> 0 Then
       If Trim(lstTxtItemTax(0).Text) = "" Then
          ShowMsg 0, "进项税科目不能为空！", vbExclamation + MB_TASKMODAL, Caption
          SendKeys "%A"
          'lstTxtItemTax(0).SetFocus
          Exit Function
       Else
          mlngPurchaseTaxAccountID = lstTxtItemTax(0).TextMatrix(lstTxtItemTax(0).ReferRow, 1)
          If Not DesineAccount(mlngPurchaseTaxAccountID, 0) Then
              Exit Function
           End If
       End If
       mdblPurchaseTaxRate = Val(txtItemTax(1).Text)
     Else
          mdblPurchaseTaxRate = 0
          mlngPurchaseTaxAccountID = 0
     End If
             
     If Not IsNumeric(txtItemTax(2).Text) Then
       ShowMsg 0, "销项税税率必须为数字！", vbExclamation + MB_TASKMODAL, Caption
       txtItemTax(2).SelStart = 0
       txtItemTax(2).SelLength = strLen(txtItemTax(2).Text)
       txtItemTax(2).SetFocus
       Exit Function
    End If
     If txtItemTax(2).Text <> 0 Then
        If Trim(lstTxtItemTax(1).Text) = "" Then
           ShowMsg Me.hwnd, "销项税科目不能为空", vbExclamation, Caption
           SendKeys "%C"
           'lstTxtItemTax(1).SetFocus
           Exit Function
        Else
           mlngSaleTaxAccountID = lstTxtItemTax(1).TextMatrix(lstTxtItemTax(1).ReferRow, 1)
           If Not DesineAccount(mlngSaleTaxAccountID, 1) Then
              Exit Function
           End If
        End If
        mdblSaleTaxRate = Val(txtItemTax(2).Text)
     Else
           mdblSaleTaxRate = 0
           mlngSaleTaxAccountID = 0
     End If
        
    If mblnIsChanged = False Then
       Unload Me
       Exit Function
    End If
    
    mblnIsInActive = chkStop.Value
    strName = txtItemTax(0).Text
    strSql = "SELECT * FROM tax WHERE strtaxName= '" & strName & "' AND lngTaxID NOT LIKE " & mlngTaxID
    Set rectemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rectemp.EOF = False Then
        ShowMsg 0, "已有同名税率名称存在！", vbExclamation + MB_TASKMODAL, Caption
        txtItemTax(0).SetFocus
        Exit Function
    End If
   
    strSql = "UPDATE Tax SET strTaxName= '" & mstrTaxName & "', blnIsInActive=" & IIf(mblnIsInActive, 1, 0) _
              & ",dblPurchaseTaxRate=" & mdblPurchaseTaxRate & ",dblSaleTaxRate=" _
              & mdblSaleTaxRate & ",lngPurchaseTaxAccountID=" & _
              mlngPurchaseTaxAccountID & ",lngSaleTaxAccountID=" & mlngSaleTaxAccountID _
              & " WHERE lngTaxID=" & mlngTaxID
    If gclsBase.ExecSQL(strSql) Then
       mblnIsChanged = False
       EditRecord = True
       gclsSys.SendMessage CStr(Me.hwnd), Message.msgTax
    End If
End Function
Private Function TaxIsUsed(ByVal lngID As Long) As Boolean
    TaxIsUsed = True
    If CheckIDUsed("ItemNature", "lngTaxID", lngID) Then Exit Function
    If CheckIDUsed("PurchaseOrderDetail", "lngTaxID", lngID) Then Exit Function
    If CheckIDUsed("SaleOrderDetail", "lngTaxID", lngID) Then Exit Function
    If CheckIDUsed("ARAPInit", "lngTaxID", lngID) Then Exit Function
    If CheckIDUsed("ItemActivityDetail", "lngTaxID", lngID) Then Exit Function
    TaxIsUsed = False
End Function
Public Function DelCard(ByVal lngID As Long, Optional strName As String = "") As Boolean
    Dim lngTaxDelID As Long
    Dim strSql As String
    Dim strFName As String
    Dim rectemp As rdoResultset
    Dim intMsg As Integer
    
    If strName = "" Then
       strFName = "该"
    Else
       strFName = strName
    End If
    lngTaxDelID = lngID
    DelCard = False
    strSql = "SELECT * FROM Tax WHERE lngTaxID =" & lngTaxDelID
    Set rectemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rectemp.EOF = True Then
        Exit Function
    End If
    If lngID = 1 Then
       ShowMsg 0, "不能删除零税率！", vbExclamation + MB_TASKMODAL, "删除商品税率"
       Exit Function
    End If
    If TaxIsUsed(lngTaxDelID) Then
       ShowMsg 0, strFName & "商品税率已经有业务发生，不能删除！", _
                  vbExclamation + MB_TASKMODAL, "删除商品税率"
       Exit Function
    End If
    intMsg = ShowMsg(0, "你确实要删除" & strFName & "商品税率吗？", _
                  vbQuestion + vbYesNo + MB_TASKMODAL, "删除商品税率")
    If intMsg = vbYes Then
       strSql = "DELETE FROM Tax WHERE lngTaxID =" & lngTaxDelID
       DelCard = gclsBase.ExecSQL(strSql)
       'If DelCard Then gclsSys.SendMessage CStr(Me.hwnd), Message.msgTax
    End If
End Function

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

Private Sub txtItemTax_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
 mblnIsChanged = True
End Sub