frmemploy.frm

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

Private Sub ChgcmdCloseColor()
    cmdCloseColor.Enabled = mblnIsToCloseColor
End Sub

Private Sub ChangeColor(isEdit As Boolean)
    Dim i As Integer
    For i = 0 To txtEmp.Count - 1
        ChangeBackColor txtEmp(i), isEdit
        txtEmp(i).Locked = Not isEdit
    Next
    For i = 0 To cboEmp.Count - 1
        With cboEmp(i)
            .Enabled = isEdit
            ChangeBackColor cboEmp(i), isEdit
        End With
    Next
End Sub

Private Sub ToModify()
    With msfGrid
        Dim i As Integer
        Dim CellStr As String
        mintModLine = .row
        mblnIsModify = True
        For i = 1 To mTitleName
            CellStr = Trim(.TextMatrix(.row, i))
            Select Case i
                Case 1 To mDeptName - 1
                    If i <> mGridSex Then
                        If i = mGridSex + 1 Then
                            txtEmp(i - 2) = CellStr
                        Else
                            txtEmp(i - 1) = CellStr
                        End If
                    Else
                        LookForCboByStr cboEmp(mSex), CellStr
                    End If
                Case mDeptName
                    LookForCboByStr cboEmp(mDept), CellStr
                Case mTitleName
                    LookForCboByStr cboEmp(mTitle), CellStr
            End Select
        Next
        txtEmp(mNote) = Trim(.TextMatrix(mintModLine, .Cols - 2))
    End With
    ChangeColor True
    RefreshButton cmdEdit, gCMDEDIT
    txtEmp(mWorkNo).Locked = True
    txtEmp(mName).SetFocus
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmEmploy = Nothing
End Sub

Private Sub mnuEditCard_Click(Index As Integer)
    cmdCard_Click Index
End Sub

Private Sub mnuEditDelete_Click()
    cmdEdit_Click gCMDDELETE
End Sub

Private Sub mnuEditModify_Click()
    cmdEdit_Click gCMDEDIT
End Sub

Private Sub msfGrid_Click()
    With msfGrid
        If .MouseRow = 0 Then SortGridByCol msfGrid
        RefreshCard cmdCard, Val(.TextMatrix(.row, .Cols - 1))
    End With
End Sub

Private Sub RefreshBtnLocal(blnIsGotFocus As Boolean)
    cmdEdit(gCMDEDIT).Enabled = blnIsGotFocus
    cmdEdit(gCMDDELETE).Enabled = blnIsGotFocus
End Sub

Private Sub msfGrid_GotFocus()
    If msfGrid.Rows <= msfGrid.FixedRows Then Exit Sub
    If Not (mblnIsModify Or mblnIsAdd) Then
        RefreshBtnLocal True
    End If
End Sub


'Private Sub msfGrid_LostFocus()
'    If Not mblnIsModify Then
'        RefreshBtnLocal False
'    End If
'End Sub

Private Sub msfGrid_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With msfGrid
        If .MouseRow = 0 Then Exit Sub
        If .Rows <= .FixedRows Then Exit Sub
        If Button = 2 Then
            If Trim(.TextMatrix(.MouseRow, mGridWorkNo)) <> Empty Then
                RefreshCard mnuEditCard, Val(.TextMatrix(.row, .Cols - 1))
                PopupMenu mnuEdit
            End If
        End If
    End With
End Sub


Private Sub txtEmp_Change(Index As Integer)
    If Index = mWorkNo Then
        If Not txtEmp(Index).Locked Then
            mblnIsNeedSave = Trim(txtEmp(Index)) <> Empty
        End If
    End If
End Sub

Private Sub txtEmp_GotFocus(Index As Integer)
    GotFocus txtEmp(Index)
End Sub

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

Private Sub FillGrid()
    Dim Rst As Recordset
    Dim ClipStr As String
    Dim tmpStr As String
    Dim intCount As Integer
    Set Rst = gDataBase.OpenRecordset("QryEmployee", dbOpenSnapshot)
    If msfGrid.Redraw Then msfGrid.Redraw = False
    With Rst
        While Not .EOF
            intCount = intCount + 1
            ClipStr = ClipStr & CStr(intCount) & vbTab _
                    & IIf(IsNull(!WorkNo), "", Trim(!WorkNo)) & vbTab _
                    & IIf(IsNull(!Name), "", Trim(!Name)) & vbTab _
                    & IIf(IsNull(!Sex), "", Trim(!Sex)) & vbTab _
                    & IIf(IsNull(!Age), "", Trim(Str(!Age))) & vbTab _
                    & IIf(IsNull(!DeptName), "", Trim(!DeptName)) & vbTab _
                    & IIf(IsNull(!TitleName), "", Trim(!TitleName)) & vbTab
                    
            tmpStr = getStatus(!CardStatus)
                
            ClipStr = ClipStr & tmpStr & vbTab _
                & IIf(IsNull(!Note), "", Trim(!Note)) _
                & vbTab & !CardStatus
            If Not .EOF Then
                ClipStr = ClipStr & vbCr
            End If
            .MoveNext
        Wend
    End With
    
    Dim intRows As Integer
    Dim intCols As Integer
    intRows = Rst.RecordCount + 1
    intCols = 10
    ClipToGrid msfGrid, ClipStr, intRows, intCols
    msfGrid.ColWidth(msfGrid.Cols - 1) = 0
    Rst.Close
    Set Rst = Nothing
End Sub

Private Function getStatus(intStatus As Integer) As String
    Dim tmpStr As String
    Select Case intStatus
        Case gNoCard
            tmpStr = mstrNoCard
        Case gHasCard
            tmpStr = mstrHasCard
        Case gMissCard
            tmpStr = mstrMissCard
    End Select
    getStatus = tmpStr
End Function


Private Function AddToDataBase() As Boolean
    Dim strWorkNo As String
    Dim strName As String
    Dim strSex As String
    Dim strAge As String
    Dim intDept As Integer
    Dim intTitle As Integer
    Dim strNote As String
    Dim isTrans As Boolean
    
    strWorkNo = Trim(txtEmp(mWorkNo))
    strName = Trim(txtEmp(mName))
    strSex = Trim(cboEmp(mSex).Text)
    strAge = Trim(txtEmp(mAge))
    strNote = Trim(txtEmp(mNote))
    getItemData cboEmp(mDept), intDept
    getItemData cboEmp(mTitle), intTitle
    
    If strWorkNo = Empty Then
        MsgBox "工号不能为空,请输入!!", , gTitle
        AddToDataBase = False
        txtEmp(mWorkNo).SetFocus
        Exit Function
    End If
    
    If strName = Empty Then
        MsgBox "姓名不能为空,请输入!!", vbInformation, gTitle
        AddToDataBase = False
        txtEmp(mName).SetFocus
        Exit Function
    End If
    
    If Not mblnIsModify Then
        If IsExist(gDataBase, "Employee", "WorkNo", strWorkNo, True) Then
            MsgBox "该工号已经存在!,请更换!!", vbInformation, gTitle
            AddToDataBase = False
            txtEmp(mWorkNo).SetFocus
            Exit Function
        End If
    End If
    
    Dim Rst As Recordset
    
    If Not mblnIsModify Then
        Set Rst = gDataBase.OpenRecordset("Employee")
    Else
        Set Rst = gDataBase.OpenRecordset("select * from Employee " _
            & " where WorkNo='" & strWorkNo & "'")
        If Rst.RecordCount <= 0 Then GoTo SaveErr
    End If
    
    On Error GoTo SaveErr
    BeginTrans
    isTrans = True
    If mblnIsModify Then
        Rst.Edit
    Else
        Rst.AddNew
        Rst!WorkNo = strWorkNo
    End If
    With Rst
        !Name = strName
        !Sex = strSex
        !Age = CInt(strAge)
        !DeptID = intDept
        !TitleID = intTitle
        !Note = strNote
        If Not mblnIsModify Then
            !CardStatus = gNoCard
        End If
        !Spell = UCase(GetPy2(strName))
        .Update
    End With
    
    If Not mblnIsModify Then
        Dim intDay As Integer
        Dim bytDay As Byte
        Dim bytShift As Byte
        Dim Sql As String
        '在排班表中插入此员工
'        bytShift = gNOSHIFT
'        For intDay = 1 To gMaxDay
'            bytDay = intDay
'            Sql = "Insert into " & gPlanTableName & _
'                " (WorkNo,F_Day,F_Shift) values ('" _
'                & strWorkNo & "'," & bytDay & "," & bytShift & ")"
'            gDataBase.Execute Sql
'        Next
    End If
    
    CommitTrans
    isTrans = False
    Rst.Close
    Set Rst = Nothing
    AddToDataBase = True
    With msfGrid
        If Not mblnIsModify Then
            Dim StrAdd As String
            Dim intOrder As Integer
            
            If .Rows <= .FixedRows Then
                intOrder = 0
            Else
                intOrder = CInt(.TextMatrix(.Rows - 1, 0))
            End If
            StrAdd = CStr(intOrder + 1) & vbTab _
                    & strWorkNo & vbTab _
                    & strName & vbTab _
                    & strSex & vbTab _
                    & strAge & vbTab _
                    & Trim(cboEmp(mDept).Text) & vbTab _
                    & Trim(cboEmp(mTitle).Text) & vbTab _
                    & mstrNoCard & vbTab _
                    & strNote
            .AddItem StrAdd
            .TopRow = .Rows - 1
        Else
            Dim intRow As Integer
            intRow = .row
            .TextMatrix(intRow, 2) = strName
            .TextMatrix(intRow, 3) = strSex
            .TextMatrix(intRow, 4) = strAge
            .TextMatrix(intRow, 5) = Trim(cboEmp(mDept).Text)
            .TextMatrix(intRow, 6) = Trim(cboEmp(mTitle).Text)
            .TextMatrix(intRow, 8) = strNote
        End If
    End With
    Exit Function
SaveErr:
    If isTrans Then Rollback
    MsgBox "数据未保存成功!请再试!!" & vbCrLf & vbCrLf & Err.Description, , gTitle
    Err.Clear
    AddToDataBase = False
   ' Rst.CancelUpdate
End Function

Private Sub txtEmp_KeyPress(Index As Integer, KeyAscii As Integer)
    Select Case Index
        Case mWorkNo
            KeyAscii = KeyFilter(KeyAscii, False)
        Case mAge
            KeyAscii = ValiText(KeyAscii, "0123456789", True)
    End Select
    
End Sub

Private Sub txtEmp_LostFocus(Index As Integer)
    If Index = mWorkNo Then
        txtEmp(Index) = UCase(Trim(txtEmp(Index)))
    End If
End Sub