frmleaveedit.frm

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

    Me.Icon = MDI.Icon

    Set cmdPrevious.PictureNormal = MDI.Image.ListImages.Item("Previous").Picture
    Set cmdNext.PictureNormal = MDI.Image.ListImages.Item("Next").Picture
    Set cmdSaveExit.PictureNormal = MDI.Image.ListImages.Item("SaveExit").Picture
    Set cmdExit.PictureNormal = MDI.Image.ListImages.Item("Exit").Picture
    Set cmdSaveNew.PictureNormal = MDI.Image.ListImages.Item("SaveNew").Picture
    
'=====================cmbTimePos=======================================
    cmbTimePos.ShowHeadScale = "0,20"
    cmbTimePos.ShowHeadValue = "DataID,时间模式"
    cmbTimePos.ShowIndex = 1
    cmbTimePos.Type = tNormal
    cmbTimePos.SetBtns "查看"
    cmbTimePos.ButtonHeight = 20
    cmbTimePos.DropWidth = cmbTimePos.Width \ 15
    
    Dim lRow As Long
    Dim lRowCount As Long
    
    lRowCount = GetTimePosCount
    For lRow = 1 To lRowCount
        cmbTimePos.AddString "时间段" & CStr(lRow) + vbLf
    Next
    cmbTimePos.AddString "全天" + vbLf
    
'=======================cmbTimeMode=========================================
    cmbTimeMode.ShowHeadScale = "0,20"
    cmbTimeMode.ShowHeadValue = "DataID,时间模式"
    cmbTimeMode.ShowIndex = 1
    cmbTimeMode.Type = tNormal
    cmbTimeMode.DropWidth = cmbTimeMode.Width \ 15
    
    cmbTimeMode.AddString "每天" + vbLf
    cmbTimeMode.AddString "每周" + vbLf
    cmbTimeMode.AddString "每月" + vbLf
    
'====================cmbWeek=================================
    
    cmbWeek.ShowHeadScale = "0,20"
    cmbWeek.ShowHeadValue = "DataID,星期几"
    cmbWeek.ShowIndex = 1
    cmbWeek.Type = tNormal
    cmbWeek.DropWidth = cmbTimeMode.Width \ 15
    
    Dim iWeek As Integer
    For iWeek = 1 To 7
        cmbWeek.AddString CStr(iWeek) + vbLf
    Next
    
'=======================cmbMonth===================================
    cmbMonth.ShowHeadScale = "0,20"
    cmbMonth.ShowHeadValue = "DataID,日"
    cmbMonth.ShowIndex = 1
    cmbMonth.Type = tNormal
    cmbMonth.DropWidth = cmbTimeMode.Width \ 15
    
    Dim iMonth As Integer
    For iMonth = 1 To 31
        cmbMonth.AddString CStr(iMonth) + vbLf
    Next
    
 
'=====================cmbEmployee=====================================

    cmbEmployee.ShowHeadScale = "0,20,20,20"
    cmbEmployee.ShowHeadValue = "EmployeeID,编号,名称,卡号"
    cmbEmployee.ShowIndex = 2
    cmbEmployee.Type = tStatic
    cmbEmployee.SetBtns "刷新"
    cmbEmployee.ButtonHeight = 20
'    cmbEmployee.DropWidth = cmbEmployee.Width \ 15
    cmbEmployee.DataSource = bufEmployee
    
    
    
    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 "时间段", "TimePos", 120, -1, "TimePos", False, sDefault
    
'    Grid.EditHwnd(DTPicker) = dtpTime.hWnd
    Grid.EditHwnd(ComboBox) = cmbTimePos.hWnd

'    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
    Grid.EditHwnd(TextBox) = txt.hWnd

    
'    dtpTime.RelateHwnd = Grid.hWnd
    cmbTimePos.RelateHwnd = Grid.hWnd

    cmbTimeMode.RelateHwnd = Grid.hWnd
'    cmbClass.RelateHwnd = Grid.hWnd
    cmbWeek.RelateHwnd = Grid.hWnd
    cmbMonth.RelateHwnd = Grid.hWnd
    txt.RelateHwnd = Grid.hWnd
    dtpTime.RelateHwnd = Grid.hWnd



    
'    Grid.Col("BeginTime").EditType = DTPicker
'    Grid.Col("EndTime").EditType = DTPicker
    Grid.Col("TimePos").EditType = ComboBox
    
    Grid.Col("BeginDate").EditType = DTPicker
    Grid.Col("EndDate").EditType = DTPicker
'    Grid.Col("ClassName").EditType = ComboBox
    Grid.Col("TimeMode").EditType = ComboBox2
'    Grid.Col("BeginTime").EditType = DTPicker
'    Grid.Col("EndTime").EditType = DTPicker
'    Grid.Col("Memo1").EditType = TextBox
    
    
    
    
    Grid.MainCol = "BeginDate"
    
    Grid.ColAutoResize = False
    Grid.AllowAddNew = True
    Grid.AllowEdit = True
    txtMemo.MaxTextLen = 255
    
    
    
End Sub

Public Function AddBill()

    Me.Caption = "请假登记-新增"
    
    cmbEmployee.SearchID 0
    txtMemo.Text = ""
    dtpLeaveDate.Value = Date
    
    If rstGrid.State = 1 Then rstGrid.Close
    Set rstGrid = Nothing
    rstGrid.CursorLocation = adUseClient
    rstGrid.Open "select BeginDate,EndDate,TimeMode,BeginTime,EndTime,TimePos from LeaveInfo_D where LeaveID=0", con, adOpenStatic, adLockBatchOptimistic
    Set Grid.DataSource = rstGrid
    
    m_Edit = False
    m_Changed = False
    m_DateID = 0
    
End Function


Public Function EditBill(LeaveID As Integer)
    Me.Caption = "请假登记－修改"
    
    If rstExec.State = 1 Then rstExec.Close
    Set rstExec = Nothing
    rstExec.CursorLocation = adUseClient
    rstExec.Open "select * from LeaveInfo where LeaveID=" & LeaveID, con, adOpenStatic, adLockBatchOptimistic
    
    If rstExec.RecordCount < 1 Then
        Message "没有找到记录!"
        Exit Function
    End If
    
    If IsNull(rstExec.Fields("EmployeeID")) Then cmbEmployee.SearchID 0 Else cmbEmployee.SearchID CInt(rstExec.Fields("EmployeeID"))
    If IsNull(rstExec.Fields("Memo1")) Then txtMemo.Text = "" Else txtMemo.Text = rstExec.Fields("Memo1")
    If IsNull(rstExec.Fields("LeaveDate")) Then dtpLeaveDate.Clear Else dtpLeaveDate.Value = rstExec.Fields("LeaveDate")

    If rstGrid.State = 1 Then rstGrid.Close
    Set rstGrid = Nothing
    rstGrid.CursorLocation = adUseClient
    rstGrid.Open "select BeginDate,EndDate,TimeMode,BeginTime,EndTime,TimePos from LeaveInfo_D where LeaveID=" & LeaveID, con, adOpenStatic, adLockBatchOptimistic
    Set Grid.DataSource = rstGrid
    
    m_Edit = True
    m_Changed = False
    m_DataID = LeaveID
End Function


Public Function SaveBill() As Boolean
On Error GoTo SaveErr

    SaveBill = False
    
    If Trim(cmbEmployee.Text) = "" Then
        Message "请输入员工名称!"
        Exit Function
    End If
    
    If IsNull(dtpLeaveDate.Value) Then
        Message "请输入请假日期"
        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("TimePos")) = "" _
                Or IsNull(rstGrid.Fields("TimePos")) Then
                    Message "请输入时间段!"
                Exit Function
            End If
            rstGrid.MoveNext
        Wend
    End If
    
    
    Dim strSQL As String
    Dim i As Integer
    Dim recDetail As New ADODB.Recordset
    
    If m_Edit = False Then
    
        strSQL = "insert into LeaveInfo(EmployeeID,LeaveDate,Memo1) values(" _
            & "'" & cmbEmployee.ID _
            & "','" & Format(dtpLeaveDate.Value, "yyyy-mm-dd") _
            & "','" & txtMemo.Text & "')"
            
        con.Execute strSQL
        
        If rstExec.State = 1 Then rstExec.Close
        Set rstExec = Nothing
        rstExec.CursorLocation = adUseClient
        rstExec.Open "select Max(LeaveID) as DataID  from LeaveInfo ", con
        
        m_DataID = rstExec.Fields("DataID")
        
        con.BeginTrans
        i = 1
   
    Else
    
        If rstExec.State = 1 Then rstExec.Close
        Set rstExec = Nothing
        rstExec.CursorLocation = adUseClient
        rstExec.Open "select * from LeaveInfo where LeaveID=" & m_DataID, con, adOpenStatic, adLockBatchOptimistic
        If rstExec.RecordCount < 1 Then
            Message "该记录已被删除!"
            Exit Function
        End If
        
        rstExec.Fields("EmployeeID") = cmbEmployee.ID
        rstExec.Fields("LeaveDate") = Format(dtpLeaveDate.Value, "yyyy-mm-dd")
        rstExec.Fields("Memo1") = txtMemo.Text
        
        con.BeginTrans
        i = 1
        rstExec.UpdateBatch
        
    End If
        
    con.Execute "delete from LeaveInfo_D where LeaveID=" & m_DataID
        
    If recDetail.State = 1 Then recDetail.Close
    Set recDetail = Nothing
    recDetail.CursorLocation = adUseClient
    recDetail.Open "select * from LeaveInfo_D where LeaveID= " & m_DataID, con, adOpenStatic, adLockBatchOptimistic
    
    If rstGrid.RecordCount > 0 Then rstGrid.MoveFirst
    Dim j As Integer
    Do While Not rstGrid.EOF
        recDetail.AddNew
        j = j + 1
        recDetail.Fields("LeaveID") = m_DataID
        recDetail.Fields("ItemNo") = j
        recDetail.Fields("BeginDate") = rstGrid.Fields("BeginDate")
        recDetail.Fields("EndDate") = rstGrid.Fields("EndDate")
        recDetail.Fields("TimeMode") = rstGrid.Fields("TimeMode")
        recDetail.Fields("BeginTime") = rstGrid.Fields("BeginTime")
        recDetail.Fields("EndTime") = rstGrid.Fields("EndTime")
        recDetail.Fields("TimePos") = rstGrid.Fields("TimePos")
        recDetail.Update
        rstGrid.MoveNext
    Loop
    
    recDetail.UpdateBatch
    con.CommitTrans
    i = 2
        
    If FindWindow("frmLeave") = True Then frmLeave.RefreshBill
    SaveBill = True
    m_Changed = False
    Exit Function

SaveErr:
    If i = 1 Then con.RollbackTrans
    If m_Edit = False Then con.Execute "delete from LeaveInfo where LeaveID=" & m_DataID
       
    Message Err.Description

End Function

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 LeaveInfo where LeaveID>" & m_DataID & "   order by LeaveID ", con, adOpenStatic, adLockBatchOptimistic
    
    If rstExec.RecordCount < 1 Then Exit Sub
    EditBill (rstExec.Fields("LeaveID"))
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
    rstExec.Open "select top 1 * from LeaveInfo where LeaveID<" & m_DataID & "   order by LeaveID   desc", con, adOpenStatic, adLockBatchOptimistic
    
    If rstExec.RecordCount < 1 Then Exit Sub
    EditBill (rstExec.Fields("LeaveID"))
End Sub

Private Sub cmbEmployee_Selected()
    m_Changed = True
End Sub

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

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 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

Public Sub DelRecord()
    Grid.Delete
    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 dtpLeaveDate_Change()
    m_Changed = True
End Sub

Private Sub txtMemo_Change()
    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