frmsalaryedit.frm

金算盘软件代码

                    mblnIsZero = True
                Else
                    mblnIsZero = False
                End If
                mblnIsTax = IIf(!blnIsTax = 1, True, False)
                mlngZeroID = !lngDeductFieldID
                mlngTaxID = !lngTaxFieldID
                mdblDeductLevel = !dblDeductLevel
                mlngDeductPutFieldID = !lngDeductPutFieldID
            End With
            recRecordset.Close
            Set recRecordset = Nothing
            '计算
            strSql = " lngSalaryListID=" & mlngSalaryID
            mblnEditData = True
            Call CalcOldData(mlngSalaryID, False)
           ' Call Salary.SalaryCalc(strSql, mlngSalaryID, mlngEditViewFieldID, mblnIsZero, _
                mblnIsTax, mlngZeroID, mlngTaxID, mdblDeductLevel, mlngDeductPutFieldID) '计算
        End If
    End If
    Call mnuRefresh
End Sub

'刷新
Private Sub mnuRefresh()
    Call JionGrid
End Sub
Private Sub mMenu_ListReportMenu(ByVal intIndex As Integer)
    Dim rec As rdoResultset
    
    Select Case intIndex
    Case 0
        Call Report.ShowStandardReport(1367, 593)
    Case 1
        Salary.ShowSalaryBill 1450, 63, mlngSalaryID
    Case 2
       Call Report.ShowSumReport(1368, 595)
    '工资配款表
    Case 3
        Call Report.ShowQuotaWizard(1552, 683)
    Case 4
        Set rec = gclsBase.BaseDB.OpenResultset("SELECT Bank.lngBankID FROM Bank", rdOpenStatic)
        If Not rec.EOF Then
            Me.MousePointer = vbHourglass
            With frmGrantByBank
                .SalaryListID = mlngSalaryID
                .ShowGrantByBank
            End With
            Me.MousePointer = vbDefault
        Else
            ShowMsg hwnd, "没有代发银行信息，不能生成代发文件。", vbInformation, Me.Caption
        End If
    Case 5
        Call Report.ShowStandardReport(1371, 597)
    End Select
End Sub

Private Sub mMenu_ToolRefresh()
    mMenu_ListEditMenu (11)
End Sub

Private Sub picSalary_DblClick()
    Dim lngX As Long
    Dim intY As Integer
    Dim strTmp As String
    Dim i As Integer

    With mclsSalaryGrid.SalaryDbGridCtrl
        .MouseCell lngX, intY
        If lngX = 0 And intY < .Cols Then
            If intY < 1 Then Exit Sub
            If Me.MousePointer = vbHourglass Then Exit Sub
            Me.MousePointer = vbHourglass
            For i = 0 To .Cols - 1
                .ColControl(i) = 0
            Next
            mblnIsSave = False
            strTmp = Trim(.CellValue(0, intY))
            If Right(strTmp, 1) = "↑" Or Right(strTmp, 1) = "↓" Then
                strTmp = Left(strTmp, Len(strTmp) - 1)
            End If
            cboEdit(1).Text = strTmp
            mblnIsSave = True
            Me.MousePointer = vbDefault
        End If
    End With
End Sub

Private Sub picSalary_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim x As Long
    Dim y As Long
    If KeyCode = 93 Then
        Call CreateMenu
        Call RefreshMenu
        With picSalary
            x = .Left + .width \ 2
            y = .top + .Height \ 3
        End With
        PopupMenu frmMain.mnuListEdit, , x, y
    End If
End Sub

Private Sub picSalary_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then
        Call CreateMenu
        Call RefreshMenu
        x = x + picSalary.Left
        y = y + picSalary.top
        PopupMenu frmMain.mnuListEdit, , x, y
    End If
End Sub

Private Sub txtEdit_Change()
    Dim strText As String
    Dim lngStart As Long
    Dim i As Long
    Dim lngRow As Long
    
    If mblnChangeText = True Then
        Exit Sub
    End If
    With mclsSalaryGrid.SalaryDbGridCtrl
        If .Row = 0 Then Exit Sub
        mblnChangeText = True
        strText = Trim(txtEdit.Text)
        If mblnKeyPress Then
            mblnKeyPress = False
            i = 1
        Else
            i = .Row
        End If
        lngRow = FindGridText(strText, i)
        If lngRow > 0 And lngRow < .Rows Then
            .Row = lngRow
            If mintSortCol > 4 Then
                .col = mintSortCol
            Else
                .col = 5
            End If
            CmdFind.Enabled = True
        Else
            CmdFind.Enabled = False
        End If
        .Refresh
        lngStart = Len(strText)
        txtEdit.SelStart = Len(strText)
        mstrFindText = strText
        If lngStart <= Len(txtEdit.Text) Then
            txtEdit.SelLength = Len(txtEdit.Text) - lngStart
        End If
        mblnChangeText = False
    End With
End Sub
Private Sub txtEdit_KeyPress(KeyAscii As Integer)
    mblnKeyPress = True
    mblnChangeText = False
End Sub
Private Sub CreateMenu()   '创建菜单
    Dim intCnt As Integer
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        .mnuListEditMenu(0).Caption = "发放项目(&I)"
        Load .mnuListEditMenu(1)
        .mnuListEditMenu(1).Caption = "发放范围(&W)"
        Load .mnuListEditMenu(2)
        .mnuListEditMenu(2).Caption = "计算公式(&C)"
        Load .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3)
        Load .mnuListEditMenu(4)
        .mnuListEditMenu(4).Caption = "批量修改(&E)"
        Load .mnuListEditMenu(5)
        .mnuListEditMenu(5).Caption = "重新计算(&J)"
        Load .mnuListEditMenu(6)
        .mnuListEditMenu(6).Caption = "锁定(&L)"
        Load .mnuListEditMenu(7)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(7)
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(8)
        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(9)
        Load .mnuListEditMenu(10)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(10)
        Load .mnuListEditMenu(11)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(11)
        Load .mnuListEditMenu(12)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(12)
        For intCnt = .mnuListEditMenu.Count - 1 To 0 Step -1
            .mnuListEditMenu(intCnt).Enabled = True
        Next
        For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
            Unload .mnuListReportMenu(intCnt)
        Next
        .mnuListReportMenu(0).Caption = "工资发放表(&G)"
        Load .mnuListReportMenu(1)
        .mnuListReportMenu(1).Caption = "工资条(&I)"
        Load .mnuListReportMenu(2)
        .mnuListReportMenu(2).Caption = "工资汇总表(&H)"
        Load .mnuListReportMenu(3)
        .mnuListReportMenu(3).Caption = "配款表向导(&W)"
        Load .mnuListReportMenu(4)
        .mnuListReportMenu(4).Caption = "银行代发文件(&B)"
        Load .mnuListReportMenu(5)
        .mnuListReportMenu(5).Caption = "个人所得税扣缴申报表(&T)"
        For intCnt = .mnuListReportMenu.Count - 1 To 0 Step -1
            .mnuListReportMenu(intCnt).Enabled = True
        Next
        .SetToolBar
    End With
End Sub
'得到当前工资表是否已经结帐
Private Sub GetSalaryIsPost(ByVal lngSalaryListID As Long)
    Dim strSql As String
    Dim recSalaryList As rdoResultset
    
    strSql = "SELECT lngSalaryListID,strDate,dblDeductLevel,blnIsMonthDuduct,lngDeductFieldID," _
             & "blnIsTax,lngTaxFieldID,strDate, lngDeductFieldID FROM SalaryList WHERE lngSalaryListID=" _
             & lngSalaryListID
    Set recSalaryList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recSalaryList
        If Not .EOF Then
            mblnIsPostDate = gclsBase.PeriodClosed(recSalaryList!strDate)
        End If
    End With
    recSalaryList.Close
    Set recSalaryList = Nothing
End Sub
Public Sub InitCalc(lngSalaryListID As Long)    '初始化计算
    Dim strSql As String
    Dim recSalaryList As rdoResultset
    Dim strNowDate As String
    
    strSql = "SELECT lngSalaryListID,strDate,dblDeductLevel,blnIsMonthDuduct,lngDeductFieldID," _
    & "blnIsTax,lngTaxFieldID,strDate, lngDeductFieldID FROM SalaryList WHERE lngSalaryListID=" _
    & lngSalaryListID
    Set recSalaryList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recSalaryList.EOF Then
        mblnIsZero = False
        mblnIsTax = IIf(recSalaryList!blnIsTax = 1, True, False)
        mlngTaxID = recSalaryList!lngTaxFieldID
        mlngZeroID = recSalaryList!lngDeductFieldID
        mdblDeductLevel = recSalaryList!dblDeductLevel
        If recSalaryList!dblDeductLevel > 0 Then
            mblnIsZero = True
            If recSalaryList!blnIsMonthDuduct = True Then  '按月发放标志
                mlngDeductPutFieldID = recSalaryList!lngDeductFieldID
            End If
        End If
    End If
    recSalaryList.Close
    Set recSalaryList = Nothing
End Sub
Public Sub ResponseMessage()
    
End Sub
'取当前操作员的录入项目,0表示非当前操作员的记录
Private Sub GetListField()
     Dim strSql As String
    Dim recRecordset As rdoResultset
    '取当前操作员的List项目
    'strSql = "SELECT List.strListName,ListField.blnIsChoosed,ViewField.strViewFieldDesc," _
        & " ViewField.strTableName,ViewField.strFieldName,ListField.lngListID,ViewField.strFieldType," _
        & " ViewField.bytFieldDec,ViewField.strFieldName,ViewField.lngViewFieldID FROM ((((List INNER JOIN ListField ON List.lngListID" _
        & "  = ListField.lngListID) INNER JOIN ViewField ON ListField.lngViewFieldID = " _
        & " ViewField.lngViewFieldID) INNER JOIN SalaryField ON ViewField.lngViewFieldID = " _
        & " SalaryField.lngViewFieldID) INNER JOIN SalaryList ON SalaryField.lngSalaryListID = " _
        & " SalaryList.lngSalaryListID) INNER JOIN View ON List.lngViewID = View.lngViewID " _
        & " WHERE List.lngOperatorID=" & mlngOperatorID & " AND " & "SalaryList.lngSalaryListID=" _
        & mlngSalaryID & " AND List.lngViewID=" & mintSalaryViewID & " AND List.lngListID= " & mlngListID _
        & " ORDER BY ListField.lngListFieldNO"
    strSql = "SELECT List.strListName,ListField.blnIsChoosed,ViewField.strViewFieldDesc," _
        & " ViewField.strTableName,ViewField.strFieldName,ListField.lngListID,ViewField.strFieldType," _
        & " ViewField.bytFieldDec,ViewField.strFieldName,ViewField.lngViewFieldID " _
        & " FROM List,ListField,ViewField,SalaryField,SalaryList,View1 " _
        & " WHERE ((((List.lngListID = ListField.lngListID) " _
        & " AND ListField.lngViewFieldID =ViewField.lngViewFieldID) " _
        & " AND ViewField.lngViewFieldID = SalaryField.lngViewFieldID) " _
        & " AND SalaryField.lngSalaryListID = SalaryList.lngSalaryListID)" _
        & " AND List.lngViewID = View1.lngViewID " _
        & " AND List.lngOperatorID=" & mlngOperatorID _
        & " AND " & "SalaryList.lngSalaryListID=" & mlngSalaryID _
        & " AND List.lngViewID=" & mintSalaryViewID _
        & " AND List.lngListID= " & mlngListID _
        & " ORDER BY ListField.lngListFieldNO"
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer, 64)
    If recRecordset.EOF Then
        '取SalaryField的项目
        'strSql = "SELECT ViewField.bytFieldDec,ViewField.strViewFieldDesc,ViewField.strFieldName," _
            & " ViewField.lngViewFieldID,ViewField.strFieldName,ViewField.strTableName,True AS blnIsChoosed," _
            & " ViewField.strFieldType,ViewField.lngViewFieldID FROM (SalaryField INNER JOIN SalaryList ON" _
            & " SalaryField.lngSalaryListID=SalaryList.lngSalaryListID) INNER JOIN ViewField ON" _
            & " SalaryField.lngViewFieldID = " _
            & " ViewField.lngViewFieldID WHERE SalaryList.lngSalaryListID=" & mlngSalaryID _
            & " AND ViewField.lngViewID =63 ORDER BY SalaryField.lngSalaryFieldNO"
        strSql = "SELECT ViewField.bytFieldDec,ViewField.strViewFieldDesc,ViewField.strFieldName," _
            & " ViewField.lngViewFieldID,ViewField.strFieldName,ViewField.strTableName,1 AS blnIsChoosed," _
            & " ViewField.strFieldType,ViewField.lngViewFieldID " _
            & " FROM SalaryField,SalaryList,ViewField " _
            & " WHERE (SalaryField.lngSalaryListID=SalaryList.lngSalaryListID) " _
            & " AND SalaryField.lngViewFieldID = ViewField.lngViewFieldID  " _
            & " AND SalaryList.lngSalaryListID=" & mlngSalaryID _
            & " AND ViewField.lngViewID =63 ORDER BY SalaryField.lngSalaryFieldNO"
        Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer, 64)
        mlngListID = 0
        If Not recRecordset.EOF Then
            recRecordset.MoveLast
            recRecordset.MoveFirst
        End If
    Else
        recRecordset.MoveLast
        recRecordset.MoveFirst
        mlngListID = recRecordset!lngListID
    End If
    mstrSelect = GetFieldString(recRecordset)
    recRecordset.Close
    Set recRecordset = Nothing
End Sub
'存工资本次发放的项目到List
Private Sub SaveNowListField(Optional blnEdit As Boolean = True)
    Dim strSql As String
    Dim recRecordset As rdoResultset