frmsalarylist.frm

金算盘软件代码

                    mclsGrid.ListSet.ViewId = mintSalaryListViewID
                    lngSalaryListID = .TextMatrix(.Row, 0)
                    '重新计算工资数据表
                    Call JionGrid
                    If .Rows = 1 Then
                        txtFindValue.Text = ""
                    End If
                    '删除工资栏目设置
                    strSql = "SELECT SalaryListSet.lngSalaryListID, SalaryListSet.lngListID FROM SalaryListSet " & _
                             " WHERE SalaryListSet.lngSalaryListID = " & .TextMatrix(.Row, 0)
                    Set recListSet = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer, 64)
                    If Not recListSet.EOF Then
                        recListSet.MoveLast
                        recListSet.MoveFirst
                        lngListID = 0
                        For i = 0 To recListSet.RowCount - 1
                            lngListID = recListSet!lngListID
                            If lngListID > 0 Then
                                strSql = "SELECT SalaryListSet.lngSalaryListID, SalaryListSet.lngListID " & _
                                         " FROM SalaryListSet " & _
                                         " WHERE SalaryListSet.lngListID = " & lngListID & _
                                         " AND SalaryListSet.lngSalaryListID <> " & .TextMatrix(.Row, 0)
                                Set recZ = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                                If Not recZ.EOF Then
                                    strSql = "DELETE FROM SalaryListSet " & _
                                             " WHERE SalaryListSet.lngListID = " & lngListID & _
                                             " AND SalaryListSet.lngSalaryListID = " & .TextMatrix(.Row, 0)
                                    gclsBase.BaseDB.Execute strSql
                                Else
                                    strSql = "DELETE FROM SalaryListSet " & _
                                             " WHERE SalaryListSet.lngListID = " & lngListID & _
                                             " AND SalaryListSet.lngSalaryListID = " & .TextMatrix(.Row, 0)
                                    gclsBase.BaseDB.Execute strSql
                                    strSql = "DELETE FROM List WHERE lngListID=" & lngListID
                                    gclsBase.BaseDB.Execute strSql
                                    strSql = "DELETE FROM ListField WHERE ListField.lngListID=" & lngListID
                                    gclsBase.BaseDB.Execute strSql
                                End If
                            End If
                            recListSet.MoveNext
                        Next
                    End If
                    strSql = "SELECT Max(lngSalaryListID) AS lngSalaryID FROM SalaryList WHERE lngSalaryListID<" & lngSalaryListID & " GROUP BY lngSalaryListID"
                    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If Not recRecordset.EOF Then
                        lngSalaryListID = recRecordset!lngSalaryID
                    Else
                        strSql = "SELECT Min(lngSalaryListID) AS lngSalaryID FROM SalaryList WHERE lngSalaryListID>" & lngSalaryListID & " GROUP BY lngSalaryListID"
                        Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                        If Not recRecordset.EOF Then
                            lngSalaryListID = recRecordset!lngSalaryID
                            strSql = "UPDATE Salary SET Salary.dblLastZero=0,Salary.dblNowTax=0 WHERE lngSalaryListID=" & lngSalaryListID
                            gclsBase.BaseDB.Execute strSql
                            lngSalaryListID = recRecordset!lngSalaryID
                        Else
                            Me.MousePointer = vbDefault
                            Exit Sub
                        End If
                    End If
                    Call Salary.CalcOldData(lngSalaryListID, False)
                    Me.MousePointer = vbDefault
                End If
            End If
        Else
            ShowMsg Me.hWnd, "没有工资表可以删除。", vbInformation, "工资发放"
        End If
    End With
    Exit Sub
Errors1:
    gclsBase.BaseWorkSpace.RollBacktrans
    Me.MousePointer = vbDefault
    ShowMsg Me.hWnd, "数据库正在被其他用户使用，不能删除工资表。", vbInformation, "工资发放"
    Exit Sub
End Sub
Private Sub mnuInput()
    '编辑工资表
    Dim strMsg As String
    
    If Not Salary.VolidSalaryOpIsEnable(3) Then Exit Sub
    With msgSalaryList
        If .TextMatrix(.Row, 0) <> "" And .Rows > 1 Then
            Me.MousePointer = vbHourglass
            mlngSalaryID = Val(.TextMatrix(msgSalaryList.Row, 0))
            frmSalaryEdit.ShowSalaryEdit
            Me.MousePointer = vbDefault
        Else
            ShowMsg Me.hWnd, "请先选择要录入的工资表。", vbInformation, "工资发放"
        End If
    End With
End Sub
Private Sub mnuNew()
    '生成工资表向导
    Dim strMsg As String
       
    If Not Salary.VolidSalaryOpIsEnable(1) Then Exit Sub
    If mblnSalaryInput Then
        ShowMsg Me.hWnd, "请先关闭录入窗体，再生成工资数据。", vbInformation, "工资发放"
        Exit Sub
    End If
    Me.MousePointer = vbHourglass
    mlngSalaryID = 0
    mblnIsAddSalary = True
    '调用向导（新增）
    frmSalaryListNewWizard.ShowSalaryWiZard 0, mlngSalaryID
    Me.MousePointer = vbDefault
End Sub

Private Sub mnuChange()
    Dim strMsg As String
    
    If Not Salary.VolidSalaryOpIsEnable(2) Then Exit Sub
    If mblnSalaryInput Then
        ShowMsg Me.hWnd, "请先关闭录入窗体，再修改工资生成向导。", vbInformation, "工资发放"
        Exit Sub
    End If
    With msgSalaryList
        If .Rows = 1 Then
            ShowMsg Me.hWnd, "无工资表可以修改工资向导。", vbInformation, "工资发放"
            Exit Sub
        End If
        If .Rows > 2 Or (.Rows = 2 And Len(Trim(.TextMatrix(1, 1))) > 0) Then
            mblnIsAddSalary = False
            Me.MousePointer = vbHourglass
            mlngSalaryID = Val(msgSalaryList.TextMatrix(msgSalaryList.Row, 0))
            '调用向导（修改）
            frmSalaryListNewWizard.ShowSalaryWiZard 1, mlngSalaryID
            Me.MousePointer = vbDefault
        Else
            ShowMsg Me.hWnd, "没有要修改工资表,请先增加一张工资表。", vbInformation, "工资发放"
            mblnIsAddSalary = True
            mlngSalaryID = 0
            Me.MousePointer = vbHourglass
            '调用向导（新增）
            frmSalaryListNewWizard.ShowSalaryWiZard 0, mlngSalaryID
            Me.MousePointer = vbDefault
        End If
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Set mclsGrid = Nothing
    Set mSalaryListMenu = Nothing
    gclsSys.MainControls.Remove Me
    Set frmSalaryList = Nothing
End Sub

Private Sub mclsGrid_AfterColChange(lngSourCol As Long, lngDestCol As Long)
    '搜索查找列
    Call cboFind_Click
End Sub
Private Sub mSalaryListMenu_ChildActive()
    Call CreateMenu
    Call RefreshMenu
    SetHelpID Me.HelpContextID
End Sub
Private Sub mSalaryListMenu_EditDel()
    Call mnuDel
End Sub
Private Sub mSalaryListMenu_EditEdit()
    Call mnuChange
End Sub

Private Sub mSalaryListMenu_EditFilter()
    mclsGrid.ListSet.SaveList
    Filter.ShowFilter mclsGrid.ListSet.ListID, 1
    mclsGrid.ListSet.ViewId = mintSalaryListViewID
    Call JionGrid
End Sub

Private Sub mSalaryListMenu_EditNew()
    Call mnuNew
End Sub

Private Sub mSalaryListMenu_EditSearch()
    frmTreeFind.ShowFind
End Sub

Private Sub mSalaryListMenu_FilePrint()
    Call Print_Grid
End Sub
Private Sub mSalaryListMenu_FilePrintSetup()
    Call PrintSetup_Grid
End Sub

Private Sub mSalaryListMenu_ListEditMenu(ByVal intIndex As Integer)
    Dim blnIsOK As Boolean
    Dim strWhere As String
    
    With msgSalaryList
        If .TextMatrix(.Row, 0) <> "" And .Row > 0 Then
            mlngSalaryID = .TextMatrix(.Row, 0)
        Else
            mlngSalaryID = 0
        End If
    End With
    If mlngSalaryID > 0 And intIndex <> 1 And intIndex <> 7 Then
        If Not Salary.VolidSalaryIdIsExists(mlngSalaryID, 2) Then
            Exit Sub
        End If
    End If
    Select Case intIndex
    Case 0 '修改
        Call mnuChange
    Case 1 '新增
        Call mnuNew
    Case 2 '删除
        Call mnuDel
    Case 4 '录入
        Call mnuInput
    Case 5 '筛选
        mclsGrid.ListSet.SaveList
        mclsGrid.ListSet.ViewId = mintSalaryListViewID
        Filter.ShowFilter mclsGrid.ListSet.ListID, 1, , , , , blnIsOK
        If blnIsOK = True Then
            mclsGrid.ListSet.SaveList
            Call JionGrid
        End If
    Case 7 '刷新
        Call JionGrid
    Case 8 '打印
        Call Print_Grid
    End Select
End Sub

Private Sub mSalaryListMenu_ListReportMenu(ByVal intIndex As Integer)
    Dim strSql As String
    Dim rec As rdoResultset
    
   With msgSalaryList
        If .TextMatrix(.Row, 0) <> "" And .Row > 0 Then
            mlngSalaryID = .TextMatrix(.Row, 0)
        Else
            mlngSalaryID = 0
        End If
    End With
    If mlngSalaryID > 0 Then
        If Not Salary.VolidSalaryIdIsExists(mlngSalaryID, 2) Then
            Exit Sub
        End If
    End If
    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.OpenRecordset ("Bank", dbOpenSnapshot)
        strSql = "SELECT Bank.lngBankId  FROM Bank "
        Set rec = gclsBase.BaseDB.OpenResultset(strSql, 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 mSalaryListMenu_ToolRefresh()
    Call JionGrid
End Sub

Private Sub msgSalaryList_DblClick()
    Dim strMsg As String
   
    With msgSalaryList
        If .Rows < 2 Then
            Exit Sub
        End If
        If .TextMatrix(.MouseRow, 0) <> "" And .Rows > 1 And .ColSel > 0 Then
             '没有工资录入权限
            If Not mblnIsInputRight Then
                ShowMsg Me.hWnd, "您没有“工资录入”权限。", vbExclamation, Me.Caption
                Exit Sub
            End If
            If Not Salary.VolidSalaryOpIsEnable(3) Then Exit Sub
            Me.MousePointer = vbHourglass
            mlngSalaryID = .TextMatrix(msgSalaryList.Row, 0)
            If Not Salary.VolidSalaryIdIsExists(mlngSalaryID, 2) Then
                Exit Sub
            End If
            frmSalaryEdit.ShowSalaryEdit
            Me.MousePointer = vbDefault
        End If
    End With
End Sub

Private Sub msgSalaryList_KeyDown(KeyCode As Integer, Shift As Integer)
    With msgSalaryList
        If KeyCode = 38 And .Row > 1 Then
            .Row = .Row - 1
        End If
        If KeyCode = 40 And .Row > .Rows - 1 Then
            .Row = .Row + 1
        End If
        If KeyCode = 13 Then
            Call msgSalaryList_DblClick
        End If
    End With
End Sub
Private Sub msgSalaryList_KeyUp(KeyCode As Integer, Shift As Integer)
    msgSalaryList.RowSel = msgSalaryList.Row
End Sub
Private Sub msgSalaryList_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not frmMain.ActiveForm Is Me Then Exit Sub
    If msgSalaryList.ColSel = 0 Then
        mblnChangeText = True
        txtFindValue.Text = ""
        mblnChangeText = False
        cmdFind.Enabled = False
    Else
        If msgSalaryList.Rows > 1 Then
            cmdFind.Enabled = True
            If mlngFindCol = 0 Then
                txtFindValue.Text = ""
            Else
                txtFindValue.Text = msgSalaryList.TextMatrix(msgSalaryList.Row, mlngFindCol)
            End If
        End If
    End If
    msgSalaryList.RowSel = msgSalaryList.Row
    If Button = 2 Then
        '鼠标右键
        Call CreateMenu
        Call RefreshMenu
        x = x + msgSalaryList.Left
        y = y + msgSalaryList.top
        PopupMenu frmMain.mnuListEdit, , x, y
        Exit Sub
    Else
        Call CreateMenu
        Call RefreshMenu
        msgSalaryList.RowSel = msgSalaryList.Row
    End If
End Sub

'工资表ID
Public Property Get SalaryID() As Long
    SalaryID = mlngSalaryID
End Property
Public Property Let SalaryID(ByVal vNewValue As Long)
    mlngSalaryID = vNewValue
End Property
Public Property Get EditItem() As Integer
    EditItem = mintEditItem
End Property
Public Property Let EditItem(ByVal vNewValue As Integer)
    mintEditItem = vNewValue
End Property

Public Property Get SalaryViewID() As Integer
    SalaryViewID = mintSalaryViewID