frmrili.frm

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

    With msfGrid
        .Rows = 7
        .Cols = 7
        .FixedRows = 1
        .FixedCols = 0
        .Height = 2406
        .Width = 4480
        .BackColorFixed = &HC0E0FF
        .BackColorSel = &H8000000D 'vbWhite
        .ForeColorSel = vbWhite
        .BackColorBkg = &H8000000E
        .ForeColorFixed = &HC0&      '&HFF&
        .FormatString = "^日" & vbTab _
                        & "^一" & vbTab _
                        & "^二" & vbTab _
                        & "^三" & vbTab _
                        & "^四" & vbTab _
                        & "^五" & vbTab _
                        & "^六" & vbTab
        Dim I As Integer
        For I = 0 To .Rows - 1
            If I = 0 Then
                .RowHeight(I) = 336
            Else
                .RowHeight(I) = 336
            End If
            
        Next
        For I = 0 To .Cols - 1
            .ColWidth(I) = 625
        Next
    End With
End Sub

'Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'    If UnloadMode = vbFormControlMenu Then
'        Select Case Trim(Me.Tag)
'            Case UCase("frmMain")
'                frmMain.mRetDate = getDate
'        End Select
'    End If
'End Sub

Private Sub msfGrid_Click()
    With msfGrid
        If Trim(.TextMatrix(.row, .col)) <> Empty Then
            mSelDate = Val(.TextMatrix(.row, .col))
        End If
    End With
End Sub


Private Sub RefreshDayList()
    Dim MaxDay As Integer
    Dim FirstWeekDay As Integer
    Dim DayRow As Integer
    Dim DayCol As Integer
    Dim I As Integer
    With msfGrid
        If Trim(txtYear) <> Empty And Trim(txtMonth) <> Empty Then
            MaxDay = GetMaxDayInAMonth(Val(txtYear), Val(txtMonth))
            FirstWeekDay = Weekday(DateSerial(Val(txtYear), Val(txtMonth), 1))
            DayRow = 1
            DayCol = FirstWeekDay - 1
            For I = 0 To DayCol - 1
                '.TextArray(DayRow * 7 + i) = ""
                .TextArray(faIndex(DayRow, I)) = ""
            Next I
            
            .Cols = 7
            .Rows = 7
            setGridText DayCol, 1, MaxDay, False, msfGrid
            setGridText DayCol, MaxDay + 1, (.Rows) * (.Cols - 1), True, msfGrid
            mCurDay = mSelDate ' Day(Date)
            If mCurDay > MaxDay Then
                mCurDay = MaxDay
            End If
            Dim myRow As Integer
            Dim myCol As Integer
            myCol = (DayCol + mCurDay) Mod .Cols
            myRow = ((DayCol + mCurDay) \ .Cols) + 1
            If myCol = 0 Then
                myCol = 6
                myRow = myRow - 1
            Else
                myCol = myCol - 1
                myRow = myRow
            End If
            If myRow > 0 Then
            If .Redraw Then .Redraw = False
            misRefresh = True
            mOldRow = myRow
            mOldCol = myCol
            .row = myRow
            .col = myCol
'            misRefresh = False
            If Not .Redraw Then .Redraw = True
            End If
        End If
    End With
End Sub

Private Sub setGridText(DayCol As Integer, StartDay As Integer, EndDay As Integer, isEmpty As Boolean, msfGrid As MSFlexGrid)
    Dim I As Integer
    Dim myRow As Integer
    Dim myCol As Integer
    With msfGrid
        For I = StartDay To EndDay
            myCol = (DayCol + I) Mod .Cols
            myRow = ((I + DayCol) \ .Cols) + 1
            If myRow > .Rows - 1 Then Exit For
            If myCol = 0 Then
                myCol = 6
                myRow = myRow - 1
            Else
                myCol = myCol - 1
                myRow = myRow
            End If
            Dim tmpStr As String
            If isEmpty Then
                tmpStr = Empty
            Else
                tmpStr = I
            End If
            .TextArray(faIndex(myRow, myCol)) = tmpStr
        Next
    End With
End Sub

Private Sub msfGrid_DblClick()
    Command1_Click
End Sub

Private Sub msfGrid_EnterCell()
    With msfGrid
        .CellBackColor = vbBlue
        .CellForeColor = vbWhite
    End With
End Sub

Private Sub msfGrid_GotFocus()
    misToCheckMouse = True
End Sub

Private Sub msfGrid_LeaveCell()
    With msfGrid
        .CellBackColor = vbWhite
        .CellForeColor = vbBlack
    End With
End Sub

Private Sub msfGrid_LostFocus()
    misToCheckMouse = False
    With msfGrid
        mOldRow = .row
        mOldCol = .col
    End With
    misRefresh = False
End Sub


Private Sub msfGrid_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msfGrid
        .row = .row
        .col = .col
        .RowSel = .row
        .ColSel = .col
    End With
End Sub


Private Sub msfGrid_SelChange()
    With msfGrid
        Dim myRow As Integer
        Dim myCol As Integer
        If Trim(.TextMatrix(.row, .col)) = Empty Then
            'If .Redraw Then .Redraw = False
            .row = mOldRow
            .col = mOldCol
            If .Redraw Then .Redraw = False
        Else
            'If Not .Redraw Then .Redraw = True
            mSelDate = Val(.TextMatrix(.row, .col))
        End If
        If misToCheckMouse Then
            myRow = .MouseRow
            myCol = .MouseCol
        Else
            If Not misRefresh Then
                myRow = mOldRow
                myCol = mOldCol
                .row = mOldRow
                .col = mOldCol
            Else
                myRow = .row
                myCol = .col
            End If
        End If
            If myRow = 0 Then 'Or Trim(.TextMatrix(myRow, myCol)) = Empty Then 'If .MouseRow = 0 Or Trim(.TextMatrix(.MouseRow, .MouseCol)) = Empty Then
                .row = mOldRow
                .col = mOldCol
                If .Redraw Then .Redraw = False
            Else
                mOldRow = .row
                mOldCol = .col
                If Not .Redraw Then .Redraw = True
            End If
    End With
End Sub

Private Sub txtMonth_Change()
   If Trim(txtMonth) = Empty Then Exit Sub
'    VScrollMonth.Value = Val(txtMonth.Text)
    If Not misStart Then
        RefreshDayList
    End If
End Sub

Private Sub txtMonth_GotFocus()
    GotFocus txtMonth
End Sub

Private Sub txtMonth_KeyDown(KeyCode As Integer, Shift As Integer)
    With VScrollMonth
        Select Case KeyCode
            Case 13
                If (Val(txtMonth) >= .Min) And (Val(txtMonth) <= .Max) Then
                    SendKeyTab KeyCode
                End If
            Case vbKeyUp
                If Val(txtMonth) < .Max Then txtMonth = Val(txtMonth) + 1
            Case vbKeyDown
                If Val(txtMonth) > .Min Then txtMonth = Val(txtMonth) - 1
        End Select
    End With
End Sub

Private Sub txtMonth_KeyPress(KeyAscii As Integer)
    KeyAscii = ValiText(KeyAscii, "123456789", True)
End Sub

Private Sub txtYear_Change()
    If Len(Trim(txtYear)) < 4 Then Exit Sub
'    VScrollYear.Value = Val(txtYear.Text)
    If Not misStart Then
        RefreshDayList
    End If
End Sub

Private Sub txtYear_GotFocus()
    GotFocus txtYear
End Sub

Private Sub txtYear_KeyDown(KeyCode As Integer, Shift As Integer)
    With VScrollYear
        Select Case KeyCode
            Case 13
                If (Val(txtYear) >= .Min) And (Val(txtYear) <= .Max) Then
                    SendKeyTab KeyCode
                End If
            Case vbKeyUp
                If Val(txtYear) < .Max Then txtYear = Val(txtYear) + 1
            Case vbKeyDown
                If Val(txtYear) > .Min Then txtYear = Val(txtYear) - 1
        End Select
    End With
End Sub

Private Sub txtYear_KeyPress(KeyAscii As Integer)
    KeyAscii = ValiText(KeyAscii, "0123456789", True)
End Sub

Private Sub VScrollMonth_Change()
'    txtMonth = VScrollMonth.Value
End Sub

Private Sub VScrollYear_Change()
'    txtYear = VScrollYear.Value
End Sub

Function faIndex(row As Integer, col As Integer) As Long
     faIndex = row * msfGrid.Cols + col
End Function