frmitemtax.frm

金算盘软件代码

End Sub

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
           BKKEY txtItemTax(Index).hwnd
           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
           BKKEY txtItemTax(Index).hwnd
           Exit Sub
        End If
        If Not IsNbite(txtItemTax(1).Text, 2) Then
           BKKEY txtItemTax(Index).hwnd
           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).TabStop = False
           lstTxtItemTax(0).BackColor = &H80000004
           lblItemTax(3).Enabled = False
        Else
           lstTxtItemTax(0).Enabled = True
           lstTxtItemTax(0).TabStop = 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
           BKKEY txtItemTax(Index).hwnd
           Exit Sub
        End If
        If Not IsNbite(txtItemTax(Index).Text) Then
           BKKEY txtItemTax(Index).hwnd
           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).TabStop = False
           lstTxtItemTax(1).BackColor = &H80000004
           lblItemTax(4).Enabled = False
        Else
           lstTxtItemTax(1).Enabled = True
           lstTxtItemTax(1).TabStop = True
           lstTxtItemTax(1).BackColor = &H80000005
           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
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 mblnIsExist Then Exit Function
    If Trim(txtItemTax(0).Text) = "" Then
        ShowMsg 0, "税率名称不能为空！", vbExclamation + MB_TASKMODAL, Caption
        txtItemTax(0).SetFocus
        Exit Function
    ElseIf InStr(txtItemTax(0).Text, "'") <> 0 Then
        ShowMsg 0, "税率名称不能为空‘'’！", vbExclamation + MB_TASKMODAL, Caption
        txtItemTax(0).SetFocus
        Exit Function
    ElseIf InStr(txtItemTax(0).Text, "|") <> 0 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
          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 0, "销项税科目不能为空！", vbExclamation + MB_TASKMODAL, Caption
          lstTxtItemTax(1).SetFocus
          Exit Function
       Else
           mlngSaleTaxAccountID = lstTxtItemTax(1).TextMatrix(lstTxtItemTax(1).ReferRow, 1)
           If Not DesineAccount(mlngSaleTaxAccountID, 0) 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
    ID = GetNewID("Tax")
    strSql = "INSERT INTO Tax (lngTaxID,strTaxName,blnIsInActive,dblPurchaseTaxRate,dblSaleTaxRate,lngPurchaseTaxAccountID,lngSaleTaxAccountID) VALUES (" & ID & ", '" _
            & 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 mblnIsExist Then Exit Function
    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, 0) 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 = "", Optional ByVal lnghWnd As Long = 0, Optional blnFromList As Boolean = False) 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 lnghWnd, "不能删除零税率！", vbExclamation + MB_TASKMODAL, "删除商品税率"
       Exit Function
    End If
    
'    If frmItemList.IsShowCard(4) = True Then
'       If lngTaxDelID = frmItemTaxListCard.getID Then
'          ShowMsg lnghWnd, "不能删除当前正在修改的商品税率！", vbExclamation + MB_SYSTEMMODAL, "删除商品税率"
'          Exit Function
'       End If
'    End If
'
    If TaxIsUsed(lngTaxDelID) Then
       ShowMsg lnghWnd, strFname & "商品税率已经有业务发生，不能删除！", _
                  vbExclamation + MB_TASKMODAL, "删除商品税率"
       Exit Function
    End If
    intMsg = ShowMsg(lnghWnd, "你确实要删除" & strFname & "商品税率吗？", _
                  vbQuestion + vbYesNo + MB_TASKMODAL, "删除商品税率")
    If intMsg = vbYes Then
       strSql = "DELETE FROM Tax WHERE lngTaxID =" & lngTaxDelID
       DelCard = gclsBase.ExecSQL(strSql)
       If DelCard Then
            If Not blnFromList Then gclsSys.SendMessage CStr(Me.hwnd), Message.msgTax
        End If
    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

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