frmsalaryfomularset.frm

金算盘软件代码

                    Else
                        mblnFomulaOk = False
                        ShowMsg Me.hWnd, "工资公式有误。", vbInformation, Me.Caption
                    End If
                End If
            End If
        Else
            If Len(Trim(.TextMatrix(.Row, 0))) = 0 Then
                mblnFomulaOk = False
                ShowMsg Me.hWnd, "计算项目不允许为空。", vbInformation, Me.Caption
                .col = 0
            Else
                mblnFomulaOk = False
                ShowMsg Me.hWnd, "计算公式不允许为空。", vbInformation, Me.Caption
                .col = 1
                If .TextMatrix(.Row, 9) <> "1" Then
                    txtSalaryFormula(0).Visible = True
                    txtSalaryFormula(0).SetFocus
                End If
            End If
        End If
    End With
    Exit Sub
Errors:
    blnIsError = True
    Resume Next
End Sub
Private Function Analysis(ByVal strFormula As String) As Boolean
    Set mclsDepoland = New DepolandClass
    Analysis = mclsDepoland.VerifyFomular(strFormula)
End Function
Private Sub cboFormula_Click()
    Dim strSql As String
    Dim recRecordset As rdoResultset
    Dim lngViewFieldID As Long
    With msgSalaryFormula(0)
        cboFormula.Text = Salary.Change_Text("|", "", cboFormula.Text)
        'strSql = "SELECT lngViewFieldID FROM ViewField WHERE TRIM(strViewFieldDesc)='" _
            & Trim(cboFormula.Text) & "' AND lngViewID=63"
        strSql = "SELECT lngViewFieldID FROM ViewField WHERE LTRIM(RTRIM(strViewFieldDesc))='" _
            & Trim(cboFormula.Text) & "' AND lngViewID=63"
        Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recRecordset.EOF Then
            .TextMatrix(.Row, 0) = cboFormula.Text
            lngViewFieldID = recRecordset!lngViewFieldID
            .TextMatrix(.Row, 3) = lngViewFieldID
        End If
        recRecordset.Close
        Set recRecordset = Nothing
    End With
End Sub
Private Sub cboFormula_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 34 Or KeyCode = 124 Then
        SendKeys "{BACKSPACE}"
    ElseIf KeyCode = 13 Or (KeyCode = 39 And cboFormula.SelStart = Len(cboFormula.Text)) Or KeyCode = 9 Then
        With msgSalaryFormula(0)
            .col = 1
            cboFormula.Visible = False
            If Trim(.TextMatrix(.Row, 9)) = "" Then
                txtSalaryFormula(0).Visible = True
                txtSalaryFormula(0).Text = .TextMatrix(.Row, 1)
                txtSalaryFormula(0).SetFocus
            End If
        End With
    End If
End Sub
Private Sub cboFormula_KeyPress(KeyAscii As Integer)
    If KeyAscii = 34 Or KeyAscii = 39 Or KeyAscii = 124 Then
        SendKeys "{BACKSPACE}"
    End If
End Sub

Private Sub chkEdit_Click(index As Integer)
    Dim i As Long
    Dim strFoumulaDesc As String
    Dim blnTmp As Boolean
    If mblnIsInit Then
        Exit Sub
    End If
    With msgSalaryFormula(0)
        blnTmp = False
        If .TextMatrix(.Row, 4) = "CalcZero" Or .TextMatrix(.Row, 4) = "CalcTax" Then
            blnTmp = False    '当前行为扣零扣税公式不进行校验
        Else
            For i = 0 To .Cols - 1      '当前行为空公式不进行校检
                If Trim(.TextMatrix(.Row, i)) <> "" Then
                    blnTmp = True
                    Exit For
                End If
            Next
        End If
    End With
    If blnTmp Then
        '当前行为空公式不进行校检
        Call Write_Grid
        Call Check_Fomula
        '通过校验
        If Not mblnFomulaOk Then
            msgSalaryFormula(0).SetFocus
            mblnIsInit = True
            If chkEdit(index).Value = 1 Then
                chkEdit(index).Value = 0
            Else
                chkEdit(index).Value = 1
            End If
            mblnIsInit = False
            Exit Sub
        Else
            txtSalaryFormula(1).Visible = False
            txtSalaryFormula(0).Visible = False
            cboFormula.Visible = False
        End If
    Else
        txtSalaryFormula(1).Visible = False
        txtSalaryFormula(0).Visible = False
        cboFormula.Visible = False
    End If
    Select Case index
    Case 0   '扣零计算
        '查找原来的扣零公式
        i = FindFormula("CalcZero", 4)
        If chkEdit(index).Value = 1 Then
            If ZeroSet() Then
                '删除原来的扣零公式
                If i > 0 Then
                    Call Delete_Formula(True, i)
                End If
                '查找项目生成公式
                strFoumulaDesc = "扣零计算(" & GetDesc(mlngDeductFieldID) & ")"
                '加入公式
                Call InsertFormula(mstrNowZeroName, strFoumulaDesc, mlngDeductFieldID, "CalcZero")
            End If
        Else
            mlngDeductFieldID = 0
            mdblDeductLevel = 0
            If i > 0 Then
                Call Delete_Formula(True, i)
                Call EraseZero
            End If
        End If
    Case 1    '发放扣零
        i = FindFormula("PutZero", 4)
        If chkEdit(index).Value = 1 Then
            If PutZero() Then
                If i > 0 Then
                    Call Delete_Formula(True, i)
                End If
                '指向发放扣零项目公式后面一行
                '加入公式
                Call InsertFormula(GetDesc(mlngDeductPutFieldID), GetDesc(mlngDeductPutFieldID) _
                    & " + 上次扣零", mlngDeductPutFieldID, "PutZero")
            End If
        Else
            mlngDeductPutFieldID = 0
            If i > 0 Then
                Call Delete_Formula(True, i)
                Call ErasePutZero
            End If
        End If
    Case 2
        i = FindFormula("CalcTax", 4)
        If chkEdit(index).Value = 1 Then
            If TaxSet() Then
                If i > 0 Then
                    Call Delete_Formula(True, i)
                End If
                '查找项目生成公式
                strFoumulaDesc = "扣税计算(" & GetDesc(mlngTaxFieldID) & ")"
                '指向扣税项目公式后面一行
                '加入公式
                Call InsertFormula(mstrNowTaxName, strFoumulaDesc, mlngTaxFieldID, "CalcTax")
            End If
        Else
            mblnIsTax = False
            mlngTaxFieldID = 0
            If i > 0 Then
                Call Delete_Formula(True, i)
                Call EraseTax
            End If
        End If
    End Select
    txtSalaryFormula(0).Visible = False
    txtSalaryFormula(1).Visible = False
    cboFormula.Visible = False
End Sub

Private Sub cmdAddItem_Click(index As Integer)
    Dim i As Long
    Dim recFormula As rdoResultset
    Dim strSql As String
    Dim recField As rdoResultset
    Dim strZ As String
    Dim recZ As rdoResultset
    Dim recX As rdoResultset
    Dim recY As rdoResultset
    Dim intMaxNO As Long
        
    '取消
    If index = 1 Then
        mblnIsOK = False
        Unload Me
        Exit Sub
    End If
    '确认
    '已结帐期间的数据不允许修改
    If frmSalaryEdit.IsPostDate Then
        Unload Me
        Exit Sub
    End If
    mblnIsOK = True
    '计算
    strSql = "SELECT * FROM SalaryFormula WHERE lngsalaryListID=" & mlngSalaryID
    Set recFormula = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer, 64)
    i = 1
    If Not recFormula.EOF Then
        recFormula.MoveFirst
    End If
    With msgSalaryFormula(0)
        If txtSalaryFormula(0).Visible = True Then
            .TextMatrix(.Row, 1) = txtSalaryFormula(0).Text
        End If
        If txtSalaryFormula(1).Visible = True Then
            .TextMatrix(.Row, 2) = txtSalaryFormula(1).Text
        End If
        If cboFormula.Visible = True Then
            .TextMatrix(.Row, 0) = cboFormula.Text
        End If
        '开始校验
        If .Rows = 2 And Trim(.TextMatrix(1, 0)) = "" And Trim(.TextMatrix(1, 1)) = "" And Trim(.TextMatrix(1, 2)) = "" Then
            
            strSql = "DELETE FROM SalaryFormula WHERE lngSalaryListID=" & mlngSalaryID
            gclsBase.BaseDB.Execute strSql
             Call WriteSalaryList
            Unload Me
            Exit Sub
        End If
        If .Rows > 1 Then
            If Len(Trim(.TextMatrix(.Rows - 1, 0)) + Trim(.TextMatrix(.Rows - 1, 1)) + Trim(.TextMatrix(.Rows - 1, 2))) = 0 Then
                .Rows = .Rows - 1
            End If
        End If
        If .Rows > 1 Then
            .Row = 1
            mblnFomulaOk = True
            Do While .Row < .Rows
                If .TextMatrix(.Row, 6) = "" Then
                    Call Check_Fomula
                    If Not mblnFomulaOk Then
                        Exit Do
                    End If
                End If
                If .Row + 1 = .Rows Then
                    Exit Do
                Else
                    .Row = .Row + 1
                End If
            Loop
            If Not mblnFomulaOk Then
                Exit Sub
            End If
        End If
        '写回公式
        On Error GoTo Errors
        gclsBase.BaseWorkSpace.BeginTrans
        Do While i < .Rows
            If recFormula.EOF Then
                recFormula.AddNew
                recFormula!lngSalaryListID = mlngSalaryID
                recFormula!lngSalaryFormulaID = BillPublic.GetNewID("SalaryFormula")
            Else
                recFormula.Edit
            End If
            recFormula!strSalaryFormulaDesc = IIf(IsNull(.TextMatrix(i, 1)), " ", IIf(Trim(.TextMatrix(i, 1)) = "", " ", Trim(.TextMatrix(i, 1))))
            recFormula!strSalaryCondDesc = IIf(IsNull(.TextMatrix(i, 2)), " ", IIf(Trim(.TextMatrix(i, 2)) = "", " ", Trim(.TextMatrix(i, 2))))
            recFormula!lngViewFieldID = IIf(IsNull(.TextMatrix(i, 3)), 0, Val(.TextMatrix(i, 3)))
            recFormula!strSalaryFormula = IIf(IsNull(.TextMatrix(i, 4)), " ", IIf(Trim(.TextMatrix(i, 4)) = "", " ", Trim(.TextMatrix(i, 4))))
            recFormula!strSalaryCond = IIf(IsNull(.TextMatrix(i, 5)), " ", IIf(Trim(.TextMatrix(i, 5)) = "", " ", Trim(.TextMatrix(i, 5))))
            recFormula!strFunctionCond = IIf(IsNull(.TextMatrix(i, 7)), " ", IIf(Trim(.TextMatrix(i, 7)) = "", " ", Trim(.TextMatrix(i, 7))))
            recFormula!lngFunctionSalaryListID = IIf(IsNull(.TextMatrix(i, 8)), 0, Val(.TextMatrix(i, 8)))
            recFormula!strFormulaType = IIf(.TextMatrix(i, 9) = "1", "1", "0")
            recFormula.Update
            If Not recFormula.EOF() Then
                recFormula.MoveNext
            End If
            i = i + 1
        Loop
        strSql = "(0"
        Do While Not recFormula.EOF
            strSql = strSql & "," & recFormula!lngSalaryFormulaID
            recFormula.MoveNext
        Loop
        strSql = "DELETE  FROM SalaryFormula WHERE lngSalaryFormulaID IN" & strSql & ")"
        gclsBase.BaseDB.Execute strSql
        '对工资项目的修改(本次扣零,上次扣零,代扣税额)
        If mlngDeductFieldID > 0 Then   '本次扣零
            strSql = "SELECT SalaryField.lngSalaryListID, SalaryField.lngViewFieldID, " & _
                     " SalaryField.lngSalaryFieldNO FROM SalaryField " & _
                     " WHERE SalaryField.lngSalaryListID= " & mlngSalaryID & _
                     " AND SalaryField.lngViewFieldID = 3520 "
            Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If recX.EOF Then
                strZ = "SELECT Max(SalaryField.lngSalaryFieldNo ) As maxNo " & _
                       " FROM SalaryField Where SalaryField.lngSalaryListID= " & mlngSalaryID
                Set recZ = gclsBase.BaseDB.OpenResultset(strZ, rdOpenStatic)
                If Not recZ.EOF Then
                    intMaxNO = recZ!MaxNo + 1
                Else
                    intMaxNO = 1
                End If
                recZ.Close
                Set recZ = Nothing
                strSql = "INSERT INTO SalaryField ( lngSalaryListID, lngViewFieldID, " & _
                         " lngSalaryFieldNO) Values ( " & mlngSalaryID & " ,3520, " & intMaxNO & ") "
                gclsBase.BaseDB.Execute strSql
            End If
        Else
            strSql = "DELETE FROM SalaryField WHERE SalaryField.lngViewFieldID = 3520 And " & _
                 "SalaryField.lngSalaryListID= " & mlngSalaryID
            gclsBase.BaseDB.Execute strSql