frmsalaryzero.frm

金算盘软件代码

            'Strsql = "SELECT lngViewFieldID FROM ViewField WHERE TRIM(strViewFieldDesc)='" _
                & Trim(cboItem.Text) & "' AND lngViewID=63"
            'Set recRecordset = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
            Strsql = "SELECT lngViewFieldID FROM ViewField WHERE RTRIM(LTRIM(strViewFieldDesc))='" _
                & Trim(cboItem.Text) & "' AND lngViewID=63"
            Set recRecordset = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
            If Not recRecordset.EOF Then
                lngViewFieldID = recRecordset!lngViewFieldID
            Else
                lngViewFieldID = 0
            End If
            '判断扣零项目是否存在
            If lngViewFieldID = 0 Then
                ShowMsg Me.hwnd, "请选择扣零项目", vbInformation, Me.Caption
                cboItem.SetFocus
                Exit Sub
            End If
            '上次扣零ID
            lngLastZeroID = recSalaryList!lngDeductFieldID
            
            '写回工资目录表
            Select Case Trim(cobZero.Text)
            Case "扣零至元"
                sngZero = 1
            Case "扣零至五元"
                sngZero = 5
            Case "扣零至十元"
                sngZero = 10
            Case "扣零至五十元"
                sngZero = 50
            Case "扣零至一百元"
                sngZero = 100
            Case "扣零至角"
                sngZero = 0.1
            Case "扣零至五角"
                sngZero = 0.5
            End Select
            recSalaryList.Edit
            recSalaryList!dblDeductLevel = sngZero
            recSalaryList!lngDeductFieldID = lngViewFieldID
            recSalaryList.Update
            'frmSalaryEdit.Zero = True
            frmSalaryEdit.Zero = 1
            frmSalaryEdit.ZeroID = lngViewFieldID
            frmSalaryEdit.DeductLevel = sngZero
            recSalaryList.Close
            Set recSalaryList = Nothing
            Strsql = "SELECT * FROM SalaryField WHERE lngViewFieldID=3520 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 (3520,100,True," & lngSalaryID & ") "
                Strsql = "INSERT INTO SalaryField (lngViewFieldID,lngSalaryFieldNO,blnIsClear,lngSalaryListID) VALUES (3520,100,1," & lngSalaryID & ") "
                gclsBase.BaseDB.Execute Strsql
            End If
            '写SalaryFormula
            Strsql = "SELECT SalaryFormula.* FROM  SalaryFormula Where SalaryFormula.lngSalaryListID=" & lngSalaryID & _
                     " and SalaryFormula.lngViewFieldID= 3520 "
            '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(cboItem.Text) & ")"
                    .Update
                Else
                    .AddNew
                    !lngViewFieldID = 3520
                    !strSalaryFormula = "CalcZero"
                    !strSalaryFormulaDesc = "扣零计算(" & Trim(cboItem.Text) & ")"
                    !lngSalaryListID = lngSalaryID
                    .Update
                End If
            End With
            recSalaryFormula.Close
            Set recSalaryFormula = Nothing
        Else
            '取消扣零项目
            'Strsql = "DELETE SalaryField.* FROM SalaryField WHERE lngViewFieldID=3520 AND lngSalaryListID=" _
                & lngSalaryID
            Strsql = "DELETE FROM SalaryField WHERE lngViewFieldID=3520 AND lngSalaryListID=" _
                & lngSalaryID
            gclsBase.BaseDB.Execute Strsql
            recSalaryList.Edit
            recSalaryList!dblDeductLevel = 0
            recSalaryList!lngDeductFieldID = 0
            recSalaryList.Update
            'frmSalaryEdit.Zero = False
            frmSalaryEdit.Zero = 0
            frmSalaryEdit.ZeroID = 0
            frmSalaryEdit.DeductLevel = 0
            Strsql = "UPDATE Salary SET dblNowZero=0 WHERE lngSalaryListID=" & lngSalaryID
            gclsBase.BaseDB.Execute Strsql
            'Strsql = "Delete SalaryFormula.* FROM  SalaryFormula Where SalaryFormula.lngSalaryListID=" & lngSalaryID & _
                         " and SalaryFormula.lngViewFieldID= 3520 "
            Strsql = "Delete FROM  SalaryFormula Where SalaryFormula.lngSalaryListID=" & lngSalaryID & _
                         " and SalaryFormula.lngViewFieldID= 3520 "
            gclsBase.BaseDB.Execute Strsql
        End If
        Unload Me
        '计算工资表
        frmSalaryEdit.Calc = True
    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 strName As String
    Dim i As Integer
    'Dim recSalaryList as rdoresultset
    Dim recSalaryList As rdoResultset
    Dim lngSalaryID
    '初始化扣零项目列表
    mlngSalaryViewID = frmSalaryList.SalaryViewID
    'Strsql = "SELECT lngViewFieldID,strViewFieldDesc FROM ViewField WHERE lngViewID=" _
        & mlngSalaryViewID & " AND strTableName='Salary'AND strFieldName <> " _
        & "'Salary.dblNowTax' AND strFieldName <> 'Salary.dblNowZero' AND" _
        & " strFieldName <> 'Salary.dblLastZero' AND strFieldType='Double'"
    'Set recViewField = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
    
    
    Strsql = "SELECT lngViewFieldID,strViewFieldDesc FROM ViewField WHERE lngViewID=" _
        & mlngSalaryViewID & " AND strTableName='Salary'AND strFieldName <> " _
        & "'Salary.dblNowTax' AND strFieldName <> 'Salary.dblNowZero' AND" _
        & " strFieldName <> 'Salary.dblLastZero' AND strFieldType='NUMBER'"
    Set recViewField = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
    If Not recViewField.EOF() Then
        recViewField.MoveLast
        recViewField.MoveFirst
    Else
        Unload Me
        Exit Sub
    End If
    i = 0
    cboItem.Clear
    If Not recViewField.EOF Then
        recViewField.MoveLast
        recViewField.MoveFirst
    End If
    Do While Not recViewField.EOF
        cboItem.AddItem (recViewField!strViewFieldDesc)
        recViewField.MoveNext
    Loop
    recViewField.Close
    Set recViewField = Nothing
    lngSalaryID = frmSalaryList.SalaryID
    '初始化扣零项目，级别
    'Strsql = "SELECT ViewField.strViewFieldDesc,SalaryList.dblDeductLevel," _
        & "SalaryList.blnIsMonthDuduct,SalaryList.lngDeductFieldID FROM SalaryList" _
            & " LEFT JOIN ViewField ON ViewField.lngViewFieldID=SalaryList.lngDeductFieldID " _
        & " WHERE SalaryList.lngSalaryListID=" & lngSalaryID
    'Set recSalaryList = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
    
    
    Strsql = "SELECT ViewField.strViewFieldDesc,SalaryList.dblDeductLevel," _
        & "SalaryList.blnIsMonthDuduct,SalaryList.lngDeductFieldID FROM SalaryList" _
            & ",ViewField WHERE ViewField.lngViewFieldID=SalaryList.lngDeductFieldID(+) " _
        & " AND SalaryList.lngSalaryListID=" & lngSalaryID
    Set recSalaryList = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
    
    If Not recSalaryList.EOF Then
        Select Case recSalaryList!dblDeductLevel
        Case 1
            cobZero.Text = "扣零至元"
        Case 5
            cobZero.Text = "扣零至五元"
        Case 10
            cobZero.Text = "扣零至十元"
        Case 50
            cobZero.Text = "扣零至五十元"
        Case 100
            cobZero.Text = "扣零至一百元"
        Case 0.1
            cobZero.Text = "扣零至一角"
        Case 0.5
            cobZero.Text = "扣零至五角"
        End Select
        If recSalaryList!dblDeductLevel > 0 Then
            chkZero(0).Value = 1
        Else
            chkZero(0).Value = 0
        End If
        If Not IsNull(recSalaryList!strViewFieldDesc) Then
            cboItem.Text = recSalaryList!strViewFieldDesc
        End If
        If recSalaryList!blnIsMonthDuduct = True Then
            chkZero(1).Value = 1
        Else
            chkZero(1).Value = 0
        End If
    End If
    recSalaryList.Close
    Set recSalaryList = Nothing
    Set cmdAddItem(0).Picture = Utility.GetFormResPicture(1001, 0)
    Set cmdAddItem(1).Picture = Utility.GetFormResPicture(1002, 0)
    Set Me.Icon = Utility.GetFormResPicture(139, vbResCursor)
    SetHelpID Me.hwnd, 32008
End Sub
Private Sub Form_Paint()
    FrameBox Me.hwnd, 240, 300, 3160, 1900
    FrameBox Me.hwnd, 240, 2300, 3160, 3380
    FrameBox Me.hwnd, 80, 100, 5700, 3540
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (139)
    Set frmSalaryZero = Nothing
End Sub