frmmain.frm

这是温州现代集团的员工考勤管理系统

        strKqDate = Trim(.TextMatrix(.row, mGridStartDate))
        strKqTime = Trim(.TextMatrix(.row, mGridStartTime))
        Sql = "update KqHistory set " _
            & " F_DelFlag=" & gTRUE _
            & " where WorkNo='" & strWorkNo & "' " _
            & " and KqDate='" & strKqDate & "' " _
            & " and KqTime='" & strKqTime & "'"
        gDataBase.Execute Sql
    End With
    With msfGrid
        If .Rows = .FixedRows + 1 Then
            .Rows = .FixedRows
        Else
            .RemoveItem .row
        End If
    End With
    Exit Sub
DeleteErr:
    MsgBox "抱歉,删除不成功" & vbCrLf & Err.Description, vbInformation, gTitle
    Err.Clear
End Sub
Private Sub AppendToGrid()
    With msfGrid
        .Rows = .Rows + 1
        .row = .Rows - 1
        .col = mGridWorkNo
        SetTxtPosition msfGrid, txtEdit
    End With
End Sub

Private Sub Form_Load()
    SetFormPosition
    ReDim mColNotRegister(0)
    mColNotRegister(0).WorkNo = ""
    ReDim mColInValidCard(0)
    mColInValidCard(0).WorkNo = ""
    
    iniTitle
    SetGridColor msfGrid
    
    If mMenuIndex = gMAINCOLLECT Then
        lstNotRegister.BackColor = gGridBackColor
        lstInValidCard.BackColor = gGridBackColor
        RefreshButton cmdKq, gCMDEDITNORMAL
    Else
        ChangeColorFortxtKQ False
        InitxtEdit 'inidate
        RefreshButton cmdEdit, gCMDEDITNORMAL
    End If
    
    IntoMain mMenuIndex
    msfGrid.FormatString = mFormatString '   'mAbsentTitle 'mLeaveTitle
    
End Sub

Private Sub SetFormPosition()
    Me.Left = (12000 - Me.Width) / 2
    Me.Top = (9000 - Me.Height)
End Sub


Private Function getToday() As String
    getToday = Format(Now, "yyyy-mm-dd")
End Function


'Private Sub setStatusBar(Index As Integer, MsgStr As String)
'    sbrData.Panels(Index).Text = MsgStr
'End Sub


Private Sub lstNotRegister_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With lstNotRegister
        If .ListCount <= 0 Then Exit Sub
        If Button = 2 Then
            'RefreshCard mnuEditCard, Val(.TextMatrix(.row, .Cols - 1))
            'Refresh
            Dim strWorkNo As String
            strWorkNo = Left(Trim(.Text), 4)
            RefreshmnuList strWorkNo
            PopupMenu mnuList
        End If
    End With
End Sub

Private Sub RefreshmnuList(strWorkNo As String)
    Dim Rst As Recordset
    Dim blnIsRegister As Boolean
    Set Rst = gDataBase.OpenRecordset("select * from Employee" _
        & " where WorkNo='" & Trim(strWorkNo) _
        & "' order by WorkNo", dbOpenSnapshot)
    blnIsRegister = Rst.RecordCount <= 0
    Rst.Close
    Set Rst = Nothing
    
    mnuListAppend.Enabled = Not blnIsRegister
    mnuListRegister.Enabled = blnIsRegister
End Sub


Private Sub mnuListAppend_Click()
    If Trim(lstNotRegister.Text) = Empty Then Exit Sub
    If MsgBox("是否要把此条记录添加到考勤数据采集中?", _
        vbQuestion + vbYesNo, gTitle) = vbNo Then Exit Sub
    Dim strWorkNo As String
    Dim strKqDate As String
    Dim strKqTime As String
    Dim intTemp As Integer
    Dim strList As String
    Dim intListIndex As Integer
    intListIndex = lstNotRegister.ListIndex
    strList = Trim(lstNotRegister.Text)
    strWorkNo = Left(strList, 4)
    strList = Trim(Mid(strList, 5))
    intTemp = InStr(1, strList, " ", vbTextCompare)
    strKqDate = Trim(Left(strList, intTemp))
    strKqTime = Trim(Mid(strList, intTemp))
    
    Dim Rst As Recordset
    Dim EmpRst As Recordset
    Dim strIn As String
    
    On Error GoTo ErrHandle
    Set Rst = gDataBase.OpenRecordset("KqHistory")
    Set EmpRst = gDataBase.OpenRecordset("Select * from " _
        & " QryEmployee where WorkNo='" & strWorkNo & "'" & _
        " order by WorkNo", dbOpenSnapshot)
    If EmpRst.RecordCount > 0 Then
        Rst.AddNew
        Rst!WorkNo = strWorkNo
        Rst!KqDate = strKqDate
        Rst!KqTime = strKqTime
        Rst.Update
        
        With EmpRst
            strIn = strWorkNo & vbTab _
                & !Name & vbTab & !Sex & vbTab _
                & !DeptName & vbTab & !TitleName & vbTab _
                & strKqDate & vbTab & strKqTime
        End With
        msfGrid.AddItem strIn
        lstNotRegister.RemoveItem intListIndex
    End If
    Rst.Close
    Set Rst = Nothing
    EmpRst.Close
    Set EmpRst = Nothing
    Exit Sub
    
ErrHandle:
    MsgBox Err.Description, vbInformation, gTitle
    Err.Clear
    Exit Sub
    'End If
End Sub

Private Sub mnuListRegister_Click()
    If lstNotRegister.ListCount <= 0 Then Exit Sub
    If MsgBox("是否要对此卡进行登记?", _
        vbQuestion + vbYesNo, gTitle) = vbNo Then Exit Sub
    With frmEmploy
        .Show 0, Me
        .cmdEdit_Click 0
        .txtEmp(0) = Left(Trim(lstNotRegister.Text), 4)
    End With
End Sub

Private Sub mSetColor_Click()

End Sub

Private Sub mSetOption_Click()

End Sub

Private Sub medDate_GotFocus()
    msfGrid.Enabled = False
    medDate.SelStart = 0
    medDate.SelLength = Len(medDate.Text)
End Sub

Private Sub medDate_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyReturn
            Dim Str As String
            Str = Trim(medDate.Text)
            With msfGrid
                If Str <> Empty Then
                    .TextMatrix(.row, mGridStartDate) = Str
                    medDate.Visible = False
                    If Not mblnCollectModify Then
                        .col = mGridStartTime
                        SetMedPosition msfGrid, medTime, False
                    Else
                        If Str <> mOldKqDate Then
                            If SaveCollectByModify Then
                                mblnCollectModify = False
                            Else
                                .TextMatrix(.row, mGridStartDate) = mOldKqDate
                            End If
                        End If
                        msfGrid.Enabled = True
                    End If
                End If
            End With
        Case vbKeyEscape
            If mblnCollectModify Then
                If medDate.Visible Then medDate.Visible = False
                If Not msfGrid.Enabled Then msfGrid.Enabled = True
                msfGrid.SetFocus
            End If
    End Select
End Sub

Private Function SaveCollectByModify() As Boolean
    Dim strWorkNo As String
    Dim strKqDate As String
    Dim strKqTime As String
    Dim Sql As String
    On Error GoTo SaveErr
    With msfGrid
        strWorkNo = Trim(.TextMatrix(.row, mGridWorkNo))
        strKqDate = Trim(.TextMatrix(.row, mGridStartDate))
        strKqTime = Trim(.TextMatrix(.row, mGridStartTime))
        Sql = "update KqHistory set " _
            & " KqDate='" & strKqDate & "'," _
            & " KqTime='" & strKqTime & "' " _
            & " where WorkNo='" & strWorkNo & "' " _
            & " and KqDate='" & mOldKqDate & "' " _
            & " and KqTime='" & mOldKqTime & "'"
        gDataBase.Execute Sql
    End With
    SaveCollectByModify = True
    Exit Function
SaveErr:
    MsgBox "抱歉,保存不成功" & vbCrLf & Err.Description, vbInformation, gTitle
    Err.Clear
    SaveCollectByModify = False
End Function

Private Sub medDate_LostFocus()
    medDate.Visible = False
End Sub

Private Sub medTime_GotFocus()
    msfGrid.Enabled = False
    medTime.SelStart = 0
    medTime.SelLength = Len(medTime.Text)
End Sub

Private Sub medTime_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyReturn
            Dim Str As String
            Str = Trim(medTime.Text)
            With msfGrid
                If Str <> Empty Then
                    .TextMatrix(.row, mGridStartTime) = Str
                    medTime.Visible = False
                    If Not mblnCollectModify Then
                        cmdKq_Click gCMDSAVE
                    Else
                        If Str <> mOldKqTime Then
                            If SaveCollectByModify Then
                                mblnCollectModify = False
                            Else
                                .TextMatrix(.row, mGridStartTime) = mOldKqTime
                            End If
                        End If
                        msfGrid.Enabled = True
                    End If
                End If
            End With
        Case vbKeyEscape
            If mblnCollectModify Then
                If medTime.Visible Then medTime.Visible = False
                If Not msfGrid.Enabled Then msfGrid.Enabled = True
                msfGrid.SetFocus
            End If
    End Select
End Sub
Private Sub SaveCollect()
    Dim strWorkNo As String
    Dim strKqDate As String
    Dim strKqTime As String
    
    With msfGrid
        strWorkNo = Trim(.TextMatrix(mRowBeforeSave, mGridWorkNo))
        strKqDate = Trim(.TextMatrix(mRowBeforeSave, mGridStartDate))
        strKqTime = Trim(.TextMatrix(mRowBeforeSave, mGridStartTime))
    
        If strKqDate = Empty Then
            MsgBox "考勤日期不能为空,请输入!!", vbInformation, gTitle
            .col = mGridStartDate
            SetMedPosition msfGrid, medDate, True
            Exit Sub
        End If
        
        If strKqTime = Empty Then
            MsgBox "考勤时间不能为空,请输入!!", vbInformation, gTitle
            .col = mGridStartTime
            SetMedPosition msfGrid, medTime, False
            Exit Sub
        End If
        
        On Error GoTo SaveErr
        Dim Sql As String
        Sql = "Insert into KqHistory (WorkNo,KqDate,KqTime,OperateTime) values('" _
            & strWorkNo & "','" & strKqDate & "','" _
            & strKqTime & "','" & Format(Date, "yyyy-mm-dd") & "')"
        gDataBase.Execute Sql
        msfGrid.Enabled = True
        cmdKq(gCMDAPPEND).Enabled = True
        cmdKq(gCMDSAVE).Enabled = False
    End With
    Exit Sub
SaveErr:
    MsgBox "保存未成功" & vbCrLf & Err.Description, vbExclamation, gTitle
    Err.Clear
End Sub

Private Sub medTime_LostFocus()
    medTime.Visible = False
End Sub

Private Sub mnuEditDelete_Click()
    cmdEdit_Click gCMDDELETE
End Sub

Private Sub mnuEditModify_Click()
    cmdEdit_Click gCMDEDIT
End Sub

Private Sub msfGrid_DblClick()
    If mStatus = gMAINCOLLECT Then
        With msfGrid
            Select Case .col
                Case mGridStartDate, mGridStartTime
                    mblnCollectModify = True
                    mOldKqDate = Trim(.TextMatrix(.row, mGridStartDate))
                    mOldKqTime = Trim(.TextMatrix(.row, mGridStartTime))
                    If .col = mGridStartDate Then
                        .col = mGridStartDate
                        SetMedPosition msfGrid, medDate, True
                        With medDate
                            .Mask = ""
                            .Text = mOldKqDate
                            .Mask = mDATEMASK
                        End With
                    Else
                        .col = mGridStartTime
                        SetMedPosition msfGrid, medTime, False
                        With medTime
                            .Mask = ""
                            .Text = mOldKqTime
                            .Mask = mTIMEMASK
                        End With
                    End If
            End Select
        End With
    End If
End Sub

Private Sub msfGrid_GotFocus()
    If msfGrid.Rows <= msfGrid.FixedRows Then Exit Sub
    If mStatus = gMAINCOLLECT Then
        cmdKq(gCMDEDIT).Enabled = True
        cmdKq(gCMDDELETE).Enabled = True
    Else
        If Not (mblnIsModify Or mblnIsAdd) Then
            RefreshBtnLocal True
        End If
    End If
End Sub

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

'Private Sub mnuPosDateSet_Click()
'    frmSetDate.Show 1
'End Sub

'Private Sub mnuQueryFlow_Click()
'    frmFlow.Show 0, Me
'End Sub

Private Sub msfGrid_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        If mStatus = gMAINCOLLECT Then
            msfGrid_DblClick
        End If
    End If
End Sub

'Pr