frmsalarytaxset.frm

金算盘软件代码

VERSION 5.00
Begin VB.Form frmSalaryTaxSet 
   Caption         =   "扣税设置"
   ClientHeight    =   2235
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5025
   HelpContextID   =   60124
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2235
   ScaleWidth      =   5025
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame fra 
      Height          =   2040
      Index           =   2
      Left            =   90
      TabIndex        =   0
      Top             =   90
      Width           =   3480
      Begin VB.Frame fra 
         Caption         =   "说明"
         Height          =   870
         Index           =   1
         Left            =   135
         TabIndex        =   4
         Top             =   990
         Width           =   3165
         Begin VB.Label lblTax 
            BackStyle       =   0  'Transparent
            Caption         =   $"frmSalaryTaxSet.frx":0000
            Height          =   645
            Index           =   1
            Left            =   90
            TabIndex        =   5
            Top             =   225
            Width           =   2895
         End
      End
      Begin VB.Frame fra 
         Height          =   735
         Index           =   0
         Left            =   135
         TabIndex        =   1
         Top             =   180
         Width           =   3165
         Begin VB.ComboBox cobTax 
            Height          =   300
            ItemData        =   "frmSalaryTaxSet.frx":004E
            Left            =   1155
            List            =   "frmSalaryTaxSet.frx":0050
            TabIndex        =   3
            Top             =   270
            Width           =   1935
         End
         Begin VB.Label lblTax 
            BackStyle       =   0  'Transparent
            Caption         =   "扣税项目(&O)"
            Height          =   225
            Index           =   2
            Left            =   90
            TabIndex        =   2
            Top             =   300
            Width           =   1065
         End
      End
   End
   Begin VB.CommandButton cmdTax 
      Height          =   350
      Index           =   0
      Left            =   3720
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   180
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdTax 
      Height          =   345
      Index           =   1
      Left            =   3720
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   555
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
End
Attribute VB_Name = "frmSalaryTaxSet"
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 mlngTaxFieldID As Long
Private mblnOk As Boolean
Private mstrSql As String
Private Sub cmdTax_Click(Index As Integer)
    Dim strSql As String
    Dim recSalaryList As rdoResultset
    Dim lngSalaryID As Long
    
    lngSalaryID = frmSalaryList.SalaryID
    '根据名称查ID
    'Strsql = "SELECT lngViewFieldID FROM ViewField WHERE TRIM(strViewFieldDesc)='" _
        & Trim(cobTax.Text) & "' AND lngViewID=63"
    strSql = "SELECT lngViewFieldID FROM ViewField WHERE LTRIM(RTRIM(strViewFieldDesc))='" _
        & Trim(cobTax.Text) & "' AND lngViewID=63"
    Set recSalaryList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recSalaryList.EOF Then
        mlngTaxFieldID = recSalaryList!lngViewFieldID
    Else
        mlngTaxFieldID = 0
    End If
    recSalaryList.Close
    Set recSalaryList = Nothing
    '确定
    If Index = 0 Then
        '判断扣税项目的存在
        If mlngTaxFieldID = 0 Then
            ShowMsg Me.hwnd, "请选择扣税项目.", vbInformation, Me.Caption
            cobTax.SetFocus
            Exit Sub
        End If
        mblnOk = True
    Else
        mblnOk = False
    End If
    Me.Hide
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_Load()
    Dim recViewField As rdoResultset
    Dim strSql As String
    Dim lngSalaryViewID
    Dim strName As String
    Dim i As Integer
    Dim lngSalaryID As Long
    Me.Left = (Screen.width - Me.width) / 2
    Me.top = (Screen.Height - Me.Height) / 2
    '初始化扣税项目
    Set recViewField = gclsBase.BaseDB.OpenResultset(mstrSql, rdOpenStatic)
    i = 0
    cobTax.Clear
    If Not recViewField.EOF Then
        recViewField.MoveLast
        recViewField.MoveFirst
    End If
    Do While Not recViewField.EOF
        If recViewField!lngViewFieldID <> 18324 And recViewField!lngViewFieldID <> 18660 Then
            cobTax.AddItem (recViewField!strViewFieldDesc)
        End If
        recViewField.MoveNext
    Loop
    '取出本次扣税设置
    lngSalaryID = frmSalaryList.SalaryID
    strSql = "SELECT ViewField.strViewFieldDesc FROM ViewField WHERE lngViewFieldID=" _
        & mlngTaxFieldID
    Set recViewField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recViewField.EOF Then
        '判断扣税字段是否存在
        If cobTax.ListCount > 0 Then
            For i = 0 To cobTax.ListCount - 1
                If Trim(cobTax.list(i)) = Trim(recViewField!strViewFieldDesc) Then
                    Exit For
                End If
            Next i
            If i < cobTax.ListCount Then
                cobTax.Text = recViewField!strViewFieldDesc
            End If
        End If
    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, vbResIcon)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (139)
    Set frmSalaryTaxSet = Nothing
End Sub
'将扣税项目自动加入扣零、扣税计算公式
Private Sub JoinToFormula()
    Dim lngViewFieID As Long   '本次扣零、本次扣税ViewFieldID
    Dim i, j As Integer
    Dim blnZeroTax As Boolean  '在公式中是否有扣零、扣税计算公式
    Dim strItemName As String  '项目名称
    Dim blnZeroTaxItem As Boolean  '在公式中是否有扣零、扣税项目
    Dim strSql As String
    Dim recRecordset As rdoResultset
    Dim strTaxName As String       '本次扣税名称
    Dim strZeroName As String      '本次扣零名称
    strItemName = Trim(cobTax.Text)
    lngViewFieID = 3521
    With frmSalaryFomularSet.msgSalaryFormula(0)
        '无扣税计算公式则查找扣税项目
        i = 1
        blnZeroTaxItem = False
        Do While i < .Rows
            If Trim(.TextMatrix(i, 0)) = strItemName Then
                blnZeroTaxItem = True
                Exit Do
            End If
            i = i + 1
        Loop
        '查找本次扣税项目名称
        strSql = "SELECT strViewFieldDesc FROM ViewField WHERE UPPER(strFieldName)='SALARY.DBLNOWTAX' AND lngViewID=63"
        Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        strTaxName = Trim(recRecordset!strViewFieldDesc)
        '计算项目中无扣税项目
        If Not blnZeroTaxItem Then
            '最后一条计算公式非空
            If Trim(.TextMatrix(.Rows - 1, 0)) <> "" Then
                .Rows = .Rows + 1
            End If
            .TextMatrix(.Rows - 1, 0) = strTaxName
            .TextMatrix(.Rows - 1, 1) = "扣税计算(" & strItemName & ")"
            .TextMatrix(.Rows - 1, 4) = "CalcTax"
            .TextMatrix(.Rows - 1, 3) = lngViewFieID
            recRecordset.Close
            Set recRecordset = Nothing
            .TextMatrix(.Rows - 1, 6) = 1
            .TextMatrix(.Rows - 1, 2) = ""
            Exit Sub
       Else
            '计算项目中有扣税项目
            If i < .Rows - 1 Then
                If strTaxName = Trim(.TextMatrix(i + 1, 0)) Then
                    i = i + 1
                End If
            End If
            If Trim(.TextMatrix(.Rows - 1, 0)) <> "" Then
                .Rows = .Rows + 1
            End If
            j = .Rows - 1
            '定位到i+1行
            Do While i + 1 < j
                '向后移动
                .TextMatrix(j, 0) = .TextMatrix(j - 1, 0)
                .TextMatrix(j, 1) = .TextMatrix(j - 1, 1)
                .TextMatrix(j, 2) = .TextMatrix(j - 1, 2)
                .TextMatrix(j, 3) = .TextMatrix(j - 1, 3)
                .TextMatrix(j, 4) = .TextMatrix(j - 1, 4)
                .TextMatrix(j, 5) = .TextMatrix(j - 1, 5)
                .TextMatrix(j, 6) = .TextMatrix(j - 1, 6)
                j = j - 1
            Loop
            '写入公式
            .TextMatrix(j, 0) = strTaxName
            .TextMatrix(j, 1) = "扣税计算(" & strItemName & ")"
            .TextMatrix(j, 4) = "CalcTax"
            .TextMatrix(j, 3) = lngViewFieID
            .TextMatrix(j, 6) = 1
            recRecordset.Close
            Set recRecordset = Nothing
        End If
    End With
End Sub
'调用扣税设置
Public Function GetTax(ByRef blnOK As Boolean, ByVal strSql As String, _
    ByRef lngViewFieldID As Long) As Boolean
    mstrSql = strSql
    mblnOk = blnOK
    mlngTaxFieldID = lngViewFieldID
    Me.Show vbModal
    lngViewFieldID = mlngTaxFieldID
    blnOK = mblnOk
    Unload Me
End Function