frmadds.frm

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

      ForeColor       =   &H00C00000&
      Height          =   210
      Index           =   7
      Left            =   375
      TabIndex        =   8
      Top             =   1665
      Width           =   315
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "A段"
      ForeColor       =   &H00C00000&
      Height          =   210
      Index           =   6
      Left            =   375
      TabIndex        =   7
      Top             =   915
      Width           =   315
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "考勤方式"
      ForeColor       =   &H00C00000&
      Height          =   210
      Index           =   5
      Left            =   7815
      TabIndex        =   6
      Top             =   285
      Width           =   840
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "考勤与否"
      ForeColor       =   &H00C00000&
      Height          =   210
      Index           =   4
      Left            =   6420
      TabIndex        =   5
      Top             =   285
      Width           =   840
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "下班时间"
      ForeColor       =   &H00C00000&
      Height          =   210
      Index           =   3
      Left            =   4755
      TabIndex        =   4
      Top             =   285
      Width           =   840
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "考勤与否"
      ForeColor       =   &H00C00000&
      Height          =   210
      Index           =   2
      Left            =   3195
      TabIndex        =   3
      Top             =   285
      Width           =   840
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "上班时间"
      ForeColor       =   &H00C00000&
      Height          =   210
      Index           =   1
      Left            =   1470
      TabIndex        =   2
      Top             =   285
      Width           =   840
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "段号"
      ForeColor       =   &H00C00000&
      Height          =   210
      Index           =   0
      Left            =   375
      TabIndex        =   1
      Top             =   285
      Width           =   420
   End
End
Attribute VB_Name = "frmAddS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const mStandard = "标准"
Const mAdd = "加班"
'Const mIntStandard = 0
'Const mIntAdd = 1
Const mMsg1 = "班次名称不能为空!请输入."
Const mMsg2 = "上班时间不能大于或等于下班时间"
Const mMsg3 = "时间段之间不能有交叉,请您仔细检查一下!"
Const mMsg4 = "该班次名称已经存在,请您换个名称!"
Const mMsg5 = "数据保存未成功，请您检查一下有关数据后再试！"
Const mMsg6 = "恭喜您,数据保存成功!"
Const mMsg7 = "上下班时间要求同时为空或同时不为空"
Const mMsg8 = "因该时间段没有要求考勤,所以不能选考勤方式."
Const mMsg9 = "班次不能超过30个,保存未成功."
Public mShiftID As Integer
Public mIsModify As Boolean


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

Private Sub cboMethod_LostFocus(Index As Integer)
    Dim Int1 As Integer
    Dim Int2 As Integer
    Int1 = Index * 2
    Int2 = Int1 + 1
    If (chkDate(Int1).Value = 0) And (chkDate(Int2).Value = 0) Then
        If Trim(cboMethod(Index).Text) <> Empty Then
            MsgBox mMsg8, vbInformation, gTitle
            cboMethod(Index).ListIndex = -1
        End If
    End If
End Sub

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

Private Sub Command1_Click(Index As Integer)
    With frmShift
        .mIsToRefresh = False
        Select Case Index
            Case 0
                If CheckData Then
                    SaveData
                    .mIsToRefresh = True
                    Unload Me
                End If
            Case 1
                Unload Me
        End Select
    End With
End Sub

Private Function SaveData() As Boolean
    Dim Rst As Recordset
    Dim ShiftCount As Integer
    Set Rst = gDataBase.OpenRecordset("Shift")
    Rst.MoveLast
    Rst.MoveFirst
    ShiftCount = Rst.RecordCount
    If ShiftCount > 30 Then
        MsgBox mMsg9, vbInformation, gTitle
        Rst.Close
        Set Rst = Nothing
        SaveData = False
        Exit Function
    End If
    Rst.Close
    Set Rst = Nothing
    
    Dim ShiftName As String
    Dim OneOn As String
    Dim OneOnIsKq As Integer
    Dim OneOff As String
    Dim OneOffIsKq As Integer
    Dim OneIsAdd As Integer
    
    Dim TwoOn As String
    Dim TwoOnIsKq As Integer
    Dim TwoOff As String
    Dim TwoOffIsKq As Integer
    Dim TwoIsAdd As Integer
    
    Dim ThreeOn As String
    Dim ThreeOnIsKq As Integer
    Dim ThreeOff As String
    Dim ThreeOffIsKq As Integer
    Dim ThreeIsAdd As Integer
    
    Dim FourOn As String
    Dim FourOnIsKq As Integer
    Dim FourOff As String
    Dim FourOffIsKq As Integer
    Dim FourIsAdd As Integer
    
    ShiftName = Trim(txtShift(0))
    OneOn = IIf(Trim(txtDate(0)) = Empty, " ", _
        Format(Val(Trim(txtDate(0))), "00") & ":" _
        & Format(Val(IIf((Trim(txtDate(1)) = Empty), _
        "0", Trim(txtDate(1)))), "00"))
    OneOff = IIf(Trim(txtDate(2)) = Empty, " ", _
        Format(Val(Trim(txtDate(2))), "00") & ":" _
        & Format(Val(IIf((Trim(txtDate(3)) = Empty), _
        "0", Trim(txtDate(3)))), "00"))
    OneOnIsKq = IIf((chkDate(0).Value = 1), -1, 0)
    OneOffIsKq = IIf((chkDate(1).Value = 1), -1, 0)
    OneIsAdd = IIf((cboMethod(0).Text = mAdd), -1, 0)
    
    TwoOn = IIf(Trim(txtDate(4)) = Empty, " ", _
        Format(Val(Trim(txtDate(4))), "00") & ":" _
        & Format(Val(IIf((Trim(txtDate(5)) = Empty), _
        "0", Trim(txtDate(5)))), "00"))
    TwoOff = IIf(Trim(txtDate(6)) = Empty, " ", _
        Format(Val(Trim(txtDate(6))), "00") & ":" _
        & Format(Val(IIf((Trim(txtDate(7)) = Empty), _
        "0", Trim(txtDate(7)))), "00"))
    TwoOnIsKq = IIf((chkDate(2).Value = 1), -1, 0)
    TwoOffIsKq = IIf((chkDate(3).Value = 1), -1, 0)
    TwoIsAdd = IIf((cboMethod(1).Text = mAdd), -1, 0)
    
    ThreeOn = IIf(Trim(txtDate(8)) = Empty, " ", _
        Format(Val(Trim(txtDate(8))), "00") & ":" _
        & Format(Val(IIf((Trim(txtDate(9)) = Empty), _
        "0", Trim(txtDate(9)))), "00"))
    ThreeOff = IIf(Trim(txtDate(10)) = Empty, " ", _
        Format(Val(Trim(txtDate(10))), "00") & ":" _
        & Format(Val(IIf((Trim(txtDate(11)) = Empty), _
        "0", Trim(txtDate(11)))), "00"))
    ThreeOnIsKq = IIf((chkDate(4).Value = 1), -1, 0)
    ThreeOffIsKq = IIf((chkDate(5).Value = 1), -1, 0)
    ThreeIsAdd = IIf((cboMethod(2).Text = mAdd), -1, 0)
    
    FourOn = IIf(Trim(txtDate(12)) = Empty, " ", _
        Format(Val(Trim(txtDate(12))), "00") & ":" _
        & Format(Val(IIf((Trim(txtDate(13)) = Empty), _
        "0", Trim(txtDate(13)))), "00"))
    FourOff = IIf(Trim(txtDate(14)) = Empty, " ", _
        Format(Val(Trim(txtDate(14))), "00") & ":" _
        & Format(Val(IIf((Trim(txtDate(15)) = Empty), _
        "0", Trim(txtDate(15)))), "00"))
    FourOnIsKq = IIf((chkDate(6).Value = 1), -1, 0)
    FourOffIsKq = IIf((chkDate(7).Value = 1), -1, 0)
    FourIsAdd = IIf((cboMethod(3).Text = mAdd), -1, 0)
    
    Dim Sql As String
    Dim ShiftID As Byte
    If Not mIsModify Then
        
        Sql = "select top 1 ID from Shift order by ID DESC"
        Set Rst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
        If Rst.RecordCount > 0 Then
            ShiftID = Trim(Rst!ID) + 1
        Else
            ShiftID = UBound(aInnerShift) + 1
        End If
        Rst.Close
        Set Rst = Nothing
        Sql = "Insert into Shift (ID,ShiftName," _
            & "F_1On,F_1OnIsKq,F_1Off,F_1OffIsKq,F_1IsAdd," _
            & "F_2On,F_2OnIsKq,F_2Off,F_2OffIsKq,F_2IsAdd," _
            & "F_3On,F_3OnIsKq,F_3Off,F_3OffIsKq,F_3IsAdd," _
            & "F_4On,F_4OnIsKq,F_4Off,F_4OffIsKq,F_4IsAdd)" _
            & " values(" & ShiftID & ",'" & ShiftName & "','" _
            & OneOn & "'," & OneOnIsKq & ",'" _
            & OneOff & "'," & OneOffIsKq & "," & OneIsAdd & ",'" _
            & TwoOn & "'," & TwoOnIsKq & ",'" & TwoOff & "'," _
            & TwoOffIsKq & "," & TwoIsAdd & ",'" _
            & ThreeOn & "'," & ThreeOnIsKq & ",'" _
            & ThreeOff & "'," & ThreeOffIsKq & "," & ThreeIsAdd & ",'" _
            & FourOn & "'," & FourOnIsKq & ",'" _
            & FourOff & "'," & FourOffIsKq & "," & FourIsAdd & ")"
    Else
        'ShiftID = mShiftID
        Sql = "Update Shift set ShiftName='" & ShiftName & "'" & _
            ",F_1On='" & OneOn & "',F_1OnIsKq=" & OneOnIsKq & _
            ",F_1Off='" & OneOff & "',F_1OffIsKq=" & OneOffIsKq & _
            ",F_1IsAdd=" & OneIsAdd & _
            ",F_2On='" & TwoOn & "',F_2OnIsKq=" & TwoOnIsKq & _
            ",F_2Off='" & TwoOff & "',F_2OffIsKq=" & TwoOffIsKq & _
            ",F_2IsAdd=" & TwoIsAdd & _
            ",F_3On='" & ThreeOn & "',F_3OnIsKq=" & ThreeOnIsKq & _
            ",F_3Off='" & ThreeOff & "',F_3OffIsKq=" & ThreeOffIsKq & _
            ",F_3IsAdd=" & ThreeIsAdd & _
            ",F_4On='" & FourOn & "',F_4OnIsKq=" & FourOnIsKq & _
            ",F_4Off='" & FourOff & "',F_4OffIsKq=" & FourOffIsKq & _
            ",F_4IsAdd=" & FourIsAdd & _
            " where ID=" & mShiftID

    End If
    
    gDataBase.Execute Sql
    If gDataBase.RecordsAffected = 0 Then
        MsgBox mMsg5, vbInformation, gTitle
        SaveData = False
        Exit Function
    End If
    SaveData = True
    MsgBox mMsg6, vbInformation, gTitle
End Function

Private Function CheckData() As Boolean
    If Trim(txtShift(0)) = Empty Then
        MsgBox mMsg1, vbInformation, gTitle
        CheckData = False
        txtShift(0).SetFocus
        Exit Function
    End If
    
    
    Dim StartI As Integer
    Dim I As Integer
    Dim Str1 As String
    Dim Str2 As String
    Dim Str3 As String
    Dim Str4 As String
    For I = 0 To 3
        StartI = I * 4
        Str1 = Format(Trim(txtDate(StartI + 2)), "00")
        Str2 = Format(Trim(txtDate(StartI + 3)), "00")
        Str3 = Format(Trim(txtDate(StartI + 0)), "00")
        Str4 = Format(Trim(txtDate(StartI + 1)), "00")
        If ((Str1 & Str2 <> Empty) And (Str3 & Str4 = Empty)) _
            Or ((Str1 & Str2 = Empty) And (Str3 & Str4 <> Empty)) Then
            MsgBox mMsg7, vbInformation, gTitle
            CheckData = False
            txtDate(StartI).SetFocus
            Exit Function
        End If
        If Str1 & Str2 < Str3 & Str4 Then
            MsgBox mMsg2, vbInformation, gTitle
            CheckData = False
            txtDate(StartI).SetFocus
            Exit Function
        End If
    Next
    
    For I = 1 To 3
        StartI = I * 4
        If (Trim(txtDate(StartI + 0)) & Trim(txtDate(StartI + 1))) _
            >= (Trim(txtDate(0)) & Trim(txtDate(1))) _
            And (Trim(txtDate(StartI + 0)) & Trim(txtDate(StartI + 1))) _
            <= (Trim(txtDate(2)) & Trim(txtDate(3))) Then
            MsgBox mMsg3, vbInformation, gTitle
            CheckData = False
            txtDate(StartI).SetFocus
            Exit Function
        End If
    Next
    
'    For I = 0 To 3
'
'    Next
    
    If Not mIsModify Then
        Dim Rst As Recordset
        Set Rst = gDataBase.OpenRecordset("select * from Shift " _
            & " Where ShiftName='" & Trim(txtShift(0)) & "'", dbOpenSnapshot)
        If Rst.RecordCount > 0 Then
            MsgBox mMsg4, vbInformation, gTitle
            CheckData = False
            Rst.Close
            Set Rst = Nothing
            Exit Function
        End If
        Rst.Close
        Set Rst = Nothing
    End If
    
    CheckData = True
End Function

Private Sub Form_Load()
    Dim I As Integer
    
    For I = 0 To cboMethod.Count - 1
        With cboMethod(I)
            .Clear
            .AddItem mStandard
'            .ItemData(.NewIndex) = mIntStandard
            .AddItem mAdd
'            .ItemData(.NewIndex) = mIntAdd
'            .ListIndex = 0
        End With
    Next
'    For i = 0 To txtDate.Count - 1
'        Select Case i Mod 4
'            Case 0
'                txtDate(i) = 8
'            Case 1
'                txtDate(i) = 0
'            Case 2
'                txtDate(i) = 11
'            Case 3
'                txtDate(i) = 30
'        End Select
'    Next
End Sub

Private Sub txtDate_Change(Index As Integer)
    Dim I As Integer
    Dim isToSave As Boolean
    For I = 0 To txtDate.Count - 1
        If Trim(txtDate(I)) <> Empty Then
            isToSave = True
            Exit For
        End If
    Next
    Command1(0).Enabled = isToSave
End Sub

Private Sub txtDate_GotFocus(Index As Integer)
    GotFocus txtDate(Index)
End Sub

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

Private Sub txtDate_LostFocus(Index As Integer)
    Dim isToCheck As Boolean
    isToCheck = True
    If Val(txtDate(Index)) < 0 Then
        txtDate(Index) = 0
        isToCheck = False
    End If
    
    If isToCheck Then
        Select Case (Index Mod 2)
            Case 0
                If Val(txtDate(Index)) > 23 Then txtDate(Index) = 23
            Case 1
                If Val(txtDate(Index)) > 59 Then txtDate(Index) = 59
        End Select
    End If
End Sub

Private Sub txtShift_GotFocus(Index As Integer)
    GotFocus txtShift(Index)
End Sub

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

'Private Sub updDate_DownClick(Index As Integer)
'    txtDate(Index) = updDate(Index).Value
'End Sub
'
'Private Sub updDate_UpClick(Index As Integer)
'    txtDate(Index) = updDate(Index).Value
'End Sub
Private Sub txtShift_KeyPress(Index As Integer, KeyAscii As Integer)
    KeyAscii = KeyFilter(KeyAscii, False)
End Sub