frmtax.frm

金算盘软件代码

        Caption = "修改个人所得税扣税标准"
        cmdNext.Visible = False
        InitCard
        Show vbModal
    End If
End Sub


Private Function CodeIsUsed(ByVal lngID As Long) As Boolean
    Dim strFname As String
    strFname = "lngPersonTaxTypeID"
    
    CodeIsUsed = True
    If CheckIDUsed("Employee", strFname, lngID) Then Exit Function
   
    CodeIsUsed = False
End Function

Public Function DelCard(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 blnExec As Boolean
    
    DelCard = False
    If Not CheckIDUsed("persontaxtype", "lngpersontaxtypeid", lngID) Then
        Exit Function
    End If
    
'    If frmEmployeeList.IsShowCard(3) = True Then
'       If lngID = frmTaxTypeListcard.getID Then
'          ShowMsg 0, "不能删除当前编辑的个人所得税扣税标准！", vbExclamation + MB_TASKMODAL, "删除个人所得税扣税标准"
'          'frmTaxTypeListcard.Show
'          Exit Function
'       End If
'    End If
    If CodeIsUsed(lngID) Then
        ShowMsg lnghWnd, "该个人所得税扣税标准已经有业务发生,不允许删除！", _
                    vbExclamation + MB_TASKMODAL, "删除个人所得税扣税标准"
        Exit Function
    End If
    If ShowMsg(lnghWnd, "你确实要删除该个人所得税扣税标准吗?", _
                  vbQuestion + vbYesNo + MB_TASKMODAL, "删除个人所得税扣税标准") = vbNo Then Exit Function
    strSql = "DELETE   FROM PersonTaxType WHERE lngPersonTaxTypeID=" & lngID
    blnExec = gclsBase.ExecSQL(strSql)
    If blnExec = True Then
        If Not blnFromList Then gclsSys.SendMessage Me.hwnd, msgTaxType
    End If
    DelCard = blnExec
End Function
Private Function InitCard(Optional strName As String = "") As Boolean
    Dim recTax As rdoResultset, strSql As String
   
    InitCard = True
    If Not mblnIsNew Then
        strSql = "SELECT * FROM PersonTaxType WHERE lngPersonTaxTypeID=" & mlngTaxID
        Set recTax = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recTax.EOF Then
            ShowMsg 0, "当前个人所得税扣税标准不存在，不能修改！", _
                    vbExclamation + MB_TASKMODAL, Caption
            Unload Me
            InitCard = False
            Exit Function
        Else
            mstrTaxName = recTax!strPersonTaxTypeName
            txtTaxType(0).Text = mstrTaxName
            mdblStart = recTax!dblStartAmount
            If Left(recTax!dblStartAmount, 1) = "." Then
                txtTaxType(1).Text = "0" & mdblStart
            Else
                txtTaxType(1).Text = mdblStart
            End If
            mdblDeductAmount = recTax!dblDeductAmount
            If Left(recTax!dblDeductAmount, 1) = "." Then
                txtTaxType(2).Text = "0" & mdblDeductAmount
            Else
                txtTaxType(2).Text = mdblDeductAmount
            End If
            mdblStartTaxRate = recTax!dblStartTaxRate
            If Left(recTax!dblStartTaxRate, 1) = "." Then
                txtTaxType(3).Text = "0" & mdblStartTaxRate
            Else
                txtTaxType(3).Text = mdblStartTaxRate
            End If
            If mdblDeductAmount = 0 Then txtTaxType(2) = ""
            If mdblStartTaxRate = 0 Then txtTaxType(3) = ""
        End If
        recTax.Close
    Else
        txtTaxType(0).Text = strName
        txtTaxType(1).Text = ""
        txtTaxType(2).Text = ""
        txtTaxType(3).Text = ""
        txtTaxType(0).SelStart = 0
        txtTaxType(0).SelLength = StrLen(txtTaxType(0).Text)
        mstrTaxName = strName
        mdblStart = 0
        mdblDeductAmount = 0
        mdblStartTaxRate = 0
    End If
End Function

Private Sub txtTaxType_Change(Index As Integer)
    If Trim(txtTaxType(Index).Text) = "" Then Exit Sub
    Select Case Index
     Case 0
          If ContainErrorChar(txtTaxType(Index).Text, "'|") Then
             BKKEY txtTaxType(Index).hwnd
             Exit Sub
          End If
          mstrTaxName = Trim(txtTaxType(Index).Text)
     Case 1, 2
          If Not IsNumeric(txtTaxType(Index).Text) Then
             BKKEY txtTaxType(Index).hwnd
             Exit Sub
          End If
          If strCount(txtTaxType(Index).Text, "-") <> 0 Then   '检查减号
             BKKEY txtTaxType(Index).hwnd
             Exit Sub
          End If
          If StrLen(txtTaxType(Index).Text) > 15 Then
             BKKEY txtTaxType(Index).hwnd
          End If
          If Index = 1 Then
             mdblStart = CDbl(Trim(txtTaxType(Index).Text))
          Else
             mdblDeductAmount = CDbl(Trim(txtTaxType(Index).Text))
          End If
    Case 3
         If Not IsNumeric(txtTaxType(Index).Text) Then
             BKKEY txtTaxType(Index).hwnd
             Exit Sub
          End If
          If strCount(txtTaxType(Index).Text, "-") <> 0 Then   '检查减号
             BKKEY txtTaxType(Index).hwnd
             Exit Sub
          End If
          If Val(txtTaxType(Index)) >= 100 Then
             BKKEY txtTaxType(Index).hwnd
             Exit Sub
          End If
          mdblStartTaxRate = CDbl(Trim(txtTaxType(Index).Text))
    End Select
End Sub

Private Sub txtTaxType_GotFocus(Index As Integer)
    txtTaxType(Index).Tag = txtTaxType(Index).Text
End Sub

Private Sub txtTaxType_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If mblnIsFirst Then
       mblnIsFirst = False
       Exit Sub
    End If
    mblnIsChanged = True
End Sub

Private Sub txtTaxType_LostFocus(Index As Integer)
    If txtTaxType(Index).Tag = txtTaxType(Index).Text Then Exit Sub    'Or txtTaxType(Index).Text = "" Then Exit Sub
       
    Select Case Index
           Case 0
                mstrTaxName = Trim(txtTaxType(Index).Text)
           Case 1
                mdblStart = CDbl(IIf(Trim(txtTaxType(Index).Text) = "", 0, Trim(txtTaxType(Index).Text)))
           Case 2
                mdblDeductAmount = CDbl(IIf(Trim(txtTaxType(Index).Text) = "", 0, Trim(txtTaxType(Index).Text)))
           Case 3
                mdblStartTaxRate = CDbl(IIf(Trim(txtTaxType(Index).Text) = "", 0, Trim(txtTaxType(Index).Text)))
    End Select
End Sub

Private Sub txtTaxType_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    mblnIsChanged = True
End Sub
Private Function DesineIsRight() As Boolean
         
         DesineIsRight = False
         If txtTaxType(0).Text = "" Then
             ShowMsg 0, "扣税标准名称不能为空！", vbExclamation + MB_TASKMODAL, Caption
             txtTaxType(0).SelStart = 0
             txtTaxType(0).SelLength = StrLen(txtTaxType(0).Text)
             txtTaxType(0).SetFocus
             Exit Function
         End If
         If txtTaxType(1).Text = "" Then
             ShowMsg 0, "起征金额不能为空！", vbExclamation + MB_TASKMODAL, Caption
             txtTaxType(1).SelStart = 0
             txtTaxType(1).SelLength = StrLen(txtTaxType(1).Text)
             txtTaxType(1).SetFocus
             Exit Function
         End If
         
         If InStr(1, txtTaxType(0).Text, "'") <> 0 Then
            ShowMsg 0, "扣税标准名称不能有‘'’符号！", vbExclamation + MB_TASKMODAL, Caption
            txtTaxType(0).SelStart = 0
            txtTaxType(0).SelLength = StrLen(txtTaxType(0).Text)
            txtTaxType(0).SetFocus
            Exit Function
         ElseIf InStr(1, txtTaxType(0).Text, "|") <> 0 Then
            ShowMsg 0, "扣税标准名称不能有‘|’符号！", vbExclamation + MB_TASKMODAL, Caption
            txtTaxType(0).SelStart = 0
            txtTaxType(0).SelLength = StrLen(txtTaxType(0).Text)
            txtTaxType(0).SetFocus
            Exit Function
         End If
         If Len(txtTaxType(0).Text) > 50 Then
             ShowMsg 0, "扣税标准名称太长！", vbExclamation + MB_TASKMODAL, Caption
             txtTaxType(0).SelStart = 0
             txtTaxType(0).SelLength = StrLen(txtTaxType(0).Text)
             txtTaxType(0).SetFocus
             Exit Function
         End If
         If mdblStart <= 0 Then
             ShowMsg 0, "起征金额必需大于零！", vbExclamation + MB_TASKMODAL, Caption
             txtTaxType(1).SelStart = 0
             txtTaxType(1).SelLength = StrLen(txtTaxType(1).Text)
             txtTaxType(1).SetFocus
             Exit Function
         End If
         If mdblDeductAmount > 0 And mdblDeductAmount < mdblStart Then
            ShowMsg 0, "扣除金额不为零时,扣除金额应大于等于起征金额！", vbExclamation + MB_TASKMODAL, Caption
            txtTaxType(2).SelStart = 0
            txtTaxType(2).SelLength = StrLen(txtTaxType(2).Text)
            txtTaxType(2).SetFocus
            Exit Function
         End If
         If mdblStartTaxRate > 0 And mdblDeductAmount <= 0 Then
            ShowMsg 0, "扣除金额内税率不为零时,扣除金额必需大于零！", vbExclamation + MB_TASKMODAL, Caption
            txtTaxType(2).SelStart = 0
            txtTaxType(2).SelLength = StrLen(txtTaxType(2).Text)
            txtTaxType(2).SetFocus
            Exit Function
         End If
         DesineIsRight = True
End Function

Private Function SaveCard() As Boolean
        Dim strSql As String
        Dim recTemp As rdoResultset
        Dim blnExec As Boolean
        Dim lngTaxID As Long
         
        lngTaxID = mlngTaxID
        SaveCard = False
        If mblnIsChanged = False Then
           Unload Me
           Exit Function
        End If
        If Not DesineIsRight() Then Exit Function
        
        strSql = "SELECT * FROM PersonTaxType WHERE strPersonTaxTypeName='" & mstrTaxName _
                  & "' AND lngPersonTaxTypeID NOT LIKE " & mlngTaxID
        Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recTemp.EOF = False Then
           ShowMsg 0, "个人所得税扣税标准已存在", vbExclamation + MB_TASKMODAL, Caption
           txtTaxType(0).SetFocus
           recTemp.Close
           Exit Function
        ElseIf mblnIsNew Then
           strSql = "SELECT Max(lngPersonTaxTypeID) AS MaxID FROM PersonTaxType "
           Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
           If Not recTemp.EOF Then
              mlngTaxID = Format(recTemp!maxID, "@;0") + 1
           Else
              mlngTaxID = 1
           End If
'            mlngTaxID = GetNewID("PersonTaxType")
           strSql = "INSERT INTO PersonTaxType (lngPersonTaxTypeID,strPersonTaxTypeName,dblStartAmount," _
                     & "dblDeductAmount,dblStartTaxRate) VALUES(" & mlngTaxID & ",'" & _
                     mstrTaxName & "'," & mdblStart & "," & mdblDeductAmount & "," & mdblStartTaxRate & ")"
           blnExec = gclsBase.ExecSQL(strSql)
        Else
           strSql = "UPDATE PersonTaxType SET strPersonTaxTypeName='" & mstrTaxName _
                    & "',dblStartAmount=" & mdblStart & ",dblDeductAmount=" & mdblDeductAmount _
                    & ",dblStartTaxRate=" & mdblStartTaxRate & " where lngPersonTaxTypeID=" & mlngTaxID
           blnExec = gclsBase.ExecSQL(strSql)
        End If
        
        If blnExec = True Then
           SaveCard = True
           mblnIsChanged = False
           gclsSys.SendMessage CStr(Me.hwnd), Message.msgTaxType
        End If
'        mlngTaxID = lngTaxID
        
End Function