frmsalarytax.frm

金算盘软件代码

VERSION 5.00
Begin VB.Form frmSalaryTax 
   Caption         =   "扣税设置"
   ClientHeight    =   2730
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5025
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2730
   ScaleWidth      =   5025
   StartUpPosition =   3  '窗口缺省
   Begin VB.ComboBox cboTax 
      Height          =   300
      Left            =   1350
      TabIndex        =   2
      Top             =   810
      Width           =   1935
   End
   Begin VB.CommandButton cmdTax 
      Height          =   350
      Index           =   0
      Left            =   3720
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   120
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdTax 
      Height          =   350
      Index           =   1
      Left            =   3720
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   525
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox chkTax 
      Caption         =   "代扣个人所得税"
      Height          =   465
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Value           =   1  'Checked
      Width           =   1695
   End
   Begin VB.Label lblTax 
      Caption         =   " 说明"
      Height          =   255
      Index           =   0
      Left            =   360
      TabIndex        =   6
      Top             =   1320
      Width           =   495
   End
   Begin VB.Label lblTax 
      BackStyle       =   0  'Transparent
      Caption         =   $"frmSalaryTax.frx":0000
      Height          =   735
      Index           =   1
      Left            =   360
      TabIndex        =   5
      Top             =   1680
      Width           =   2895
   End
   Begin VB.Label lblTax 
      BackStyle       =   0  'Transparent
      Caption         =   "扣税项目(&O)"
      Height          =   225
      Index           =   2
      Left            =   240
      TabIndex        =   1
      Top             =   840
      Width           =   1065
   End
End
Attribute VB_Name = "frmSalaryTax"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'扣税设置
'
'功能：设置本次扣税
'
'作者：唐吉禹
'     1998-7-15
'
'输出接口：通过Tax和TaxID属性对frmSalaryEdit的mblnTax,mlngtaxID赋值
'
Option Explicit
Private Sub chkTax_Click()
    If chkTax.Value = 0 Then
        cboTax.Enabled = False
        cboTax.Text = ""
    Else
        cboTax.Enabled = True
    End If
End Sub
Private Sub cmdTax_Click(Index As Integer)
    Dim Strsql As String
    Dim lngSalaryID As Long
    Dim lngViewFieldID As Long
    'Dim recRecordset as rdoresultset
    'Dim recSalaryList as rdoresultset
    'Dim recSalaryFormula as rdoresultset
   
    Dim recRecordset As rdoResultset
    Dim recSalaryList As rdoResultset
    Dim recSalaryFormula As rdoResultset
    
    lngSalaryID = frmSalaryList.SalaryID
    '根据名称查ID
    'Strsql = "SELECT lngViewFieldID FROM ViewField WHERE TRIM(strViewFieldDesc)='" _
        & Trim(cboTax.Text) & "' AND lngViewID=63"
    'Set recSalaryList = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
    
    
    Strsql = "SELECT lngViewFieldID FROM ViewField WHERE RTRIM(LTRIM(strViewFieldDesc))='" _
        & Trim(cboTax.Text) & "' AND lngViewID=63"
    Set recSalaryList = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
    
    If Not recSalaryList.EOF Then
        lngViewFieldID = recSalaryList!lngViewFieldID
    Else
        lngViewFieldID = 0
    End If
    Select Case Index
    '确定
    Case 0
        '已结帐期间的数据不允许修改
        If frmSalaryEdit.IsPostDate Then
            Unload Me
            Exit Sub
        End If
        If chkTax.Value = 1 Then
            '判断扣税项目的存在
            If lngViewFieldID = 0 Then
                ShowMsg Me.hwnd, "扣税项目：" & cboTax.Text & "不存在，不能进行扣税", vbInformation, Me.Caption
                cboTax.SetFocus
                Exit Sub
            Else
                '写入SalaryList
                Strsql = "SELECT * FROM SalaryList WHERE lngSalaryListID=" & lngSalaryID
                'Set recSalaryList = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenDynaset)
                Set recSalaryList = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenDynamic, rdConcurRowVer, rdExecDirect)
                recSalaryList.Edit
                'recSalaryList!blnIsTax = True
                recSalaryList!blnIsTax = 1
                recSalaryList!lngTaxFieldID = lngViewFieldID
                recSalaryList.Update
                recSalaryList.Close
                Set recSalaryList = Nothing
                frmSalaryEdit.Tax = True
                frmSalaryEdit.TaxID = lngViewFieldID
                frmSalaryEdit.Calc = True
                Strsql = "SELECT * FROM SalaryField WHERE lngViewFieldID=3521 AND lngSalaryListID=" _
                    & lngSalaryID
                'Set recRecordset = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
                Set recRecordset = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
                If recRecordset.EOF Then
                    'Strsql = "INSERT INTO SalaryField (lngViewFieldID,lngSalaryFieldNO,blnIsClear,lngSalaryListID) VALUES (3521,101,True," & lngSalaryID & ") "
                    Strsql = "INSERT INTO SalaryField (lngViewFieldID,lngSalaryFieldNO,blnIsClear,lngSalaryListID) VALUES (3521,101,1," & lngSalaryID & ") "
                    gclsBase.BaseDB.Execute Strsql
                End If
                '写SalaryFormula
                Strsql = "SELECT SalaryFormula.* FROM  SalaryFormula Where SalaryFormula.lngSalaryListID=" & lngSalaryID & _
                         " and SalaryFormula.lngViewFieldID= 3521 "
                'Set recSalaryFormula = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenDynaset)
                Set recSalaryFormula = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenDynamic, rdConcurRowVer, rdExecDirect)
                With recSalaryFormula
                    If Not .EOF Then
                        .Edit
                        !strSalaryFormulaDesc = "扣税计算(" & Trim(cboTax.Text) & ")"
                        .Update
                    Else
                        .AddNew
                        !lngViewFieldID = 3521
                        !strSalaryFormula = "CalcTax"
                        !strSalaryFormulaDesc = "扣税计算(" & Trim(cboTax.Text) & ")"
                        !lngSalaryListID = lngSalaryID
                        .Update
                    End If
                End With
                recSalaryFormula.Close
                Set recSalaryFormula = Nothing
                Unload Me
            End If
        Else
            '取消扣税
            'Strsql = "DELETE SalaryField.* FROM SalaryField WHERE lngViewFieldID=3521 AND lngSalaryListID=" _
                & lngSalaryID
            Strsql = "DELETE FROM SalaryField WHERE lngViewFieldID=3521 AND lngSalaryListID=" _
                & lngSalaryID
            gclsBase.BaseDB.Execute Strsql
            'Strsql = "UPDATE SalaryList SET blnIsTax=False,lngTaxFieldID=0 WHERE lngSalaryListID=" _
                & lngSalaryID
            
            Strsql = "UPDATE SalaryList SET blnIsTax=0,lngTaxFieldID=0 WHERE lngSalaryListID=" _
                & lngSalaryID
            gclsBase.BaseDB.Execute Strsql
            
            Strsql = "UPDATE Salary SET dblNowTax=0 WHERE lngSalaryListID=" & lngSalaryID
            gclsBase.BaseDB.Execute Strsql
            'Strsql = "Delete SalaryFormula.* FROM  SalaryFormula Where SalaryFormula.lngSalaryListID=" & lngSalaryID & _
                         " and SalaryFormula.lngViewFieldID= 3521 "
            
            Strsql = "Delete FROM  SalaryFormula Where SalaryFormula.lngSalaryListID=" & lngSalaryID & _
                         " and SalaryFormula.lngViewFieldID= 3521 "
            gclsBase.BaseDB.Execute Strsql
            '计算工资表
            frmSalaryEdit.Calc = True
            Unload Me
        End If
    Case 1
        Unload Me
    End Select
End Sub
Private Sub Form_Load()
    'Dim recViewField as rdoresultset
    Dim recViewField As rdoResultset
    Dim Strsql As String
    Dim lngSalaryViewID
    Dim strName As String
    Dim i As Integer
    Dim lngSalaryID As Long
    '初始化扣税项目
    lngSalaryViewID = frmSalaryList.SalaryViewID
    Strsql = "SELECT lngViewFieldID,strViewFieldDesc FROM ViewField WHERE lngViewID=" _
        & lngSalaryViewID & " AND strTableName='Salary' AND strFieldName <> " _
        & "'Salary.dblNowTax' AND strFieldName <> 'Salary.dblNowZero' AND" _
        & " strFieldName <> 'Salary.dblLastZero'"
    'Set recViewField = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
    Set recViewField = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
    i = 0
    cboTax.Clear
    If Not recViewField.EOF Then
        recViewField.MoveLast
        recViewField.MoveFirst
    End If
    Do While Not recViewField.EOF
        cboTax.AddItem (recViewField!strViewFieldDesc)
        recViewField.MoveNext
    Loop
    '取出本次扣税设置
    lngSalaryID = frmSalaryList.SalaryID
    'Strsql = "SELECT ViewField.strViewFieldDesc FROM SalaryList INNER JOIN ViewField ON " _
        & " SalaryList.lngTaxFieldID=ViewField.lngViewFieldID WHERE lngSalaryListID=" _
        & lngSalaryID
    'Set recViewField = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
    
    Strsql = "SELECT ViewField.strViewFieldDesc FROM SalaryList , ViewField " _
        & " WHERE SalaryList.lngTaxFieldID=ViewField.lngViewFieldID AND lngSalaryListID=" _
        & lngSalaryID
    Set recViewField = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
    
    If Not recViewField.EOF() Then
        cboTax.Text = recViewField!strViewFieldDesc
        chkTax.Value = 1
    Else
        chkTax.Value = 0
    End If
    recViewField.Close
    Set recViewField = Nothing
    Set cmdTax(0).Picture = Utility.GetFormResPicture(1001, 0)
    Set cmdTax(1).Picture = Utility.GetFormResPicture(1002, 0)
    Set Me.Icon = Utility.GetFormResPicture(139, vbResCursor)
    SetHelpID Me.hwnd, 32007
End Sub
Private Sub Form_Paint()
    FrameBox Me.hwnd, 80, 100, 3540, 2660
    FrameBox Me.hwnd, 180, 1400, 3400, 2540
End Sub
Private Sub Form_Unload(Cancel As Integer)
    '判断工资列表是否置灰代扣带缴表
    If chkTax.Value = 1 Then
        frmSalaryList.msgSalaryList.TextMatrix(frmSalaryList.msgSalaryList.Row, 5) = 1
    Else
        frmSalaryList.msgSalaryList.TextMatrix(frmSalaryList.msgSalaryList.Row, 5) = 0
    End If
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (139)
    Set frmSalaryTax = Nothing
End Sub