frmsetclassedit.frm

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

    cmbMonth.DropWidth = cmbTimeMode.Width \ 15
    
    Dim iMonth As Integer
    For iMonth = 1 To 31
        cmbMonth.AddString CStr(iMonth) + vbLf
    Next
    
'=================================Grid=================================
    Grid.ClearHeadData
    Grid.AddHeader "序号", "Serial", 40, -1, "Serial", False, sSerial
    Grid.AddHeader "开始日期", "BeginDate", 120, -1, "BeginDate", False, sDefault
    Grid.AddHeader "结束日期", "EndDate", 120, -1, "EndDate", False, sDefault
    Grid.AddHeader "时间模式", "TimeMode", 120, -1, "TimeMode", False, sDefault
    Grid.AddHeader "开始时间", "BeginTime", 120, -1, "BeginTime", False, sDefault
    Grid.AddHeader "结束时间", "EndTime", 120, -1, "EndTime", False, sDefault
    Grid.AddHeader "班次", "ClassName", 120, -1, "ClassName", False, sDefault
    
    Grid.EditHwnd(ComboBox) = cmbClass.hWnd
    Grid.EditHwnd(ComboBox2) = cmbTimeMode.hWnd
    Grid.EditHwnd(ComboBox3) = cmbWeek.hWnd
    Grid.EditHwnd(ComboBox4) = cmbMonth.hWnd
    Grid.EditHwnd(DTPicker) = dtpTime.hWnd
    
    cmbTimeMode.RelateHwnd = Grid.hWnd
    cmbClass.RelateHwnd = Grid.hWnd
    cmbWeek.RelateHwnd = Grid.hWnd
    cmbMonth.RelateHwnd = Grid.hWnd
    dtpTime.RelateHwnd = Grid.hWnd
    
    Grid.Col("BeginDate").EditType = DTPicker
    Grid.Col("EndDate").EditType = DTPicker
    
    Grid.Col("TimeMode").EditType = ComboBox2
'    Grid.Col("BeginTime").EditType = DTPicker
'    Grid.Col("EndTime").EditType = DTPicker
    Grid.Col("ClassName").EditType = ComboBox

    Grid.AllowAddNew = True
    Grid.AllowEdit = True
    Grid.MainCol = "BeginDate"
    
    txtName.MaxTextLen = 20
    
End Sub

Private Sub cmdNext_Click()
    If ChangedMsg = False Then Exit Sub
    If rstExec.State = 1 Then rstExec.Close
    Set rstExec = Nothing
    rstExec.CursorLocation = adUseClient
    rstExec.Open "select Top 1 * from ClassInfo where OnClassID>" & m_OnClassID & "    order by OnClassID ", con, adOpenStatic, adLockBatchOptimistic
    
    If rstExec.RecordCount < 1 Then Exit Sub
    EditBill (rstExec.Fields("OnClassID"))
    
End Sub

Private Sub cmdPrevious_Click()
    If ChangedMsg = False Then Exit Sub
    If rstExec.State = 1 Then rstExec.Close
    Set rstExec = Nothing
    rstExec.CursorLocation = adUseClient
    Debug.Print "select Top 1 * from ClassInfo where OnClassID<" & m_OnClassID & "   order by OnClassID   desc"
    rstExec.Open "select Top 1 * from ClassInfo where OnClassID<" & m_OnClassID & "   order by OnClassID   desc", con, adOpenStatic, adLockBatchOptimistic
    
    If rstExec.RecordCount < 1 Then Exit Sub
    EditBill (rstExec.Fields("OnClassID"))
    
End Sub

Public Sub AddBill()

    txtName.PutText ""
    txtName.SetFocus
    
    m_Edit = False
    m_Changed = False
    m_OnClassID = 0
    Me.Caption = "默认排班-新增"
    
    If rstGrid.State = 1 Then rstGrid.Close
    Set rstGrid = Nothing
    rstGrid.CursorLocation = adUseClient
    rstGrid.Open "select BeginDate,EndDate,TimeMode,BeginTime,EndTime,a.ClassID,b.ClassName from ClassInfo_D a" _
        & " left outer join Class b on a.ClassID=b.ClassID where a.OnClassID=0", con, adOpenStatic, adLockBatchOptimistic
    Set Grid.DataSource = rstGrid
    
End Sub

Public Sub EditBill(ByVal OnClassID As String)
    
    If rstExec.State = 1 Then rstExec.Close
    Set rstExec = Nothing
    rstExec.CursorLocation = adUseClient
    rstExec.Open "select * from ClassInfo where OnClassID=" & OnClassID, con, adOpenStatic, adLockBatchOptimistic
    
    If IsNull(rstExec.Fields("OnClassName")) Then txtName.Text = "" Else txtName.Text = rstExec.Fields("OnClassName")
    
    m_Edit = True
    m_Changed = False
    m_OnClassID = OnClassID
    Me.Caption = "默认排班-修改"
    
    If rstGrid.State = 1 Then rstGrid.Close
    Set rstGrid = Nothing
    rstGrid.CursorLocation = adUseClient
    rstGrid.Open "select BeginDate,EndDate,TimeMode,BeginTime,EndTime,a.ClassID,b.ClassName from ClassInfo_D a" _
        & " left outer join Class b on a.ClassID=b.ClassID where a.OnClassID=" & OnClassID, con, adOpenStatic, adLockBatchOptimistic
    Set Grid.DataSource = rstGrid
    
End Sub

Public Function SaveBill() As Boolean
On Error GoTo SaveErr

    SaveBill = False
    If Trim(txtName.Text) = "" Then
        Message "请输入名称!"
        txtName.SetFocus
        Exit Function
    End If
    
    If rstGrid.RecordCount < 1 Then
        Message "请输入时间明细!"
        Exit Function
    Else
        rstGrid.MoveFirst
        While Not rstGrid.EOF
            If Trim(rstGrid.Fields("BeginDate")) = "" _
                Or IsNull(rstGrid.Fields("BeginDate")) Then
                    Message "请输入开始日期!"
                    Exit Function
            End If
            If Trim(rstGrid.Fields("EndDate")) = "" _
                Or IsNull(rstGrid.Fields("EndDate")) Then
                    Message "请输入结束日期!"
                    Exit Function
            End If
            
            If CDate(rstGrid.Fields("BeginDate")) > CDate(rstGrid.Fields("EndDate")) Then
                    Message "结束日期不能比开始日期早!"
                    Exit Function
            End If
            
            If Trim(rstGrid.Fields("TimeMode")) = "" _
                Or IsNull(rstGrid.Fields("TimeMode")) Then
                    Message "请输入时间模式!"
                Exit Function
            End If
            
            If Trim(rstGrid.Fields("TimeMode")) <> "每天" Then
                If Trim(rstGrid.Fields("BeginTime")) = "" _
                    Or IsNull(rstGrid.Fields("BeginTime")) Then
                        Message "请输入开始时间!"
                    Exit Function
                End If
                If Trim(rstGrid.Fields("EndTime")) = "" _
                    Or IsNull(rstGrid.Fields("EndTime")) Then
                        Message "请输入结束时间!"
                    Exit Function
                End If
                
                If Val(rstGrid.Fields("BeginTime")) > Val(rstGrid.Fields("EndTime")) Then
                    Message "结束时间不能比开始时间早!"
                    Exit Function
                End If
                
            End If
            
            If Trim(rstGrid.Fields("ClassID")) = "" _
                Or IsNull(rstGrid.Fields("ClassID")) Then
                    Message "请输入班次!"
                Exit Function
            End If
            rstGrid.MoveNext
        Wend
    End If
    

    Dim lTrans As Long
    
    If m_Edit = False Then
        
        If rstExec.State = 1 Then rstExec.Close
        Set rstExec = Nothing
        rstExec.CursorLocation = adUseClient
        rstExec.Open "select * from ClassInfo where OnClassName='" & Trim(txtName.Text) & "'", con, adOpenStatic, adLockBatchOptimistic
        If rstExec.RecordCount > 0 Then
            Message "该默认班次名称已存在!"
            Exit Function
        End If
        
        rstExec.AddNew
        rstExec.Fields("OnClassName") = Trim(txtName.Text)
        rstExec.UpdateBatch
        
        If rstExec.State = 1 Then rstExec.Close
        Set rstExec = Nothing
        rstExec.CursorLocation = adUseClient
        rstExec.Open "select * from ClassInfo where OnClassName='" & Trim(txtName.Text) & "'", con, adOpenStatic, adLockBatchOptimistic
        If rstExec.RecordCount = 0 Then
            Message "新增出错!"
            Exit Function
        Else
            m_OnClassID = rstExec.Fields("OnClassID")
        End If
        
        con.BeginTrans
        lTrans = 1
    
    Else
        con.BeginTrans
        lTrans = 1
        If rstExec.State = 1 Then rstExec.Close
        Set rstExec = Nothing
        rstExec.CursorLocation = adUseClient
        rstExec.Open "select * from ClassInfo where OnClassID= " & m_OnClassID, con, adOpenStatic, adLockBatchOptimistic
        If rstExec.RecordCount = 0 Then
            Message "记录不存在!"
            Exit Function
        End If
        rstExec.Fields("OnClassName") = Trim(txtName.Text)
        rstExec.UpdateBatch
        
    End If
    
    con.Execute "delete from ClassInfo_D where OnClassID=" & m_OnClassID

    Dim strSQL As String
    Dim lItemNO As Long
    If rstGrid.RecordCount > 0 Then
        rstGrid.MoveFirst
        While Not rstGrid.EOF
            lItemNO = lItemNO + 1
            strSQL = "insert into ClassInfo_D(OnClassID,ItemNo,BeginDate,EndDate,TimeMode,BeginTime, " _
                & "EndTime,ClassID) Values( " _
                & m_OnClassID _
                & "," & lItemNO _
                & ",'" & rstGrid.Fields("BeginDate") _
                & "','" & rstGrid.Fields("EndDate") _
                & "','" & rstGrid.Fields("TimeMode") _
                & "','" & rstGrid.Fields("BeginTime") _
                & "','" & rstGrid.Fields("EndTime") _
                & "','" & rstGrid.Fields("ClassID") & "')"
            
            Debug.Print strSQL
            con.Execute strSQL
            rstGrid.MoveNext
        Wend
    End If
    
    If FindWindow("frmSetClass") = True Then frmSetClass.RefreshBill
    SaveBill = True
    m_Changed = False
    con.CommitTrans
    lTrans = 2

    Exit Function

SaveErr:
    If lTrans = 1 Then con.RollbackTrans
    ErrMsg
End Function

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

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

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

Public Sub DelRecord()
    Grid.Delete
    m_Changed = True
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 Form_Unload(Cancel As Integer)
    If rstGrid.State = 1 Then rstGrid.Close
    Set rstGrid = Nothing
    If rstExec.State = 1 Then rstExec.Close
    Set rstExec = Nothing
End Sub

Private Sub cmbTimeMode_Selected()

On Error Resume Next


    
    If Trim(cmbTimeMode.Text) = "每周" Then
        Grid.Col("BeginTime").EditType = ComboBox3
        Grid.Col("EndTime").EditType = ComboBox3
        If Weekday(Date) = 1 Then
            rstGrid.Fields("BeginTime") = "7"
            rstGrid.Fields("EndTime") = "7"
        Else
            rstGrid.Fields("BeginTime") = CStr(Weekday(Date) - 1)
            rstGrid.Fields("EndTime") = CStr(Weekday(Date) - 1)
        End If
        
    ElseIf Trim(cmbTimeMode.Text) = "每月" Then
        Grid.Col("BeginTime").EditType = ComboBox4
        Grid.Col("EndTime").EditType = ComboBox4
        rstGrid.Fields("BeginTime") = Day(Date)
        rstGrid.Fields("EndTime") = Day(Date)
        
    ElseIf Trim(cmbTimeMode.Text) = "每天" Then
        Grid.Col("BeginTime").EditType = OtherHwnd
        Grid.Col("EndTime").EditType = OtherHwnd
        rstGrid.Fields("BeginTime") = ""
        rstGrid.Fields("EndTime") = ""
        
    End If
    
    rstGrid.Update
    Grid.Refresh
    
End Sub

Private Sub Grid_AfterColEdit(ByVal ColIndex As Long)
    If Grid.IsInNewRow Then
        rstGrid.AddNew
        rstGrid.Fields("BeginDate") = Format(dtpTime.Value, "yyyy-mm-dd")
        rstGrid.Update
        Grid.RefreshNew
    End If
    m_Changed = True
End Sub

Private Sub Grid_BeforeRowChange(ByVal NewRow As Long, Cancel As Long)
On Error Resume Next
    If Grid.FieldByKey(NewRow, "TimeMode") = "每周" Then
        Grid.Col("BeginTime").EditType = ComboBox3
        Grid.Col("EndTime").EditType = ComboBox3
        
    ElseIf Grid.FieldByKey(NewRow, "TimeMode") = "每月" Then
        Grid.Col("BeginTime").EditType = ComboBox4
        Grid.Col("EndTime").EditType = ComboBox4

    ElseIf Grid.FieldByKey(NewRow, "TimeMode") = "每天" Then
        Grid.Col("BeginTime").EditType = OtherHwnd
        Grid.Col("EndTime").EditType = OtherHwnd
    End If
End Sub

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


Private Sub txtName_Change()
    m_Changed = True
End Sub