frmclassedit.frm

考勤机管理软件,用于统计某段时间某个部门或者某个员工在某段内迟到与早退次数.

    Set Grid.DataSource = recGrid
    
    m_ClassID = ClassID
    m_Edit = True
    m_Changed = False
End Sub

Private Function Compare() As Boolean
    Dim lCount As Long
    Dim i As Long
    Dim tmps As String
    Dim tmps1 As String
    Dim iValue As Long
    
    ReDim ClassInfo(0)

    lCount = recGrid.RecordCount
    If lCount > 0 Then
    
        ReDim ClassInfo(1 To lCount) As ClassType
        blnClassInfo = True
        
        recGrid.MoveFirst
        For i = 1 To lCount

            
            tmps = recGrid!OnDutyTime
            tmps1 = Split(tmps, ":")(0)
            iValue = Val(tmps1)
            tmps1 = Split(tmps, ":")(1)
            iValue = Val(tmps1) + iValue * 60
            ClassInfo(i).InTime = iValue
            
            tmps = recGrid!OffDutyTime
            tmps1 = Split(tmps, ":")(0)
            iValue = Val(tmps1)
            tmps1 = Split(tmps, ":")(1)
            iValue = Val(tmps1) + iValue * 60
            ClassInfo(i).OutTime = iValue
    
            recGrid.MoveNext
        Next
        
    End If
    
    Dim lRow As Long
    Dim lNext As Long
    Dim tmpbtime As String
    Dim tmpetime As String
    

    For lRow = 1 To lCount - 1
        For lNext = lRow + 1 To lCount

            If ClassInfo(lRow).InTime > ClassInfo(lNext).InTime Then

                tmpbtime = ClassInfo(lRow).InTime
                tmpetime = ClassInfo(lRow).OutTime
                
                ClassInfo(lRow).InTime = ClassInfo(lNext).InTime
                ClassInfo(lRow).OutTime = ClassInfo(lNext).OutTime
                
                ClassInfo(lNext).InTime = tmpbtime
                ClassInfo(lNext).OutTime = tmpetime

            End If

        Next
    Next
    
    For lRow = 1 To lCount
        If lRow + 1 <= lCount Then
            If ClassInfo(lRow + 1).InTime <= ClassInfo(lRow).OutTime Then
                Exit Function
            End If
        End If
    Next
    Compare = True
End Function




Public Function SaveBill() As Boolean
On Error GoTo SaveErr

    SaveBill = False
    If Len(txtName.Text) = 0 Then
        Message "请输入名称!"
        Exit Function
    End If
        
    Dim tmpi As Long
    Dim tmpj As Long
    Dim tmpx As Long

    If recGrid.RecordCount < 1 Then
        Message "请输入时间明细!"
        Exit Function
    Else
        recGrid.MoveFirst
        While Not recGrid.EOF
            If Trim(recGrid.Fields("OnDutyTime")) = "" _
                Or IsNull(recGrid.Fields("OnDutyTime")) Then
                    Message "请输入上班时间!"
                Exit Function
            End If
            If Trim(recGrid.Fields("OffDutyTime")) = "" _
                Or IsNull(recGrid.Fields("OffDutyTime")) Then
                    Message "请输入下班时间!"
                Exit Function
            End If
            
            tmpi = Val(Split(recGrid.Fields("OnDutyTime"), ":")(0)) * 60 + Val(Split(recGrid.Fields("OnDutyTime"), ":")(1))
            tmpj = Val(Split(recGrid.Fields("OffDutyTime"), ":")(0)) * 60 + Val(Split(recGrid.Fields("OffDutyTime"), ":")(1))
            If tmpj <= tmpi Then
                Message "下班时间不能比上班时间早或相等!"
                Exit Function
            End If
            
            

            
'            If tmpx <> 0 Then
'                If tmpi <= tmpx Then
'                    Message "上班时间不能比上次下班时间早或相等!"
'                    Exit Function
'                End If
'            End If
'
'            tmpx = tmpj

            recGrid.MoveNext
        Wend
        If Compare = False Then
            Message "上班时间与下班时间之间有重叠,请检查!"
            Exit Function
        End If
        
        
    End If
    
    
    Dim i As Integer
    Dim recDetail As New ADODB.Recordset
    
    If m_Edit = False Then
    
        If recExec.State = 1 Then recExec.Close
        Set recExec = Nothing
        recExec.CursorLocation = adUseClient
        recExec.Open "select * from Class where ClassName='" & txtName.Text & "'", con, adOpenStatic, adLockOptimistic
        If recExec.RecordCount > 0 Then
            Message "该班次名称已存在!"
            Exit Function
        End If
        
        recExec.AddNew
        recExec.Fields("ClassName") = txtName.Text
        recExec.Update
        
        If recExec.State = 1 Then recExec.Close
        Set recExec = Nothing
        recExec.CursorLocation = adUseClient
        recExec.Open "select * from Class where ClassName='" & txtName.Text & "'", con, adOpenStatic, adLockOptimistic
        
        If recExec.RecordCount > 0 Then m_ClassID = recExec.Fields("ClassID")
        
        con.BeginTrans
        i = 1
   
    Else
    
        If recExec.State = 1 Then recExec.Close
        Set recExec = Nothing
        recExec.CursorLocation = adUseClient
        recExec.Open "select * from Class where ClassID=" & m_ClassID, con, adOpenStatic, adLockBatchOptimistic
        If recExec.RecordCount < 1 Then
            Message "该记录已被删除!"
            Exit Function
        End If
        
        recExec.Fields("ClassName") = txtName.Text
        
        con.BeginTrans
        i = 1
        recExec.UpdateBatch
        
    End If
        
    If recDetail.State = 1 Then recDetail.Close
    Set recDetail = Nothing
    recDetail.CursorLocation = adUseClient
    recDetail.Open "select * from Class_D where ClassID= " & m_ClassID, con, adOpenStatic, adLockBatchOptimistic
    
    If recDetail.RecordCount > 0 Then con.Execute "delete from Class_D where ClassID=" & m_ClassID
    
    If recGrid.RecordCount > 0 Then recGrid.MoveFirst
    Dim j As Integer
    Do While Not recGrid.EOF
        recDetail.AddNew
        j = j + 1
        recDetail.Fields("ClassID") = m_ClassID
        recDetail.Fields("ItemNo") = j
        recDetail.Fields("OnDutyTime") = recGrid.Fields("OnDutyTime")
        recDetail.Fields("OffDutyTime") = recGrid.Fields("OffDutyTime")
        recDetail.Update
        recGrid.MoveNext
    Loop
    
    recDetail.UpdateBatch
    con.CommitTrans
    i = 2
        
    If FindWindow("frmClass") = True Then frmClass.RefreshBill
    SaveBill = True
    m_Changed = False
    Exit Function

SaveErr:
    If i = 1 Then con.RollbackTrans
    If m_Edit = False Then con.Execute "delete from Class where ClassID=" & m_ClassID
       
    ErrMsg

End Function

Public Sub DelRecord()
    
    Grid.Delete
    m_Changed = True
End Sub


Private Sub cmdPrevious_Click()

    If ChangedMsg = False Then Exit Sub

    If recExec.State = 1 Then recExec.Close
    Set recExec = Nothing
    recExec.CursorLocation = adUseClient
    recExec.Open "select  top 1 * from Class where ClassID<" & m_ClassID & "   order by ClassID   desc", con, adOpenStatic, adLockBatchOptimistic
    
    If recExec.RecordCount < 1 Then
'        Message "该单已是最后单!"
        Exit Sub
    End If
        
    EditBill (recExec.Fields("ClassID"))
End Sub

Private Sub cmdNext_Click()
    If ChangedMsg = False Then Exit Sub

    If recExec.State = 1 Then recExec.Close
    Set recExec = Nothing
    recExec.CursorLocation = adUseClient
    recExec.Open "select top 1 * from Class where ClassID>" & m_ClassID & "   order by ClassID ", con, adOpenStatic, adLockBatchOptimistic
    
    If recExec.RecordCount < 1 Then
'        Message "该单已是最后单!"
        Exit Sub
    End If
        
    EditBill (recExec.Fields("ClassID"))
End Sub

Private Sub cmdSaveNew_Click()
    If SaveBill = False Then Exit Sub
    AddBill
    
End Sub

Private Sub cmdSaveExit_Click()
    If SaveBill = False Then Exit Sub
    Unload Me
    
End Sub

Private Sub cmdExit_Click()
    m_Changed = False
    Unload Me
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    Dim l As Long
    If m_Changed = True Then l = ChangedBox("记录已更改,是否保存?")
    If l = vbYes Then
        If SaveBill = False Then Cancel = 1
    ElseIf l = vbNo Then
        Cancel = 0
    ElseIf l = vbCancel Then
        Cancel = 1
    End If
    
End Sub

Private Sub Grid_AfterColEdit(ByVal ColIndex As Long)

    If Grid.IsInNewRow Then
        recGrid.AddNew
        recGrid.Fields("OnDutyTime") = txt.Text
        recGrid.Update
        Grid.RefreshNew
    End If
    m_Changed = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If recGrid.State = 1 Then recGrid.Close
    Set recGrid = Nothing
    If recExec.State = 1 Then recExec.Close
    Set recExec = Nothing
End Sub



Private Sub Grid_RButtonUp(ByVal Area As SSUPERGRIDLib.sArea, ByVal X As Long, ByVal Y As Long)
    If Area = sRowArea Then
        Set iFrom = Me
        Me.PopupMenu MNU.mnuClassEdit
    End If
End Sub

Private Sub txtName_Change()
    m_Changed = True
End Sub