frmmain.frm

IC卡考勤系统源代码,动态连接库中函数说明,源程序中有相关的使用说明.

        If Not CreatePlanTable Then
            MsgBox mMsg7, vbCritical, gTitle
            SaveDataToDatabase = False
            Exit Function
        End If
    End If
    
    Dim strOperateTime As String
    strOperateTime = Format(Now, "yyyy-mm-dd hh:mm")
    
    Dim Rst As Recordset
    If mStatus = gMAINLEAVE Then
        Set Rst = gDataBase.OpenRecordset("Leave")
    ElseIf mStatus = gMAINABSENT Then
        Set Rst = gDataBase.OpenRecordset("Absent")
    End If
    
    On Error GoTo SaveErr
    
    BeginTrans
    isTrans = True
    If Not mblnIsModify Then
        Rst.AddNew
        Rst!WorkNo = strWorkNo
    Else
        Rst.Edit
    End If
    With Rst
        !StartDate = strSDate
        !StartTime = strSTime
        !EndDate = strEDate
        !EndTime = strETime
        !UserID = gUserID
        !AllowMan = strAllowMan
        !OperateTime = strOperateTime
        If mStatus = gMAINLEAVE Then
            !TypeID = intLeaveType
            !Reason = strReason
        ElseIf mStatus = gMAINABSENT Then
            !isEvection = intLeaveType
        End If
        .Update
    End With
    Rst.Close
    
'    UpdateShiftPlan strSDate, strEDate, Trim(cboKQ.Text)
    
    CommitTrans
    isTrans = False
    Set Rst = Nothing
    SaveDataToDatabase = True
    
    If Not mblnIsModify Then
        Dim StrAdd As String
        With msfGrid
            StrAdd = strWorkNo & vbTab & Trim(txtKQ(mtxtName)) _
                & vbTab & Trim(txtKQ(mtxtSex)) & vbTab _
                & Trim(txtKQ(mtxtDept)) & vbTab _
                & Trim(txtKQ(mtxtTitle)) & vbTab _
                & strSDate & vbTab & strSTime & vbTab _
                & strEDate & vbTab & strETime & vbTab _
                & Trim(cboKQ.Text) & vbTab _
                & strAllowMan & vbTab
            If mStatus = gMAINLEAVE Then
                StrAdd = StrAdd & strReason
            End If
            .AddItem StrAdd
            .TopRow = .Rows - 1
        End With
    Else
        With msfGrid
            .TextMatrix(.row, mGridStartDate) = strSDate
            .TextMatrix(.row, mGridStartTime) = strSTime
            .TextMatrix(.row, mGridEndDate) = strEDate
            .TextMatrix(.row, mGridEndTime) = strETime
            .TextMatrix(.row, mGridType) = Trim(cboKQ.Text)
            .TextMatrix(.row, mGridAllowMan) = strAllowMan
            If mStatus = gMAINLEAVE Then
                .TextMatrix(.row, mGridReason) = strReason
            End If
        End With
    End If
    DoPlan strWorkNo, Trim(txtKQ(mtxtName)), Trim(txtKQ(mtxtDept))
    'MsgBox "恭喜!数据保存成功,请修改排班表", vbInformation, gTitle
    Exit Function
SaveErr:
    If isTrans Then
        Rollback
        MsgBox "数据未保存成功!请再试!! " & vbCrLf _
            & vbCrLf & Err.Description, vbExclamation, gTitle
    Else
        MsgBox Err.Description, vbExclamation, gTitle
    End If
    Err.Clear
    SaveDataToDatabase = False
   ' Rst.CancelUpdate
End Function

Private Sub DoPlan(strWorkNo As String, strName As String, strDeptName As String)
    Dim MyfrmDetail As frmDetail
    Set MyfrmDetail = New frmDetail
    Dim strTemp As String
    With MyfrmDetail
            .mDeptID = Empty
            .mWorkNo = strWorkNo
            strTemp = mstrDui
            strTemp = strTemp & "[" & strDeptName & "]" & mstrEmployee _
                     & "[" & strName & "]"
            .mTitle = strTemp & mstrDoPlan
            .mIsToLook = False
        .Show vbModal
        'If .mNeedToRefresh Then tvwPlan_NodeClick mNode
        Unload MyfrmDetail
    End With
End Sub

'Private Sub UpdateShiftPlan(strSDate As String, strEDate As String, strAbsentType As String)
'    Dim intStartDay As Integer
'    Dim intEndDay As Integer
'    intStartDay = CInt(Var(Right(strSDate, 2)))
'    intEndDay = CInt(Var(Right(strEDate, 2)))
'    Dim IntDay As Integer
'    Dim Sql As String
'    For IntDay = intStartDay To intEndDay
'        Sql = "update " & gPlanTableName & _
'            " set F_Shift="
'        If mStatus = gMAINLEAVE Then
'            Sql = Sql & GSHIFTLEAVEID
'        ElseIf mStatus = gMAINABSENT Then
'            If strAbsentType = GSHIFTEVECTIONSTR Then
'                Sql = Sql & GSHIFTEVECTIONID
'            ElseIf strAbsentType = GSHIFTMONEYSTR Then
'                Sql = Sql & GSHIFTMONEYID
'            End If
'        End If
'        Sql = Sql & " Where WorkNo='" & strWorkNo & _
'            "' and F_Day=" & IntDay
'        gDataBase.Execute Sql
'    Next
'End Sub

Private Sub AddAction()
    RefreshButton cmdEdit, gCMDAPPEND
    ChangeColorFortxtKQ True
End Sub

Private Sub ChangeColorFortxtKQ(isEdit As Boolean)
    Dim i As Integer
    For i = 0 To txtKQ.Count - 1
        With txtKQ(i)
            ChangeBackColor txtKQ(i), isEdit
            Select Case i
                'Case mtxtName, mtxtSex, mtxtAge, mtxtTitle, mtxtDept, mtxtSDate, mtxtEDate
                Case mtxtWorkNo, mtxtSHour, mtxtSMinute, mtxtEHour, mtxtEMinute, mtxtAllowMan
                    .Locked = Not isEdit
                Case mtxtReason
                    If mStatus = gMAINLEAVE Then
                        .Locked = Not isEdit
                    End If
            End Select
        End With
    Next
    With cboKQ
        .Enabled = isEdit
        ChangeBackColor cboKQ, isEdit
    End With
    For i = 0 To picHour.Count - 1
        ChangeBackColor picHour(i), isEdit
    Next
    For i = 0 To picMinite.Count - 1
        ChangeBackColor picMinite(i), isEdit
    Next
    
    For i = 0 To VScrollHour.Count - 1
        VScrollHour(i).Enabled = isEdit
    Next
    
    For i = 0 To VScrollMinite.Count - 1
        VScrollMinite(i).Enabled = isEdit
    Next
    
    If isEdit Then
        txtKQ(mtxtWorkNo).SetFocus
    End If
End Sub


Private Function getNowTime() As String
    getNowTime = Format(Now, "yyyy-mm-dd hh:mm:ss")
End Function


Private Sub IntoMain(Index As Integer)
    Select Case Index
        Case gMAINCOLLECT
            showMainPic True
        Case gMAINLEAVE, gMAINABSENT
            msfGrid.Visible = False
            showMainPic False, Index
            With msfGrid
                If Index = gMAINLEAVE Then
                    .Cols = mIntLeaveCols
                    '.FormatString = mLeaveTitle
                ElseIf Index = gMAINABSENT Then
                    .Cols = mIntAbsentCols
                    '.FormatString = mAbsentTitle
                End If
                iniGridRows msfGrid
            End With
            msfGrid.Visible = True
    End Select
End Sub

Private Sub iniGridRows(myGrid As MSFlexGrid)
    With myGrid
        .Rows = .FixedRows 'clear old data
        .Rows = gFIXEDROWS
    End With
    'RefreshHistory
End Sub

Private Sub RefreshHistory()
    'If (mStatus <> gMAINLEAVE) And (mStatus <> gMAINABSENT) Then Exit Sub
    Dim Rst As Recordset
    Dim Sql As String
    Sql = "Select  * from "
    If mStatus = gMAINLEAVE Then
        Sql = Sql & "QryLeave"
    ElseIf mStatus = gMAINABSENT Then
        Sql = Sql & "QryAbsent"
    ElseIf mStatus = gMAINCOLLECT Then
        Sql = Sql & "QryKqHistory"
    End If
    Sql = Sql & " where left(trim(OperateTime),10)='" & _
        Format(Now, "yyyy-mm-dd") & "' order by WorkNo"
    
    Set Rst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
    Dim Str As String
    With Rst
        While Not .EOF
            Str = Str & IIf(IsNull(!WorkNo), "", Trim(!WorkNo)) _
                & vbTab & IIf(IsNull(!Name), "", Trim(!Name)) _
                & vbTab & IIf(IsNull(!Sex), "", Trim(!Sex)) _
                & vbTab & IIf(IsNull(!DeptName), "", Trim(!DeptName)) _
                & vbTab & IIf(IsNull(!TitleName), "", Trim(!TitleName))
            If mStatus = gMAINCOLLECT Then
                Str = Str & vbTab & IIf(IsNull(!KqDate), "", Trim(!KqDate)) _
                    & vbTab & IIf(IsNull(!KqTime), "", Trim(!KqTime))
            Else
                Str = Str & vbTab & IIf(IsNull(!StartDate), "", Trim(!StartDate)) _
                    & vbTab & IIf(IsNull(!StartTime), "", Trim(!StartTime)) _
                    & vbTab & IIf(IsNull(!EndDate), "", Trim(!EndDate)) _
                    & vbTab & IIf(IsNull(!EndTime), "", Trim(!EndTime)) & vbTab
                If mStatus = gMAINLEAVE Then
                    Str = Str & IIf(IsNull(!TypeName), "", Trim(!TypeName)) _
                        & vbTab & IIf(IsNull(!AllowMan), "", Trim(!AllowMan)) _
                        & vbTab & IIf(IsNull(!Reason), "", Trim(!Reason))
                ElseIf mStatus = gMAINABSENT Then
                    Dim tmpMyStr As String
                    If Not IsNull(!isEvection) Then
                        If !isEvection Then
                            tmpMyStr = GSHIFTEVECTIONSTR
                        Else
                            tmpMyStr = GSHIFTMONEYSTR
                        End If
                    Else
                        tmpMyStr = Empty
                    End If
                    Str = Str & tmpMyStr & vbTab _
                        & IIf(IsNull(!AllowMan), "", Trim(!AllowMan))
                End If
            End If
            
            If Not .EOF Then
                Str = Str & vbCr
            End If
            .MoveNext
        Wend
    End With
    
    Dim intCols As Integer
    Dim intRows As Integer
    intRows = Rst.RecordCount + msfGrid.FixedRows
    If mStatus = gMAINLEAVE Then
        intCols = mIntLeaveCols
    ElseIf mStatus = gMAINABSENT Then
        intCols = mIntAbsentCols
    ElseIf mStatus = gMAINCOLLECT Then
        intCols = mIntCollectCols
    End If
    ClipToGrid msfGrid, Str, intRows, intCols
    Rst.Close
    Set Rst = Nothing
End Sub

Private Sub showMainPic(isTrue As Boolean, Optional MainStatus As Integer = gMAINCOLLECT)
    picMain.Visible = isTrue
    picEdit.Visible = Not isTrue
    fraEdit.Visible = Not isTrue
    
    With msfGrid
        If isTrue Then
            If UBound(mColNotRegister) > 0 _
                Or UBound(mColInValidCard) > 0 Then
                fraList.Visible = True
                .Top = mHasInValidTop
                .Height = mHasInValidHeight
            Else
                .Top = mValidTop
                .Height = mValidHeight
            End If
        Else
            If fraList.Visible Then fraList.Visible = False
            If MainStatus = gMAINABSENT Then
                txtKQ(mtxtReason).Visible = False
                fraEdit.Height = 2235 - 495
                .Top = 2670
                .Height = 5175
            Else
                txtKQ(mtxtReason).Visible = True
                fraEdit.Height = 2235
                .Top = mHasInValidTop
                .Height = mHasInValidHeight
            End If
        End If
    End With
    
    Dim tmpStr As String
    tmpStr = "类别"
    If MainStatus = gMAINLEAVE Or MainStatus = gMAINABSENT Then
        If MainStatus = gMAINLEAVE Then
            tmpStr = GSHIFTLEAVESTR & tmpStr
            FillCbo cboKQ, aLeaveType
            If Not txtKQ(mtxtReason).Visible Then
                txtKQ(mtxtReason).Visible = True
                lblReason.Visible = True
            End If
        Else
            cboKQ.Clear
            tmpStr = mstrAbsent & tmpStr
            With cboKQ
                .AddItem GSHIFTEVECTIONSTR
                .ItemData(.NewIndex) = -1
                .AddItem GSHIFTMONEYSTR
                .ItemData(.NewIndex) = 0
                .ListIndex = 0
            End With
            If txtKQ(mtxtReason).Visible Then
                txtKQ(mtxtReason).Visible = False
                lblReason.Visible = False
            End If
        End If
        Label1(9).Caption = tmpStr
        'txtKQ(mtxtworkno).SetFocus
    End If
    
    mStatus = MainStatus
End Sub


Private Sub cmdKq_Click(Index As Integer)
    Select Case Index
        Case mCollect
            Dim Fr As frmSelPos
            Dim isOK As Boolean
            Set Fr = New frmSelPos
            Fr.Show 1
            isOK = Fr.mIsOk
            mPosName = Fr.mPosName
            Unload Fr
            Set Fr = Nothing
            If Not isOK Then Exit Sub
            If CollectDataFromPos Then
                WriteTempToKq
            End If
        Case mRefresh
            RefreshHistory
        Case gCMDAPPEND
            mblnCollectModify = False
            cmdKq(gCMDAPPEND).Enabled = False
            AppendToGrid
            cmdKq(gCMDSAVE).Enabled = True
        Case gCMDSAVE
            SaveCollect
        Case gCMDEDIT
        Case gCMDDELETE
            DeleteCollect
        Case gCMDQUERY
        Case gCMDRETURN
            Unload Me
    End Select
End Sub

Private Sub DeleteCollect()
    Dim strWorkNo As String
    Dim strKqDate As String
    Dim strKqTime As String
    Dim Sql As String
    On Error GoTo DeleteErr
    With msfGrid
        strWorkNo = Trim(.TextMatrix(.row, mGridWorkNo))