frmpersontax.frm

金算盘软件代码

             End If
          End If
          If EditDiscountTax(Val(lblData(0).Caption)) = -1 Then
                ShowMsg 0, "当前级数已被删除，击任一键退出！", _
                           vbExclamation + MB_TASKMODAL, Me.Caption
                Exit Function
          End If
          strSql = "UPDATE PersonTax SET dblAmount2=" & txtData(1).Text & _
               " ,dblTaxRate=" & txtData(0).Text & _
               ",dbldiscounttax=" & EditDiscountTax(Val(lblData(0).Caption)) & " WHERE lngPersonTaxID=" & m_lngPersonTaxID
          blnexec1 = gclsBase.ExecSQL(strSql)
          If blnexec1 = True Then
             gclsSys.SendMessage CStr(Me.hwnd), Message.msgPersonTax
             EditRecord = True
             m_blnIsChanged = False
          End If
       End If
    End If
End Function
Public Function DelCard(ByVal lngID As Long, Optional ByVal lnghWnd As Long = 0, Optional blnFromList As Boolean = False) As Boolean
    Dim recTemp As rdoResultset
    Dim strSql As String
    Dim intMsg As Integer
    Dim blnIsDel As Boolean
    
    DelCard = False
    '需要判断是否是末级
'    If frmEmployeeList.IsShowCard(2) = True Then
'       If lngID = frmPersonTaxListCard.PersonTaxID Then
'          ShowMsg lnghWnd, "不能删除当前编辑的个人所得税！", _
'                      vbExclamation + MB_SYSTEMMODAL, "删除个人所得税"
'          Exit Function
'       End If
'    End If
    strSql = "SELECT MAX(lngPersonTaxID) AS MaxID FROM PersonTax"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.EOF = True Then
        Exit Function
    End If
    If recTemp!maxID <> lngID Then
        ShowMsg lnghWnd, "应先删除最后一级个人所得税税率！", _
                     vbExclamation + MB_TASKMODAL, "删除个人所得税"
        Exit Function
    End If
    If CodeIsUsed(lngID) Then Exit Function
    intMsg = ShowMsg(lnghWnd, "你确实要删除当前选取的个人所得税吗？", _
                      vbQuestion + vbYesNo + MB_TASKMODAL, "删除个人所得税")
    If intMsg = vbYes Then
       strSql = "DELETE FROM PersonTax WHERE lngPersonTaxID=" & lngID
       blnIsDel = gclsBase.ExecSQL(strSql)
       If blnIsDel = True Then
           If Not blnFromList Then gclsSys.SendMessage CStr(Me.hwnd), Message.msgPersonTax
       End If
    Else
       Exit Function
    End If
    
    DelCard = blnIsDel
   
End Function
Private Function InitCard() As Boolean
    Dim recpersontax As rdoResultset, strSql As String

    InitCard = True
    If m_lngPersonTaxID > 0 Then
        Caption = "修改个人所得税税率"
        cmdPersonTax(2).Visible = False
        strSql = "SELECT * FROM  PersonTax WHERE lngPersonTaxID=" & m_lngPersonTaxID
        Set recpersontax = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recpersontax.EOF Then
            ShowMsg 0, "当前个人所得税税率不存在，不能修改！", _
                        vbExclamation + MB_TASKMODAL, Caption
            Unload Me
            InitCard = False
            Exit Function
        Else
            lblData(0).Caption = CStr(recpersontax!lngpersontaxID)
            lblData(1).Caption = CStr(recpersontax!dblAmount1)
            m_dblLastAmount2 = recpersontax!dblAmount2
            txtData(1).Text = recpersontax!dblAmount2
            m_dblLastTaxRate = recpersontax!dblTaxRate
            txtData(0).Text = recpersontax!dblTaxRate
        End If
        recpersontax.Close
    Else
        Caption = "新增个人所得税税率"
        cmdPersonTax(2).Visible = True
        strSql = "SELECT * FROM PersonTax order by lngPersonTaxID"
        Set recpersontax = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recpersontax.EOF = False Then
            recpersontax.MoveLast
            lblData(0).Caption = recpersontax!lngpersontaxID + 1
            If recpersontax!dblAmount2 = 0 Then
               lblData(1).Caption = recpersontax!dblAmount1 + 1
               mdblAmount2IsZero = True
            Else
               mdblAmount2IsZero = False
               lblData(1).Caption = recpersontax!dblAmount2
            End If
        Else
            lblData(0).Caption = 1
            lblData(1).Caption = 0
        End If
        txtData(0).Text = ""
        txtData(1).Text = 0
    End If
    
End Function
Private Function CodeIsUsed(ByVal lngID As Long) As Boolean
    CodeIsUsed = True
    If CheckIDUsed("Salary", "lngPersonTaxID", lngID) Then Exit Function
    
    CodeIsUsed = False
End Function



Private Sub cmdPersonTax_Click(Index As Integer)
Dim recpersontax As rdoResultset
Dim strSql As String

    Select Case Index
        Case 0
            If Caption = "修改个人所得税税率" Then
                 If Not (EditRecord) Then
                      Exit Sub
                 End If
            Else
                If Not (AddRecord) Then
                    Exit Sub
                End If
'                strSql = "select * from PersonTax order by lngPersonTaxID"
'                Set recpersontax = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'                If recpersontax.RowCount > 0 Then
'                   recpersontax.MoveLast
'                   ID = recpersontax!lngpersontaxID
'                Else
'                   ID = 0
'                End If
            End If
            Unload Me
            Exit Sub
        Case 1
            m_blnIsChanged = False
            Unload Me
            Exit Sub
        Case 2
            If Not (AddRecord) Then
               Exit Sub
            End If
            txtData(0).Text = ""
            txtData(1).Text = 0
            '需要重新初始化lbl
            strSql = " SELECT * FROM PersonTax order by lngPersonTaxID"
            Set recpersontax = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            recpersontax.MoveLast
            lblData(0).Caption = CStr(recpersontax!lngpersontaxID + 1)
            If recpersontax!dblAmount2 = 0 Then
               lblData(1).Caption = recpersontax!dblAmount1 + 1
               mdblAmount2IsZero = True
            Else
               mdblAmount2IsZero = False
               lblData(1).Caption = recpersontax!dblAmount2
            End If
            recpersontax.Close
         End Select
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If mblnIsList Then
        mblnIsList = False
        Exit Sub
    End If
    If KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdPersonTax(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    On Error GoTo ErrHandle
'    SetHelpID Me.hwnd, 10237
    m_blnIsChanged = False
    
    Utility.LoadFormResPicture Me
'    SendKeys "%{R}"
    'Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_Paint()
  FrameBox Me.hwnd, 150, 150, 3500, 1700
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intResponse As Integer
    
    If UnloadMode = vbFormControlMenu Then
       If m_blnIsChanged Then
          intResponse = ShowMsg(0, "当前个人所得税税率已被修改，是否保存？", _
                       vbQuestion + vbYesNo + MB_TASKMODAL, Caption)
          If intResponse = vbYes Then
             If m_lngPersonTaxID > 0 Then
                Cancel = Not AddRecord
             Else
                Cancel = Not EditRecord
             End If
          ElseIf intResponse = vbCancel Then
            Cancel = True
          End If
       End If
    End If
    If Not Cancel Then m_blnIsChanged = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
     On Error Resume Next
     Utility.UnLoadFormResPicture Me
End Sub

Private Sub txtData_Change(Index As Integer)
    If Not ChickIsRight(txtData(Index).Text) Then Exit Sub
End Sub

Private Sub txtData_GotFocus(Index As Integer)
    txtData(Index).Tag = txtData(Index).Text
End Sub

Private Sub txtData_KeyPress(Index As Integer, KeyAscii As Integer)
m_blnIsChanged = True
End Sub

Private Sub txtData_LostFocus(Index As Integer)
    Dim strSql As String
    Dim recpersontax As rdoResultset
    
    If txtData(Index).Tag = txtData(Index).Text And txtData(Index).Text = "" Then Exit Sub
    If Index = 0 Then
        If txtData(0).Text = "" Then
           ShowMsg 0, "税率不能为空！", vbExclamation + MB_TASKMODAL, Caption
           txtData(0).SetFocus
           Exit Sub
        ElseIf TxtToDouble(txtData(0).Text) >= 100 Or TxtToDouble(txtData(0).Text) < 0 Then
           ShowMsg 0, "税率只能在0--100之间！", vbExclamation + MB_TASKMODAL, Caption
           txtData(0).SetFocus
           Exit Sub
        End If
        If txtData(Index).Text = CStr(m_dblLastTaxRate) Then Exit Sub
        m_dblTaxRate = CDbl(txtData(Index).Text)
    Else
        If txtData(1).Text = "" Then txtData(1).Text = 0
        If txtData(Index).Text = m_dblLastAmount2 Then Exit Sub
        m_dblAmount2 = CDbl(txtData(Index).Text)
'        strSql = "select * from PersonTax order by lngPersonTaxId"
'        Set recpersontax = gclsBase.BaseDB.openresultset(strSql, rdopenstatic)
'        If recpersontax.rowcount > 0 Then
'           Do While Not recpersontax.EOF
'              If recpersontax!lngpersontaxID = lblData(0).Caption Then
'                 recpersontax.MoveNext
'                 Exit Do
'              End If
'              recpersontax.MoveNext
'           Loop
'           If Not recpersontax.EOF Then
'              If recpersontax!dblAmount2 <> 0 Then
'                 If Val(txtData(1).Text) > recpersontax!dblAmount2 Then
'                    ShowMsg 0, "本级应纳税所得额上限大于了下级应纳税所得额上限", _
'                              vbExclamation + MB_TASKMODAL, Me.Caption
'                    txtData(1).SetFocus
'                    Exit Sub
'                 End If
'              End If
'           End If
'        End If
    End If
    m_blnIsChanged = True
'    If m_dblAmount2 <> m_dblLastAmount2 Or m_dblTaxRate <> m_dblLastTaxRate Then
'        m_blnIsChanged = True
'    Else
'        m_blnIsChanged = False
'    End If
End Sub
Private Function EditDiscountTax(ByVal lngID As Long) As Double
    Dim dblLastDiscountTax As Double
    Dim dblLastTaxRate As Double
    Dim strSql As String
    Dim recTax As rdoResultset
    Dim CurdblCount1, CurdblTaxRate As Double
    
    strSql = "select * from PersonTax order by lngPersonTaxID"
    Set recTax = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTax.RowCount > 0 Then
       Do While Not recTax.EOF
          If recTax!lngpersontaxID = lngID Then
             Exit Do
          End If
          recTax.MoveNext
       Loop
       If recTax.EOF Then
          EditDiscountTax = -1
          Exit Function
       ElseIf recTax.RowCount = 1 Then
              dblLastDiscountTax = 0
              dblLastTaxRate = 0
              EditDiscountTax = CDbl(lblData(1).Caption) * CDbl(txtData(0).Text) / 100
       Else
           
           recTax.MovePrevious
           If recTax.BOF Then
              EditDiscountTax = 0
           Else
              dblLastDiscountTax = recTax!dblDiscountTax
              dblLastTaxRate = recTax!dblTaxRate
           'recTax.Close
              EditDiscountTax = CDbl(lblData(1).Caption) * CDbl(txtData(0).Text) / 100 - CDbl(lblData(1).Caption) * dblLastTaxRate / 100 + dblLastDiscountTax
           End If
       End If
       '速算扣除数 = 本级应纳所得额下限×本级税率 - 本级应纳所得额下限×上级税率 + 上级速算扣除数
    Else
       EditDiscountTax = -1
    End If
    recTax.Close
End Function

Private Function NextDiscountTax(ByVal lngID As Long) As Double
    Dim dblLastDiscountTax As Double
    Dim dblLastTaxRate As Double
    Dim strSql As String
    Dim recTax As rdoResultset
    Dim CurdblCount1, CurdblTaxRate As Double
    
    strSql = "select * from PersonTax order by lngPersonTaxID"
    Set recTax = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTax.RowCount > 0 Then
       Do While Not recTax.EOF
          If recTax!lngpersontaxID = lngID Then
             Exit Do
          End If
          recTax.MoveNext
       Loop
       If recTax.EOF Then
          NextDiscountTax = -1
          Exit Function
       ElseIf recTax.RowCount = 1 Then
              dblLastDiscountTax = 0
              dblLastTaxRate = 0
              NextDiscountTax = CDbl(lblData(1).Caption) * CDbl(txtData(0).Text) / 100
       Else
           CurdblTaxRate = recTax!dblTaxRate
           recTax.MovePrevious
           dblLastDiscountTax = recTax!dblDiscountTax
           dblLastTaxRate = recTax!dblTaxRate
           'recTax.Close
           NextDiscountTax = CDbl(txtData(1).Text) * CDbl(CurdblTaxRate) / 100 - CDbl(txtData(1).Text) * dblLastTaxRate / 100 + dblLastDiscountTax
       End If
       '速算扣除数 = 本级应纳所得额下限×本级税率 - 本级应纳所得额下限×上级税率 + 上级速算扣除数
    Else
       NextDiscountTax = -1
    End If
    recTax.Close
End Function
Private Function DiscountTax() As Double
    Dim dblLastDiscountTax As Double
    Dim dblLastTaxRate As Double
    Dim strSql As String
    Dim recTax As rdoResultset
    
    strSql = "select * from PersonTax order by lngPersonTaxID"
    Set recTax = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTax.RowCount > 0 Then
       recTax.MoveLast
       dblLastDiscountTax = recTax!dblDiscountTax
       dblLastTaxRate = recTax!dblTaxRate
       '速算扣除数 = 本级应纳所得额下限×本级税率 - 本级应纳所得额下限×上级税率 + 上级速算扣除数
       DiscountTax = CDbl(lblData(1).Caption) * CDbl(txtData(0).Text) / 100 - CDbl(lblData(1).Caption) * dblLastTaxRate / 100 + dblLastDiscountTax
    Else
       DiscountTax = 0
    End If
    recTax.Close
End Function