frmsalaryzero.frm

金算盘软件代码

VERSION 5.00
Begin VB.Form frmSalaryZero 
   Caption         =   "扣零设置"
   ClientHeight    =   3675
   ClientLeft      =   630
   ClientTop       =   825
   ClientWidth     =   7080
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3675
   ScaleWidth      =   7080
   Begin VB.ComboBox cboItem 
      Height          =   300
      Left            =   1380
      TabIndex        =   5
      Top             =   1410
      Width           =   1695
   End
   Begin VB.CheckBox chkZero 
      Caption         =   "发放扣零"
      Height          =   435
      Index           =   1
      Left            =   480
      TabIndex        =   6
      Top             =   2640
      Value           =   1  'Checked
      Width           =   1095
   End
   Begin VB.CommandButton cmdAddItem 
      Height          =   350
      Index           =   1
      Left            =   5805
      Style           =   1  'Graphical
      TabIndex        =   8
      Top             =   540
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdAddItem 
      Height          =   350
      Index           =   0
      Left            =   5805
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   140
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox chkZero 
      Caption         =   "扣零处理"
      Height          =   435
      Index           =   0
      Left            =   360
      TabIndex        =   0
      Top             =   480
      Value           =   1  'Checked
      Width           =   1095
   End
   Begin VB.ComboBox cobZero 
      Height          =   300
      ItemData        =   "frmSalaryZero.frx":0000
      Left            =   1380
      List            =   "frmSalaryZero.frx":0019
      TabIndex        =   2
      Top             =   960
      Width           =   1695
   End
   Begin VB.Label lblZero 
      Caption         =   "扣零发放方法"
      Height          =   255
      Index           =   1
      Left            =   480
      TabIndex        =   10
      Top             =   2205
      Width           =   1095
   End
   Begin VB.Label lblZero 
      Caption         =   "扣零"
      Height          =   255
      Index           =   0
      Left            =   480
      TabIndex        =   9
      Top             =   240
      Width           =   375
   End
   Begin VB.Label lblZero 
      BackStyle       =   0  'Transparent
      Caption         =   $"frmSalaryZero.frx":0071
      Height          =   3135
      Index           =   2
      Left            =   3480
      TabIndex        =   3
      Top             =   360
      Width           =   2175
   End
   Begin VB.Label lblZero 
      BackStyle       =   0  'Transparent
      Caption         =   "扣零项目(&O)"
      Height          =   225
      Index           =   4
      Left            =   360
      TabIndex        =   4
      Top             =   1440
      Width           =   1125
   End
   Begin VB.Label lblZero 
      BackStyle       =   0  'Transparent
      Caption         =   "扣零标准(&N)"
      Height          =   255
      Index           =   3
      Left            =   360
      TabIndex        =   1
      Top             =   990
      Width           =   1035
   End
End
Attribute VB_Name = "frmSalaryZero"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'扣零设置
'
'作者：唐吉禹
'
'1998-7-15
'
'功能：设置本次扣零项目及标准
'
'输出接口：通过Zero、ZeroID和DeductLevel属性对frmSalaryEdit的mblnZero（扣零否）
'         ,mlngZeroID（扣零ID）,mdblDeductLevel（扣零级别）赋值
'
Option Explicit
Private mlngSalaryViewID As Long
Private Sub chkZero_Click(Index As Integer)
    If chkZero(0).Value = 0 Then
        cobZero.Enabled = False
        cobZero.Text = ""
        cboItem.Enabled = False
        cboItem.Text = ""
    Else
        cobZero.Enabled = True
        cboItem.Enabled = True
    End If
End Sub
Private Sub cmdAddItem_Click(Index As Integer)
    'Dim recSalaryList as rdoresultset
    'Dim recRecordset as rdoresultset
    'Dim recSalaryFormula as rdoresultset
    
    Dim recSalaryList As rdoResultset
    Dim recRecordset As rdoResultset
    Dim recSalaryFormula As rdoResultset
    
    Dim lngSalaryID As Long
    Dim Strsql As String
    Dim lngZeroID As Integer
    Dim lngLastZeroID As Long
    Dim sngZero As Single
    Dim lngViewFieldID As Long
    Select Case Index
    '确认
    Case 0
        '已结帐期间的数据不允许修改
        If frmSalaryEdit.IsPostDate Then
            Unload Me
            Exit Sub
        End If
        '校验
        lngSalaryID = frmSalaryList.SalaryID
        Strsql = "SELECT * FROM SalaryList WHERE lngSalaryListID=" & lngSalaryID
        'Set recSalaryList = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenDynaset)
        Set recSalaryList = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenDynamic, rdConcurRowVer, rdExecDirect)
        recSalaryList.MoveFirst
        '发放扣零
        If chkZero(1).Value = 1 Then
            recSalaryList.Edit
            'recSalaryList!blnIsMonthDuduct = True
            recSalaryList!blnIsMonthDuduct = 1
            recSalaryList.Update
            '增加上次扣零到发放列表中
            Strsql = "SELECT * FROM SalaryField WHERE lngViewFieldID=7699 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 (7699,102,True," & lngSalaryID & ") "
                Strsql = "INSERT INTO SalaryField (lngViewFieldID,lngSalaryFieldNO,blnIsClear,lngSalaryListID) VALUES (7699,102,1," & lngSalaryID & ") "
                gclsBase.BaseDB.Execute Strsql
            End If
        Else
            '取消上次扣零
            recSalaryList.Edit
            'recSalaryList!blnIsMonthDuduct = False
            recSalaryList!blnIsMonthDuduct = 0
            recSalaryList.Update
            'Strsql = "DELETE SalaryField.* FROM SalaryField WHERE lngViewFieldID=7699 AND lngSalaryListID=" _
                & lngSalaryID
            Strsql = "DELETE FROM SalaryField WHERE lngViewFieldID=7699 AND lngSalaryListID=" _
                & lngSalaryID
            gclsBase.BaseDB.Execute Strsql
        End If
        '扣零处理
        If chkZero(0).Value = 1 Then
            '判断扣零级别
            If Trim(cobZero.Text) <> "扣零至元" And Trim(cobZero.Text) <> "扣零至五元" _
                And Trim(cobZero.Text) <> "扣零至十元" And Trim(cobZero.Text) <> "扣零至五十元" _
                And Trim(cobZero.Text) <> "扣零至一百元" And Trim(cobZero.Text) <> "扣零至角" _
                And Trim(cobZero.Text) <> "扣零至五角" Then
                ShowMsg Me.hwnd, "请选择扣零标准", vbInformation, Me.Caption
                cobZero.SetFocus
                Exit Sub
            End If