frmpersontaxlistcard.frm

金算盘软件代码

          If txtData(1).Text <> 0 Then
             If Val(txtData(1).Text) <= Val(LblData(1)) Then
                ShowMsg 0, "应纳税所得额上限应当大于应纳税所得额下限！", _
                          vbExclamation + MB_TASKMODAL, Caption
                txtData(1).SetFocus
                Exit Function
             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) As Boolean
    Dim recTemp As rdoResultset
    Dim strSql As String
    Dim intMsg As Integer
    Dim blnIsDel As Boolean
    
    DelCard = False
    '需要判断是否是末级
    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 0, "应删除最后一个个人所得税税率!", _
                     vbExclamation + MB_TASKMODAL, "删除个人所得税"
        Exit Function
    End If
    If CodeIsUsed(lngID) Then Exit Function
    intMsg = ShowMsg(0, "你确实要删除当前选取的个人所得税吗？", _
                      vbQuestion + vbYesNo + MB_TASKMODAL, "删除个人所得税")
    If intMsg = vbYes Then
       strSql = "DELETE FROM PersonTax WHERE lngPersonTaxID=" & lngID
       blnIsDel = gclsBase.ExecSQL(strSql)
       If blnIsDel = True 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_Load()
    SetHelpID Me.hwnd, 27006
    m_blnIsChanged = False
    
    frmTaxPersonList.IsShowCard(1) = True
    Utility.LoadFormResPicture Me
'    Set cmdPersonTax(0).Picture = LoadResPicture(1001, vbResBitmap)
'    Set cmdPersonTax(1).Picture = LoadResPicture(1002, vbResBitmap)
'    Set cmdPersonTax(2).Picture = LoadResPicture(1004, vbResBitmap)
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
End Sub

Private Sub Form_Paint()
  FrameBox Me.hwnd, 120, 210, 3555, 1875
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
             Cancel = Not AddRecord
          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)
    Utility.UnLoadFormResPicture Me
    frmTaxPersonList.IsShowCard(1) = False
    gclsSys.CurrFormName = ""
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
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_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
        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
    
    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 = True 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