frmsalarylistnewwizard.frm

金算盘软件代码

         Left            =   -74880
         Stretch         =   -1  'True
         Tag             =   "140"
         Top             =   480
         Width           =   1575
      End
      Begin VB.Image imeSalaryWizard 
         BorderStyle     =   1  'Fixed Single
         Height          =   4335
         Index           =   2
         Left            =   -74880
         Stretch         =   -1  'True
         Tag             =   "140"
         Top             =   480
         Width           =   1575
      End
      Begin VB.Image imeSalaryWizard 
         BorderStyle     =   1  'Fixed Single
         Height          =   4335
         Index           =   1
         Left            =   -74880
         Stretch         =   -1  'True
         Tag             =   "140"
         Top             =   480
         Width           =   1575
      End
      Begin VB.Image imeSalaryWizard 
         BorderStyle     =   1  'Fixed Single
         Height          =   4335
         Index           =   0
         Left            =   120
         Stretch         =   -1  'True
         Tag             =   "140"
         Top             =   480
         Width           =   1575
      End
      Begin VB.Label lblWizard 
         Caption         =   $"frmSalaryListNewWizard.frx":0171
         Height          =   3015
         Index           =   9
         Left            =   -68040
         TabIndex        =   23
         Top             =   960
         Width           =   1335
      End
      Begin VB.Label lblWizard 
         Caption         =   $"frmSalaryListNewWizard.frx":01EF
         Height          =   2895
         Index           =   8
         Left            =   -68250
         TabIndex        =   8
         Top             =   960
         Width           =   1815
      End
      Begin VB.Label lblWizard 
         Caption         =   "项目："
         Height          =   255
         Index           =   7
         Left            =   -71745
         TabIndex        =   44
         Top             =   3120
         Width           =   1095
      End
      Begin VB.Label lblWizard 
         Caption         =   "项目值："
         Height          =   225
         Index           =   13
         Left            =   -69015
         TabIndex        =   46
         Top             =   3120
         Width           =   1035
      End
      Begin VB.Label lblWizard 
         Caption         =   "3."
         Height          =   255
         Index           =   5
         Left            =   -68550
         TabIndex        =   78
         Top             =   2760
         Width           =   195
      End
      Begin VB.Label lblWizard 
         Caption         =   "2."
         Height          =   255
         Index           =   4
         Left            =   -68550
         TabIndex        =   77
         Top             =   1860
         Width           =   195
      End
      Begin VB.Label lblWizard 
         Caption         =   "1."
         Height          =   255
         Index           =   3
         Left            =   -68550
         TabIndex        =   76
         Top             =   960
         Width           =   195
      End
      Begin VB.Label lblWizard 
         Caption         =   "可选择的工资项目"
         Height          =   225
         Index           =   15
         Left            =   -73170
         TabIndex        =   9
         Top             =   420
         Width           =   1485
      End
      Begin VB.Label lblWizard 
         Caption         =   "本次发放的工资项目"
         Height          =   195
         Index           =   16
         Left            =   -69420
         TabIndex        =   11
         Top             =   420
         Width           =   1875
      End
      Begin VB.Label lblWizard 
         Caption         =   "工资表建立日期(&G)"
         Height          =   225
         Index           =   2
         Left            =   2910
         TabIndex        =   3
         Top             =   1650
         Width           =   1755
      End
      Begin VB.Label lblWizard 
         Caption         =   "工资表名称(&P)"
         Height          =   255
         Index           =   14
         Left            =   2880
         TabIndex        =   1
         Top             =   930
         Width           =   1275
      End
   End
   Begin VB.Frame Frame1 
      Height          =   30
      Left            =   45
      TabIndex        =   75
      Top             =   5070
      Width           =   8775
   End
   Begin VB.CommandButton cmdWizard 
      Height          =   345
      Index           =   3
      Left            =   7620
      Style           =   1  'Graphical
      TabIndex        =   74
      Tag             =   "1016"
      Top             =   5160
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdWizard 
      Height          =   345
      Index           =   2
      Left            =   6300
      Style           =   1  'Graphical
      TabIndex        =   73
      Tag             =   "1006"
      Top             =   5160
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdWizard 
      Enabled         =   0   'False
      Height          =   345
      Index           =   1
      Left            =   4980
      Style           =   1  'Graphical
      TabIndex        =   72
      Tag             =   "1005"
      Top             =   5160
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdWizard 
      Cancel          =   -1  'True
      Height          =   345
      Index           =   0
      Left            =   3690
      Style           =   1  'Graphical
      TabIndex        =   71
      Tag             =   "1002"
      Top             =   5160
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
End
Attribute VB_Name = "frmSalaryListNewWizard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'工资表生成向导
'
'功能：生成工资表数据，再对工资表数据进行计算、扣税处理、扣零处理
'
'输入接口
'
'读取工资列表中的 SalaryList    '工资列表Recordset
'读取工资列表中的 SalaryID      '工资表ID
'读取工资列表中的 Employee      '雇员表Recordset
'读取工资列表中的 EditItem      '调用项目卡片，0 修改，1 新增
'读取工资列表中的 SalaryViewID  '工资表视图ID
'读取工资列表中的 IsAddSalary   '新增工资表否
'
'作者: 唐吉禹
'1998-6-20
'
'msgWizard(0):数据来源，第4列隐藏lngSalaryListID
'msgWizard(1):工资项目，第4列隐藏lngViewFieldID
'msgWizard(2):本次项目，第4列隐藏lngViewFieldID
'msgWizard(3):清零项目，第5列隐藏lngViewFieldID
'msgWizard4  :发放范围，第0列隐藏lngEmployeeID
'msgWizard(4):计算公式，第3列隐藏计算项目的lngViewFieldID，
'                       第4列隐藏英文公式
'                       第5列隐藏英文条件
'                       第6列隐藏校验是否通过
'                       第7列隐藏计算函数条件
'                       第8列隐藏统计函数的表
'                       第9列隐藏特殊公式标志，该行公式不允许录入。
'msgWizard(5):选择项目，第1列隐藏项目的lngViewFieldID，
'                       第2列隐藏项目类型
'                       第3列隐藏项目数据表名
'                       第4列隐藏项目字段名
'说明：CalcZero表示扣零计算,CalcTax表示扣税计算
Option Explicit
Private mlngSalaryID As Long
Private mintEditItem As Integer '调用项目卡片，0 修改，1 新增
Private mintSalaryViewID As Integer '工资表视图ID
Private mblnIsAddSalary As Boolean  '新增工资表否
Private mblnIsEditFrom As Boolean  '修改数据来源否
Private WithEvents mclsDepoland As DepolandClass
Attribute mclsDepoland.VB_VarHelpID = -1
Private mblnFomulaOk As Boolean   '公式校验正确否
Private mblnCond As Boolean       '校验的是条件否
Private WithEvents mControl As MainControl
Attribute mControl.VB_VarHelpID = -1
Dim mstrSalarySQL As String      '工资数据SQL
Private mclsGrid As New Grid
Private mblnInitmsgWizard4 As Boolean   '初始化范围列表标志
Private mlngMyID As Long               '修改工资表ID
Private mblnChangList As Boolean       '改变公式顺序
Private mstrFomularItemname As String   '工资公式项目名称
Private mblnFixedItem As Boolean           '是否要重新设置清零
Private mlngDeductFieldID As Long          '扣零项目ID
Private mlngTaxFieldID As Long             '扣税项目ID
Private mlngDeductPutFieldID As Long       '扣零发放项目
Private mblnIsTax As Boolean               '本次扣税否
Private mdblDeductLevel As Double          '扣零级别
Private mblnIsInit As Boolean              '是否初始进入
Private mlngFromID As Long                 '工资表来源ID
Private mstrSalaryItemSQL As String      '工资发放项目条件
Private mblnIsInputRight As Boolean     '是否有工资录入权限
Private mblnIsClickAge As Boolean       '是否触发工龄计算方法Click事件
Private mblInitSalaryAge As Boolean     '初始化工龄计算公式标志
Private mstrAgeFormula As String        '工龄计算公式
Private mstrAgeMethod As String         '工龄计算方法
Private mstrAgeWhere As String          '工龄计算条件
Private mblnAddItem As Boolean
Private mblnfrmIsfirstLoad  As Boolean

Private Sub EditWizard()  '修改向导
    Dim strSql As String
    Dim blnOKWizard As Boolean
    Dim recSalaryList As rdoResultset
    Dim dblZero As Double
    Dim i As Integer
    Dim strSalarySql As String
    Dim blnIsMonthDuduct As Boolean
    Dim blnIsrefesh As Boolean
    Dim lngFromID As Long
    
    If mblnIsEditFrom Then  '重新生成
        On Error GoTo Errors
        gclsBase.BaseWorkSpace.BeginTrans
        '删除工资目录表
        strSql = "DELETE FROM SalaryList WHERE lngSalaryListID=" & mlngMyID
        gclsBase.BaseDB.Execute strSql
        '删除工资项目表
        strSql = "DELETE FROM SalaryField WHERE lngSalaryListID=" & mlngMyID
        gclsBase.BaseDB.Execute strSql
        '删除工资公式表
        strSql = "DELETE FROM SalaryFormula WHERE lngSalaryListID=" & mlngMyID
        gclsBase.BaseDB.Execute strSql
        '删除工资数据表
        strSql = "DELETE FROM Salary WHERE lngSalaryListID=" & mlngMyID
        gclsBase.BaseDB.Execute strSql
        gclsBase.BaseWorkSpace.CommitTrans
    Else
        '更新工资目录表
        mlngSalaryID = frmSalaryList.SalaryID
        strSql = "SELECT * FROM SalaryList WHERE lngSalaryListID=" & mlngSalaryID
        Set recSalaryList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer, 64)
        recSalaryList.Edit
        If recSalaryList!strSalaryListName <> Trim(txtWizard(0).Text) Then
            recSalaryList!strSalaryListName = Trim(txtWizard(0).Text)
        End If
        '查找数据来源
        lngFromID = 0
        With msgWizard(0)
            i = 1
            Do While i < .Rows
                If .TextMatrix(i, 0) = "√" Then
                    lngFromID = .TextMatrix(i, 4)
                    Exit Do
                End If
                i = i + 1
            Loop
        End With
        recSalaryList!lngSourceListID = lngFromID
        recSalaryList!strDate = Format(Calendar1.Text, "yyyy-mm-dd")
        recSalaryList!dblDeductLevel = mdblDeductLevel
        recSalaryList!lngDeductFieldID = mlngDeductFieldID
        'recSalaryList!blnIsTax = mblnIsTax
        recSalaryList!blnIsTax = IIf(mblnIsTax = True, 1, 0)
        recSalaryList!lngTaxFieldID = mlngTaxFieldID
        recSalaryList!lngDeductPutFieldID = mlngDeductPutFieldID
        recSalaryList!strSalaryAgeFormula = IIf(Trim(mstrAgeFormula) = "", " ", Trim(mstrAgeFormula))
        recSalaryList!strSalaryAgeMethod = mstrAgeMethod
        recSalaryList.Update
        recSalaryList.Close
        Set recSalaryList = Nothing
        '更新发放项目表
        Call Salary.EditSalaryItem(frmSalaryListNewWizard.msgWizard(1), frmSalaryListNewWizard.msgWizard(2))
        '更新工资公式
        If msgWizard(4).Rows > 1 Then
            Call Salary.EditSalaryFormula(frmSalaryListNewWizard.msgWizard(4), mlngSalaryID)
        End If