frmsalaryedit.frm

金算盘软件代码

    Dim i As Long

    intSortCol = 0
    intSortType = 0
    With mclsSalaryGrid.SalaryDbGridCtrl
        For i = 0 To .Cols - 1
            If Right(Trim(.CellValue(0, i)), 1) = "↑" Then
                intSortCol = i
                intSortType = 1
                .CellValue(0, i) = Left(Trim(.CellValue(0, i)), Len(Trim(.CellValue(0, i))) - 1)
                .CellFormula(0, i) = Left(Trim(.CellFormula(0, i)), Len(Trim(.CellFormula(0, i))) - 1)
            ElseIf Right(Trim(.CellValue(0, i)), 1) = "↓" Then
                intSortCol = i
                intSortType = -1
                .CellValue(0, i) = Left(Trim(.CellValue(0, i)), Len(Trim(.CellValue(0, i))) - 1)
                .CellFormula(0, i) = Left(Trim(.CellFormula(0, i)), Len(Trim(.CellFormula(0, i))) - 1)
            End If
        Next
    End With
    Set clsPrint = New PrintClass
    strName = Trim(cboEdit(0).Text)
    clsPrint.PrintNewList1 gclsBase.BaseDB, mclsSalaryGrid.Recordset, mclsSalaryGrid.SalaryDbGridCtrl.TableHandle, 63, "工资数据" & Chr(1) _
        & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    With mclsSalaryGrid.SalaryDbGridCtrl
        If intSortCol > 0 Then
            If intSortType = 1 Then
               .CellValue(0, intSortCol) = .CellValue(0, intSortCol) & "↑"
            ElseIf intSortType = -1 Then
                .CellValue(0, intSortCol) = .CellValue(0, intSortCol) & "↓"
            Else
                .CellValue(0, intSortCol) = .CellValue(0, intSortCol) & "↑"
            End If
        End If
    End With
End Sub


Private Sub mclsSalaryGrid_AfterRowColChange()
    Dim strFlag As String
    Dim intDesc As Integer
    Dim strTmp As String
    
    With mclsSalaryGrid.SalaryDbGridCtrl
        If .Row > 0 Then
            mblnChangeText = True
            If Not IsNull(.CellValue(.Row, mintSortCol)) Then
                If GetItemType(mintSortCol) = 1 Then
                    intDesc = GetInputItemFieldDec(mintSortCol)
                    If intDesc > 0 Then
                        strFlag = "###,###,##0." & String(intDesc, "0")
                    Else
                        strFlag = "###,###,##0"
                    End If
                    If Val(.CellValue(.Row, mintSortCol)) = 0 Then
                        strTmp = ""
                    Else
                        strTmp = IIf(Trim(Format(.CellValue(.Row, mintSortCol), strFlag)) = "", "", Format(.CellValue(.Row, mintSortCol), strFlag))
                    End If
                    txtEdit.Text = strTmp
                Else
                    txtEdit.Text = .CellValue(.Row, mintSortCol)
                End If
            Else
                txtEdit.Text = ""
            End If
            mblnChangeText = False
            If .col < .Cols - 1 Then
                If .col = mlngLockCol Then
                    .EnterDirection = 2
                Else
                    .EnterDirection = 4
                End If
            End If
            CmdFind.Enabled = True
        End If
    End With
End Sub

'数据保存
Private Sub mclsSalaryGrid_BeforeSaveData(strVal As String, lngCancel As Long)
    Dim lngRow As Long
    Dim lngCol As Long
    Dim strOldVal As String
    
    With mclsSalaryGrid.SalaryDbGridCtrl
        If .Row > 0 And .Row < .Rows And .col > 4 And .col < .Cols Then
            If Not mblnIsSave Then Exit Sub
            If IsNull(.CellValue(.Row, .col)) Then
                strOldVal = ""
            Else
                strOldVal = .CellValue(.Row, .col)
            End If
            lngRow = .Row
            lngCol = .col
            Me.MousePointer = vbHourglass
            If Not WriteVaildInputData(strVal, lngRow, lngCol) Then
                strVal = strOldVal
            Else
                mblnDateIsChange = True
                CalcRefreshData lngRow, lngCol
            End If
            Me.MousePointer = vbDefault
        End If
    End With
End Sub

Private Sub mMenu_ChildActive()
    SetHelpID Me.HelpContextID
    mclsSalaryGrid.SalaryDbGridCtrl.Refresh
    With frmMain
        .mnuEditEdit.Enabled = False
        .mnuEditNew.Enabled = False
        .mnuEditDel.Enabled = False
        .mnuEditFilter = True
        .mnuEditSearch = True
        .mnuEditColumn = True
        .mnuFilePrint.Enabled = True
        .mnuFilePrintSetup.Enabled = True
        .mnuToolRefresh.Enabled = True
        .SetToolBar
    End With
End Sub

'栏目设置
Private Sub mMenu_EditColumn()
    Dim blnTmp As Boolean
    Dim lngID As Long
    Dim strSql As String
    mblnItemSet = True
    '保存当前操作员的ListID
    lngID = mlngListID
    '生成本次发放的List记录，并记忆lngListID，操作员ID计为当前操作员ID
    '将操作员ID号为-1的操作员，
    '避免重复生成无穷多条记录,先将当前操作员ID，查找操作员ID为-1的操作员，将该ID置为当前操作员ID
    Call SaveNowListField(True)
    '栏目设置
    mblnIsListSetOK = False
    blnTmp = frmSalaryListSet.ShowSalarylistset
    If Not blnTmp Then
        Exit Sub
    End If
    cboInputItem.Clear
    Call GetListField
    '将本次的LIST的操作员ID计为-1（避免重复生成无穷多条记录，
    '确保操作员对应LIST的唯一性，只有在执行保存栏目后才能保存设置）
    If mstrListName = "所有栏目" Or mstrListName = "" Then
        strSql = "UPDATE List SET lngOperatorID=-1 WHERE lngListID=" & mlngListID
        gclsBase.BaseDB.Execute strSql
    End If
    If Not mblnIsListSetOK Then
        mlngListID = lngID
    End If
    '录入栏目设置
    Call InitInputItem
    If mstrListName <> "" And mstrListName <> "所有栏目" Then
        cboInputItem.ListIndex = GetItemListIndex(mstrListName, mlngListID)
    Else
        If mblnIsListSetOK Then
            Call mnuRefresh
        End If
        mstrListName = ""
    End If
End Sub

Private Sub mMenu_EditFilter()
    Dim lngID As Long
    Dim strSql As String
    Dim blnOK As Boolean
    mblnItemSet = True
    '对应筛选条件的改变(依据工资表ID)
    If mlngSalaryID > 0 Then
        'strSql = "UPDATE  ViewField  Set  ViewField.blnIsFilter = False  WHERE " & _
                 " ViewField.lngViewID= " & mintSalaryViewID & " AND ViewField.strTableName= 'Salary'"
        strSql = "UPDATE  ViewField  Set  ViewField.blnIsFilter = 0  WHERE " & _
                 " ViewField.lngViewID= " & mintSalaryViewID & " AND UPPER(ViewField.strTableName)= 'SALARY'"
        gclsBase.ExecSQL (strSql)
        'strSql = "UPDATE ViewField INNER JOIN SalaryField ON ViewField.lngViewFieldID =  " & _
                 " SalaryField.lngViewFieldID SET ViewField.blnIsFilter = True " & _
                 " WHERE ViewField.lngViewID= " & mintSalaryViewID & " AND ViewField.strTableName='Salary' " & _
                 " AND SalaryField.lngSalaryListID= " & mlngSalaryID
        strSql = "UPDATE ViewField SET ViewField.blnIsFilter = 1 " & _
                 " WHERE ViewField.lngViewID= " & mintSalaryViewID & " AND UPPER(ViewField.strTableName)='SALARY' " & _
                 " AND ViewField.lngViewFieldID IN (SELECT SalaryField.lngViewFieldID FROM SalaryField " & _
                 " WHERE SalaryField.lngSalaryListID= " & mlngSalaryID & ")"
        gclsBase.ExecSQL (strSql)
    End If
    '保存当前操作员的ListID
    lngID = mlngListID
    '生成本次发放的List记录，并记忆lngListID，操作员ID计为当前操作员ID
    '避免重复生成无穷多条记录
    Call SaveNowListField
    mclsSalaryGrid.ListSet.ViewId = mintSalaryViewID
    Filter.ShowFilter mclsSalaryGrid.ListSet.ListID, 1, , , , , blnOK
    mclsSalaryGrid.ListSet.SaveList
    mclsSalaryGrid.ListSet.ViewId = mintSalaryViewID
    mstrWhere = mclsSalaryGrid.ListSet.WhereOfSql
    Call GetListField
    '还原当前操作员的记录
    strSql = "UPDATE List SET lngOperatorID=" & mlngOperatorID & " WHERE lngListID=" & lngID
    gclsBase.BaseDB.Execute strSql
    '将本次的LIST的操作员ID计为-1（避免重复生成无穷多条记录，
    '确保操作员对应LIST的唯一性，只有在执行保存栏目后才能保存设置）
    strSql = "UPDATE List SET lngOperatorID=-1 WHERE lngListID=" & mlngListID
    gclsBase.BaseDB.Execute strSql
    If blnOK Then
        mblnFilter = True
        Call mnuRefresh
    End If
End Sub
Private Sub mMenu_EditSearch()
    frmTreeFind.ShowFind
End Sub

Private Sub mMenu_FilePrint()
    mMenu_ListEditMenu (12)
End Sub

Private Sub mMenu_ListEditMenu(ByVal intIndex As Integer)
    Dim strSalarySql As String
    Dim strSql As String
    Dim recRecordset As rdoResultset
    Dim lngID As Long
    Dim blnTmp As Boolean
    Dim lngLogID As Long
    Dim blnZeroTax As Boolean   '是否存在计算项目可以扣零、扣税。
    Dim strErr As String
    Dim strMsg As String
    Dim recEmployee As rdoResultset
    
    'strSql = "SELECT lngViewFieldID,strViewFieldDesc FROM ViewField WHERE lngViewID=" _
        & mintSalaryViewID & " AND strTableName='Salary'AND strFieldName <> " _
        & "'Salary.dblNowTax' AND strFieldName <> 'Salary.dblNowZero' AND" _
        & " strFieldName <> 'Salary.dblLastZero' AND strFieldType='Double'"
    strSql = "SELECT lngViewFieldID,strViewFieldDesc FROM ViewField WHERE lngViewID=" _
        & mintSalaryViewID & " AND UPPER(strTableName)='SALARY'AND UPPER(strFieldName) <> " _
        & "'SALARY.DBLNOWTAX' AND UPPER(strFieldName) <> 'SALARY.DBLNOWZERO' AND" _
        & " UPPER(strFieldName) <> 'SALARY.DBLLASTZERO' AND UPPER(strFieldType)='DOUBLE'"
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recRecordset.EOF Then
        blnZeroTax = True
    End If
    recRecordset.Close
    Set recRecordset = Nothing
    blnTmp = False
    Select Case intIndex
    Case 0  '发放项目
        blnTmp = frmSalaryItem.ShowSalaryItem
        If blnTmp Then
            mlngListID = 0
            Call SaveItemToListField
            Call GetListField
            '发放项目改变后,录入项目为所有栏目
            cboInputItem.ListIndex = 0
            cboInputItem_Click
        End If
        Exit Sub
    Case 1   '发放范围
        Me.MousePointer = vbHourglass
        blnTmp = frmSalaryEmployee.ShowSalaryEmployee
        Me.MousePointer = vbDefault
        If Not blnTmp Then
            Exit Sub
        End If
    Case 2   '计算公式
        blnTmp = frmSalaryFomularSet.ShowSalaryFomularSet
        If Not blnTmp Then
            Exit Sub
        End If
'        If cboInputItem.Text = "所有栏目" Then
'            Call cboInputItem_Click
'        End If
    Case 4   '批量修改
        blnTmp = frmSalaryListEditSome.ShowSalaryListEditSome()
        If Not blnTmp Then
            Exit Sub
        End If
    Case 5 '重新计算
        If Not mblnIsPostDate Then
            Me.MousePointer = vbHourglass
            Call CalcOldData(mlngSalaryID, True)
            Me.MousePointer = vbDefault
            prgBar.Visible = False
        End If
    Case 6 '锁定列
        If mblnIsLockCol Then
            SetLockGridCol
        End If
        Exit Sub
    Case 8  '筛选
        Call mMenu_EditFilter
        Exit Sub
    Case 9   '栏目设置
        Call mMenu_EditColumn
        Exit Sub
    Case 11 '刷新
        If Not mblnIsPostDate Then
            Me.MousePointer = vbHourglass
            Call CalcOldData(mlngSalaryID, True)
            Me.MousePointer = vbDefault
            prgBar.Visible = False
        End If
    Case 12   '打印
        If Not mblnIsPostDate Then
            Me.MousePointer = vbHourglass
            Call CalcOldData(mlngSalaryID, False)
            mnuRefresh
            Me.MousePointer = vbDefault
        End If
        mMenu_Print
        Exit Sub
    End Select
    If mblnIsPostDate Then
        Exit Sub
    End If
    If intIndex = 0 Or intIndex = 2 Or intIndex = 4 Then
        If mblnEditData Then
            strSql = "SELECT SalaryList.dblDeductLevel, SalaryList.blnIsMonthDuduct,SalaryList.lngDeductPutFieldID," _
                & "SalaryList.lngDeductFieldID, SalaryList.blnIsTax, SalaryList.lngTaxFieldID" _
                & " FROM SalaryList WHERE lngSalaryListID=" & mlngSalaryID
            Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            With recRecordset
                If !dblDeductLevel > 0 Then