frmpersontaxlistcard.frm

金算盘软件代码

VERSION 5.00
Begin VB.Form frmPersonTaxListCard 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "新增个人所得税税率"
   ClientHeight    =   2070
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4965
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   2070
   ScaleWidth      =   4965
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox txtData 
      Height          =   285
      Index           =   1
      Left            =   1500
      TabIndex        =   10
      Top             =   1350
      Width           =   1875
   End
   Begin VB.TextBox txtData 
      Height          =   285
      Index           =   0
      Left            =   240
      TabIndex        =   8
      Top             =   1350
      Width           =   1065
   End
   Begin VB.CommandButton cmdPersonTax 
      Height          =   345
      Index           =   2
      Left            =   3660
      Style           =   1  'Graphical
      TabIndex        =   2
      Tag             =   "1009"
      Top             =   960
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdPersonTax 
      Height          =   350
      Index           =   1
      Left            =   3660
      Style           =   1  'Graphical
      TabIndex        =   1
      Tag             =   "1002"
      Top             =   570
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdPersonTax 
      Height          =   350
      Index           =   0
      Left            =   3660
      Style           =   1  'Graphical
      TabIndex        =   0
      Tag             =   "1001"
      Top             =   180
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.Label lblPersonTax 
      Caption         =   "应纳税所得额上限(&A)"
      Height          =   165
      Index           =   3
      Left            =   1560
      TabIndex        =   9
      Top             =   1170
      Width           =   1755
   End
   Begin VB.Label lblPersonTax 
      Caption         =   "税率(&R)"
      Height          =   165
      Index           =   2
      Left            =   270
      TabIndex        =   7
      Top             =   1170
      Width           =   735
   End
   Begin VB.Label lblData 
      BorderStyle     =   1  'Fixed Single
      Height          =   285
      Index           =   1
      Left            =   1530
      TabIndex        =   6
      Top             =   510
      Width           =   1845
   End
   Begin VB.Label lblPersonTax 
      Caption         =   "应纳税所得额下限"
      Height          =   165
      Index           =   1
      Left            =   1560
      TabIndex        =   5
      Top             =   330
      Width           =   1485
   End
   Begin VB.Label lblPersonTax 
      Caption         =   "级次"
      Height          =   165
      Index           =   0
      Left            =   270
      TabIndex        =   4
      Top             =   330
      Width           =   435
   End
   Begin VB.Label lblData 
      BorderStyle     =   1  'Fixed Single
      Height          =   285
      Index           =   0
      Left            =   240
      TabIndex        =   3
      Top             =   510
      Width           =   1065
   End
End
Attribute VB_Name = "frmPersonTaxListCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'功能:           完成个人所得税税率的增、删、改。
'接口：   AddCard   增加个人所得税税率记录。
'                   参数：intModal 显示模式，strName 用户输入值
'         EditCard  修改摘要记录。
'                   参数： lngRecordID 被修改的记录的ID，intModal 显示模式
'         DelCard   删除摘要记录。
'                   参数： lngRecordID 被删除的记录的ID
'作者：     郑权
'1998.11.16

Option Explicit
Private m_lngPersonTaxID As Integer
Private m_dblAmount2 As Double
Private m_dblTaxRate As Double
Private m_dblLastTaxRate As Double
Private m_dblLastAmount2 As Double
Private m_blnIsChanged As Boolean
Private WithEvents mclsMainControl As MainControl       '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private mdblAmount2IsZero As Boolean
Private ID As Long



Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0)
    
    m_lngPersonTaxID = lngID
    If Not InitCard Then Exit Sub
    If Me.WindowState = 1 Then Me.WindowState = 0
    cmdPersonTax(2).Default = False
    cmdPersonTax(0).Default = True
    Show intModal
    If intModal <> vbModal Then ZOrder 0
End Sub
Public Function AddCard(Optional intModal As Integer = 0) As Long
    
    m_lngPersonTaxID = 0
    If Not InitCard Then Exit Function
    If Me.WindowState = 1 Then Me.WindowState = 0
    cmdPersonTax(0).Default = False
    cmdPersonTax(2).Default = True
    Show intModal
     AddCard = ID
    If intModal <> vbModal Then ZOrder 0
   
End Function
Public Function AddRecord() As Boolean
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim dblDiscountTax As Double
    Dim blnexesql As Boolean
    Dim lngID As Long
    Dim recpersontax As rdoResultset
    
    
    AddRecord = False
    If txtData(0).Text = "" Then
        ShowMsg 0, "税率不能为空！", vbExclamation + MB_TASKMODAL, Caption
        txtData(0).SetFocus
        Exit Function
    ElseIf Val(txtData(0).Text) > 100 Then
        ShowMsg 0, "税率不能大于100%！", vbExclamation + MB_SYSTEMMODAL, Caption
        txtData(0).SetFocus
        Exit Function
    End If
    If Val(txtData(1).Text) <> 0 Then
       If Val(LblData(1).Caption) >= Val(txtData(1).Text) Then
          ShowMsg 0, "应纳税所得额上限小于或等于了应纳税所得额下限！", _
                     vbExclamation + MB_TASKMODAL, Caption
          txtData(1).SetFocus
          Exit Function
       End If
    End If
    
    'm_dblAmount2 = CDbl(txtData(1).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 Function
             End If
          End If
       End If
    End If
    
    
    dblDiscountTax = DiscountTax()
    strSql = "INSERT  INTO PersonTax (lngPersonTaxID,dblAmount1,dblAmount2,dblTaxRate,dblDiscountTax) VALUES ( " _
          & Val(LblData(0).Caption) & "," & Val(LblData(1).Caption) & " ," & Val(txtData(1).Text) & "," & Val(txtData(0).Text) & "," & dblDiscountTax & ")"
    blnexesql = gclsBase.ExecSQL(strSql)
    If blnexesql = True Then
       If mdblAmount2IsZero = True Then
          strSql = "select * from PersonTax order by lngPersonTaxID"
          Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
          recTemp.MoveLast
          If recTemp.RowCount >= 2 Then
             recTemp.MovePrevious
             lngID = recTemp!lngpersontaxID
             recTemp.Close
             strSql = "update PersonTax set dblAmount2=" & Val(LblData(1).Caption) & " where lngPersonTaxID=" & lngID
             blnexesql = gclsBase.ExecSQL(strSql)
          End If
       End If
    End If
    If blnexesql = True Then
       AddRecord = True
       gclsSys.SendMessage CStr(Me.hwnd), Message.msgPersonTax
       m_blnIsChanged = False
    End If
End Function

'编辑记录
Private Function EditRecord() As Boolean
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim recpersontax As rdoResultset
    Dim lngNextID As Long
    Dim i As Integer
    Dim lngTaxID As Long
    Dim blnexec1, blnexec2 As Boolean
    
    EditRecord = False
    If m_blnIsChanged = False Then
       EditRecord = True
       Exit Function
    End If
    If txtData(0).Text = "" Then
        ShowMsg 0, "税率不能为空！", vbExclamation + MB_TASKMODAL, Caption
        txtData(0).SetFocus
        Exit Function
    ElseIf Val(txtData(0).Text) > 100 Then
        ShowMsg 0, "税率不能大于100%！", vbExclamation + MB_SYSTEMMODAL, Caption
        txtData(0).SetFocus
        Exit Function
    End If
    
    '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_SYSTEMMODAL, Me.Caption
                 txtData(1).SetFocus
                 Exit Function
              End If
           End If
       End If
     End If
    
    strSql = "select * from persontax order by lngpersontaxid"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.RowCount > 0 Then
       recTemp.MoveLast
       If Val(recTemp!lngpersontaxID) <> Val(LblData(0)) Then
          If txtData(1) = 0 Then
             ShowMsg 0, "不是末级的应纳税所得额上限不能为零！", _
                         vbExclamation + MB_TASKMODAL, Me.Caption
             txtData(1).SetFocus
             recTemp.Close
             Exit Function
          Else
             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)
          strSql = "select * from persontax order by lngpersontaxid"
          Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
          Do While Not recTemp.EOF '求下一级次
             If recTemp!lngpersontaxID = Val(LblData(0).Caption) Then
                recTemp.MoveNext
                Exit Do
             Else
                recTemp.MoveNext
             End If
          Loop
          If Not recTemp.EOF Then
             lngTaxID = recTemp!lngpersontaxID
             recTemp.Close
             '更新下级应纳税所得额下限
             If NextDiscountTax(lngTaxID) = -1 Then
                ShowMsg 0, "当前级数已被删除，击任一键退出！", _
                          vbExclamation + MB_TASKMODAL, Me.Caption
                Exit Function
             End If
             strSql = "UPDATE PersonTax SET dblAmount1= " & txtData(1).Text & _
              ",dbldiscounttax=" & NextDiscountTax(lngTaxID) & " where lngPersonTaxID=" & lngTaxID
             blnexec2 = gclsBase.ExecSQL(strSql)
             If blnexec1 = True And blnexec2 = True Then
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgPersonTax
                EditRecord = True
                m_blnIsChanged = False
             End If
          Else
             If blnexec1 = True Then
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgPersonTax
                EditRecord = True
                m_blnIsChanged = False
             End If
          End If
       Else