frmtaxtypelistcard.frm

金算盘软件代码

           ZOrder 0
        End If
    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) As Boolean
    Dim recTemp As Recordset
    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 gclsSys.SendMessage Me.hwnd, msgTaxType
    DelCard = blnExec
End Function
Private Function InitCard(Optional strName As String = "") As Boolean
    Dim recTax As Recordset, strSql As String
   
'    mblnIsFirst = True
    InitCard = True
    If Not mblnIsNew Then
        strSql = "SELECT * FROM PersonTaxType WHERE lngPersonTaxTypeID=" & mlngTaxID
        Set recTax = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenForwardOnly)
        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
            txtTaxType(1).Text = mdblStart
            mdblDeductAmount = recTax!dblDeductAmount
            txtTaxType(2).Text = mdblDeductAmount
            mdblStartTaxRate = recTax!dblStartTaxRate
            txtTaxType(3).Text = mdblStartTaxRate
            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
'    mblnIsFirst = False
End Function



Private Sub txtTaxType_Change(Index As Integer)
    If mblnIsFirst = True 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_KeyPress(Index As Integer, KeyAscii 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
'    mblnIsChanged = True
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
         
         mdblStart = IIf(Trim(txtTaxType(1).Text) = "", 0, Trim(txtTaxType(1).Text))
         mdblDeductAmount = IIf(Trim(txtTaxType(2).Text) = "", 0, Trim(txtTaxType(2).Text))
         mdblStartTaxRate = IIf(Trim(txtTaxType(3).Text) = "", 0, Trim(txtTaxType(3).Text))
         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 Recordset
        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.OpenRecordset(strSql, dbOpenForwardOnly)
        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.OpenRecordset(strSql, dbOpenForwardOnly)
           If Not recTemp.EOF Then
              lngTaxID = recTemp!maxID + 1
           Else
              lngTaxID = 1
           End If
           strSql = "INSERT INTO PersonTaxType (strPersonTaxTypeName,dblStartAmount," _
                     & "lngPersonTaxTypeID,dblDeductAmount,dblStartTaxRate) VALUES ('" & _
                     mstrTaxName & "'," & mdblStart & "," & lngTaxID & _
                     "," & 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