kqmodule.bas

学生考勤检查系统

    With aInnerShift(4)
        .ID = GSHIFTMONEYID
        .ShiftName = GSHIFTMONEYNAME
        .Note = GSHIFTMONEYSTR
    End With
    
    Dim Rst As Recordset
    Dim i As Integer
    Dim Sql As String
    Dim IsToDelete As Boolean
    Dim isToAdd As Boolean
    On Error GoTo ShiftErr
    For i = 1 To UBound(aInnerShift)
        With aInnerShift(i)
            IsToDelete = False
            isToAdd = True
            Sql = "Select * from Shift where ID=" & .ID
            Set Rst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
            If Rst.RecordCount > 0 Then
                If Rst!ShiftName <> Trim(.ShiftName) Then
                    IsToDelete = True
                Else
                    isToAdd = False
                End If
            End If
            Rst.Close
            Set Rst = Nothing
            If IsToDelete Then
                Sql = "delete * from Shift where ID=" & .ID
                gDataBase.Execute Sql
            End If
            If isToAdd Then
                Sql = "Insert into Shift (ID,ShiftName) values(" & .ID _
                    & ",'" & .ShiftName & "')"
                gDataBase.Execute Sql
            End If
        End With
    Next
    Exit Sub
ShiftErr:
    Err.Clear
    MsgBox mMsg1, vbExclamation, gTitle
    EndSystem
End Sub

Public Sub EndSystem()
    If Not gDataBase Is Nothing Then
        gDataBase.Close
        Set gDataBase = Nothing
    End If
    Dim Fr As Form
    For Each Fr In Forms
        Unload Fr
    Next
End Sub
Private Sub IniItem(t_table As String, aArray() As ItemStruc)
    ReDim aArray(0)
    aArray(0).ID = gMAXITEM
    
    Dim Rst As Recordset
    Dim i As Integer
    Dim isSame As Boolean
    
    On Error GoTo ErrHandle
    Set Rst = gDataBase.OpenRecordset("select * from " _
        & Trim(t_table) & " Where F_DelFlag=" & gFALSE _
        & " order by ID", dbOpenSnapshot)
    
    While Not Rst.EOF
        isSame = False
        For i = 0 To UBound(aArray)
            If Rst!ID = aArray(i).ID Then
                isSame = True
                Exit For
            End If
        Next
        If Not isSame Then
            ReDim Preserve aArray(UBound(aArray) + 1)
            With aArray(UBound(aArray))
                .ID = Rst!ID
                .Name = IIf(IsNull(Rst!Name), "", Trim(Rst!Name))
            End With
        End If
        Rst.MoveNext
    Wend
    Rst.Close
    Set Rst = Nothing
    Exit Sub
ErrHandle:
    Dim er As Error
    Dim MsgStr As String
    For Each er In Errors
        MsgStr = MsgStr & er.Description & er.Number & vbCrLf
    Next
    MsgBox MsgStr, , gTitle
    Resume Next
End Sub

Public Sub RefreshButton(cmdEdit As Object, Optional intActionAfter As Integer = gCMDEDITNORMAL)
    Dim i As Integer
    Select Case intActionAfter
        Case gCMDAPPEND
            For i = 0 To cmdEdit.Count - 2
                With cmdEdit(i)
                    Select Case i
                        Case gCMDSAVE, gCMDRETURN, gCMDAPPEND
                            If Not .Enabled Then .Enabled = True
                        Case gCMDEDIT, gCMDDELETE, gCMDQUERY
                            If .Enabled Then .Enabled = False
                    End Select
                End With
            Next
        Case gCMDEDITNORMAL
            For i = 0 To cmdEdit.Count - 2
                With cmdEdit(i)
                    Select Case i
                        Case gCMDAPPEND, gCMDQUERY, gCMDRETURN
                            If Not .Enabled Then .Enabled = True
                        Case gCMDSAVE, gCMDEDIT, gCMDDELETE
                            If .Enabled Then .Enabled = False
                    End Select
                End With
            Next
        Case gCMDEDIT
            For i = 0 To cmdEdit.Count - 2
                With cmdEdit(i)
                    Select Case i
                        Case gCMDSAVE, gCMDEDIT
                            If Not .Enabled Then .Enabled = True
                        Case gCMDAPPEND, gCMDDELETE, gCMDQUERY, gCMDRETURN
                            If .Enabled Then .Enabled = False
                    End Select
                End With
            Next
        Case gCMDEDITCANCEL
            If cmdEdit(gCMDSAVE).Enabled Then cmdEdit(gCMDSAVE).Enabled = False
    End Select
End Sub

Public Sub ChangeBackColor(cn As Control, isEdit As Boolean)
    If isEdit Then
        cn.BackColor = vbWhite
    Else
        cn.BackColor = &H8000000F
    End If
End Sub


Public Sub ClipToGrid(msfGrid As MSFlexGrid, ClipStr As String, intRows As Integer, intCols As Integer)
    With msfGrid
        On Error GoTo ClipErr
        .Rows = .FixedRows
        If intRows > .FixedRows Then
            If .Redraw Then .Redraw = False
            .Rows = intRows
            .Cols = intCols
            .row = .FixedRows
            .col = .FixedCols
            .RowSel = .Rows - 1
            .ColSel = .Cols - 1
            .Clip = ClipStr
            .row = .FixedRows
            .col = 0
            .Redraw = True
            .RowHeightMin = 300
        End If
    End With
    Exit Sub
ClipErr:
    MsgBox Err.Description, vbExclamation, gTitle
    Err.Clear
End Sub

Public Function HasThisTable(TableName As String) As Boolean
    Dim TD As TableDef
    For Each TD In gDataBase.TableDefs
        If TD.Name = TableName Then
            HasThisTable = True
            Exit Function
        End If
    Next
    HasThisTable = False
End Function

Public Function CreateAllRecord(TableName As String) As Boolean
    Dim intEmp As Integer
    Dim intDay As Integer
    Dim Rst As Recordset
    Dim strWorkNo As String
    Dim bytDay As Byte
    Dim bytShift As Byte
    Dim Sql As String
    
    bytShift = gNOSHIFT '缺省的 无班次
    
    On Error GoTo CreateRecErr
    Set Rst = gDataBase.OpenRecordset("select WorkNo from Employee" _
        & " where F_DelFlag=" & gFALSE, dbOpenSnapshot)
        
    While Not Rst.EOF
        strWorkNo = Trim(Rst!WorkNo)
        For intDay = 1 To gMaxDay
            bytDay = intDay
            Sql = "Insert into " & TableName & _
                " (WorkNo,F_Day,F_Shift) values ('" _
                & strWorkNo & "'," & bytDay & "," & bytShift & ")"
            gDataBase.Execute Sql
        Next
        Rst.MoveNext
    Wend
    
    Rst.Close
    Set Rst = Nothing
    CreateAllRecord = True
    Exit Function
CreateRecErr:
    Err.Clear
    CreateAllRecord = False
End Function


Public Function CreatePlanTable() As Boolean
    Dim strTableName As String
    Dim HasThisTD As Boolean
    Dim HasRecord As Boolean
    Dim TD As TableDef
    Dim Rst As Recordset
    
    strTableName = gPlanTableName
    
    HasThisTD = HasThisTable(strTableName)
    
    If Not HasThisTD Then '无此表
        If Not CreateATable(strTableName) Then GoTo IniErr
    End If
    
    Set Rst = gDataBase.OpenRecordset(strTableName)
    If Rst.RecordCount > 0 Then HasRecord = True
    Rst.Close
    Set Rst = Nothing
    
    If Not HasRecord Then '无记录
       If Not CreateAllRecord(strTableName) Then GoTo IniErr
    End If
    
    CreatePlanTable = True
    Exit Function
IniErr:
    CreatePlanTable = False
    Exit Function
End Function

Public Sub GetPosToCbo(tmpCbo As ComboBox)
    Dim mSql As String
    Dim mRst As Recordset
    
    mSql = "select * from T_Pos order by PosNo"
    Set mRst = gDataBase.OpenRecordset(mSql)
    Dim Str As String
    tmpCbo.Clear
    While Not mRst.EOF
        Str = IIf(IsNull(mRst!PosName), "", Trim(mRst!PosName))
        tmpCbo.AddItem Str
        tmpCbo.ItemData(tmpCbo.NewIndex) = mRst!PosNo
        mRst.MoveNext
    Wend
    If tmpCbo.ListCount > 0 Then tmpCbo.ListIndex = 0
    mRst.Close
    Set mRst = Nothing
End Sub


Public Function IsNormalKq(IntShift As Integer, strWorkNo As String, strDate As String, strKqTime As String) As Boolean
    Dim sKqTime As String
    Dim tmpStr As String
    Dim mSql As String
    Dim mRst As Recordset
    
    strKqTime = Empty
    mSql = "select F_1On from Shift where ID=" & IntShift _
        & " and F_1OnIsKq=" & gTRUE '暂时只适合A段要求考勤的班次
        '只要在KqHistory中添加F_Section(是哪段考勤)
    Set mRst = gDataBase.OpenRecordset(mSql, dbOpenSnapshot)
    If mRst.RecordCount > 0 Then
        sKqTime = IIf(IsNull(mRst!F_1On), "", Trim(mRst!F_1On))
    Else
        IsNormalKq = False
        Exit Function
    End If
    mRst.Close
    Set mRst = Nothing
    
    If sKqTime = Empty Then
        IsNormalKq = False
        Exit Function
    End If
    
    mSql = "select KqTime from KqHistory " _
        & " where KqDate='" & strDate & "'" _
        & " and WorkNo='" & strWorkNo & "'" _
        & " order by KqTime"
    Set mRst = gDataBase.OpenRecordset(mSql, dbOpenSnapshot)
    If mRst.RecordCount > 0 Then
        tmpStr = IIf(IsNull(mRst!KqTime), "", Trim(mRst!KqTime))
    End If
    mRst.Close
    Set mRst = Nothing
    
    If tmpStr = Empty Then
        IsNormalKq = False
        'Exit Function
    Else
        If sKqTime < tmpStr Then
            IsNormalKq = False
        Else
            IsNormalKq = True
        End If
    End If
    strKqTime = tmpStr
End Function