frmemploy.frm

一个用VB开发的考勤管理系统... 希望大家来看看..提出见意.. 谢谢.

Attribute VB_Exposed = False
Option Explicit
Dim mblnIsModify As Boolean
Dim mblnIsAdd As Boolean
Dim mintModLine As Integer
Public mcolWorkno As Collection
Dim mblnIsToCloseColor As Boolean
Dim mblnIsNeedSave As Boolean

Const mstrNoCard = "-"
Const mstrHasCard = "√"
Const mstrMissCard = "○"

'***** cmdCard
Private Const mNew = 0
Private Const mMiss = 1
Private Const mCancelMiss = 2
Private Const mChange = 3
Private Const mGreyCard = 4

'***txtEmp
Const mWorkNo = 0
Const mName = 1
Const mAge = 2
Const mNote = 3

'*****cboEmp
Const mSex = 0
Const mDept = 1
Const mTitle = 2

'****msfGrid
Const mGridWorkNo = 1
Const mGridSex = 3
Const mDeptName = 5
Const mTitleName = 6
Const mCardStatus = 7

Const mMsg1 = "您确定要删除此名员工的信息?"
Const mMsg2 = "抱歉,删除不成功!"

Private Sub RefreshCard(RefObj As Object, intCardStatus As Integer)
    Dim i As Integer
    Select Case intCardStatus
        Case gNoCard
            For i = 0 To RefObj.Count - 1
                With RefObj(i)
                    If i = mNew Then
                        If Not .Enabled Then .Enabled = True
                    Else
                        If .Enabled Then .Enabled = False
                    End If
                End With
            Next
        Case gHasCard
            For i = 0 To RefObj.Count - 1
                With RefObj(i)
                    If i = mMiss Or i = mChange Then
                        If Not .Enabled Then .Enabled = True
                    Else
                        If .Enabled Then .Enabled = False
                    End If
                End With
            Next
        Case gMissCard
            For i = 0 To RefObj.Count - 1
                With RefObj(i)
                    If i = mCancelMiss Or i = mChange Then
                        If Not .Enabled Then .Enabled = True
                    Else
                        If .Enabled Then .Enabled = False
                    End If
                End With
            Next
        Case mGreyCard
            For i = 0 To RefObj.Count - 1
                If RefObj(i).Enabled Then RefObj(i).Enabled = False
            Next
    End Select
End Sub



Private Sub cboEmp_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        SendKeyTab KeyCode
    End If
End Sub

Private Sub cmdCard_Click(Index As Integer)
    Dim intStatus As Integer
    Select Case Index
        Case mNew
            intStatus = gHasCard
        Case mMiss
            intStatus = gMissCard
        Case mCancelMiss
            intStatus = gHasCard
    End Select
    Dim Rst As Recordset
    Dim strWorkNo As String
    strWorkNo = Trim(msfGrid.TextMatrix(msfGrid.row, mGridWorkNo))
    Set Rst = gDataBase.OpenRecordset("select CardStatus from Employee where " _
        & " WorkNo='" & strWorkNo & "'")
    On Error GoTo CardErr
    If Rst.RecordCount > 0 Then
        With Rst
            .Edit
            !CardStatus = intStatus
            .Update
        End With
        
    End If
    Rst.Close
    Set Rst = Nothing
    chgGridStatus intStatus
    RefreshCard cmdCard, intStatus
    Exit Sub
CardErr:
    Err.Clear
    MsgBox "更改未成功!,请检查相关信息后重试!", vbInformation, gTitle
End Sub

Private Sub chgGridStatus(intStatus As Integer)
    With msfGrid
        .TextMatrix(.row, mCardStatus) = Trim(getStatus(intStatus))
        .TextMatrix(.row, .Cols - 1) = intStatus
    End With
End Sub

Private Sub cmdCloseColor_Click()
    CloseColor msfGrid
    mblnIsToCloseColor = False
    ChgcmdCloseColor
End Sub

Public Sub cmdEdit_Click(Index As Integer)
    Dim strTmp As String
    Select Case Index
        Case gCMDAPPEND
            Dim blnIsToGo As Boolean
            blnIsToGo = True
            If Not mblnIsAdd Then
                strTmp = gSTRCANCEL
                AddAction
                InitxtEmp
                txtEmp(mWorkNo).SetFocus
            Else
                If mblnIsNeedSave Then
                    If MsgBox("您确定不保存吗?", vbQuestion + _
                        vbYesNo + vbDefaultButton2, gTitle) _
                        = vbNo Then
                        blnIsToGo = False
                    End If
                End If
                If blnIsToGo Then
                    strTmp = gSTRAPPEND
                    InitxtEmp
                    ChangeColor False
                    mblnIsNeedSave = False
                    RefreshButton cmdEdit, gCMDEDITCANCEL
                Else
                    strTmp = gSTRCANCEL
                End If
                
            End If
            strTmp = strTmp & "(&A)"
            cmdEdit(gCMDAPPEND).Caption = strTmp
            If blnIsToGo Then
                mblnIsAdd = Not mblnIsAdd
            End If
        Case gCMDSAVE
            If AddToDataBase Then
               AfterSave
               strTmp = gSTRMODIFY & "&M"
               cmdEdit(gCMDEDIT).Caption = strTmp
               mnuEditModify.Caption = strTmp
            End If
        Case gCMDEDIT
            If Not mblnIsModify Then
                strTmp = gSTRRESET
                ToModify
            Else
                strTmp = gSTRMODIFY
                AfterSave
            End If
            strTmp = strTmp & "(&M)"
            mnuEditModify.Caption = strTmp
            cmdEdit(gCMDEDIT).Caption = strTmp
        Case gCMDDELETE
            MsgBox "您如果删除了该员工," & vbCrLf & vbCrLf _
                & "则有关该员工所有信息都将删除" & vbCrLf & vbCrLf _
                & "包括考勤记录、请假记录，出差记录等...", vbCritical, gTitle
            
'            DeleteForEmployee msfGrid, 1, "您确定要删除此名员工的信息?", _
'                gDataBase, "Employee", "WorkNo"
            If DeleteForEmployee Then
                If Not txtEmp(mName).Locked Then InitxtEmp
                RefreshButton cmdEdit, gCMDEDITNORMAL
            End If
        Case gCMDQUERY
            Set mcolWorkno = New Collection
            
            frmEmpFind.Show vbModal
            
            If mblnIsToCloseColor Then
                mblnIsToCloseColor = False
                CloseColor msfGrid
                ChgcmdCloseColor
            End If
            If mcolWorkno.Count > 0 Then ShowQueryMan
        Case gCMDRETURN
            Unload Me
    End Select
End Sub '

Private Function DeleteForEmployee() As Boolean
    Dim isTrans As Boolean
    Dim strKey As String
    Dim strField As String
    
    If MsgBox(mMsg1, _
        vbQuestion + vbYesNo + vbDefaultButton2, _
        gTitle) = vbNo Then Exit Function
    
    On Error GoTo DeleteErr
    With msfGrid
        strKey = Trim(.TextMatrix(.row, 1))
        strField = "WorkNo"
        BeginTrans
            isTrans = True
            SetDelFlagForTable strKey, gDataBase, gPlanTableName, strField, True
            SetDelFlagForTable strKey, gDataBase, "Absent", strField, True
            SetDelFlagForTable strKey, gDataBase, "ChangePlan", strField, True
            SetDelFlagForTable strKey, gDataBase, "KqHistory", strField, True
            SetDelFlagForTable strKey, gDataBase, "Leave", strField, True
            SetDelFlagForTable strKey, gDataBase, "Employee", strField, True
        CommitTrans
        DeleteForEmployee = True
        isTrans = False
        If .Rows = .FixedRows + 1 Then
            .Rows = .FixedRows
        Else
            .RemoveItem .row
        End If
    End With
    
    Exit Function
DeleteErr:
    If isTrans Then Rollback
    MsgBox mMsg2 & vbCrLf & vbCrLf & Err.Description, vbExclamation, gTitle
    Err.Clear
    DeleteForEmployee = False
End Function

Private Sub ShowQueryMan()
    Dim i As Integer
    Dim j As Integer
    Dim H As Integer
    With msfGrid
        If .Redraw Then .Redraw = False
        mblnIsToCloseColor = True
        ChgcmdCloseColor
        For i = 1 To mcolWorkno.Count
            For j = .FixedRows To .Rows - 1
                If Trim(mcolWorkno.Item(i)) = Trim(.TextMatrix(j, mGridWorkNo)) Then
                    For H = 0 To .Cols - 1
                        .row = j
                        .col = H
                        .CellBackColor = gCellSelBackColor
                        .CellForeColor = gCellSelForeColor
                    Next
                    Exit For
                End If
            Next
        Next
        .Redraw = True
    End With
End Sub

Private Sub AfterSave()
    InitxtEmp
    ChangeColor False
    RefreshButton cmdEdit, gCMDEDITNORMAL
    mblnIsModify = False
    mblnIsAdd = False
    mblnIsNeedSave = False
    cmdEdit(gCMDAPPEND).Caption = gSTRAPPEND & "&A"
End Sub

Private Sub InitxtEmp()
    Dim i As Integer
    For i = 0 To txtEmp.Count - 1
        With txtEmp(i)
            .Text = Empty
        End With
    Next
    For i = 0 To cboEmp.Count - 1
        If cboEmp(i).ListCount > 0 Then cboEmp(i).ListIndex = 0
    Next
End Sub

Private Sub AddAction()
    RefreshButton cmdEdit, gCMDAPPEND
    ChangeColor True
End Sub
Private Sub Form_Load()
    SetGridColor msfGrid
    ChangeColor False
    RefreshButton cmdEdit, gCMDEDITNORMAL
    RefreshCard cmdCard, mGreyCard
    msfGrid.FormatString = "^序号" & vbTab & "^工号" & Space(2) & vbTab _
                   & "<姓 名" & Space(3) & vbTab _
                   & "^性别" & Space(1) & vbTab _
                   & "^年龄" & Space(1) & vbTab _
                   & "<部 门" & Space(4) & vbTab _
                   & "<职 务" & Space(4) & vbTab _
                   & "^卡状态" & Space(3) & vbTab _
                   & "<备  注" & Space(7) & vbTab & "<StatusID"
    
    With cboEmp(mDept)
        .Clear
        FillCbo cboEmp(mDept), aDepartment
    End With
    With cboEmp(mTitle)
        .Clear
        FillCbo cboEmp(mTitle), aTitle
    End With
    
    FillGrid
    mblnIsToCloseColor = False
    ChgcmdCloseColor
    'cmdEdit(gCMDAPPEND).SetFocus
End Sub