frmmain.frm

这是温州现代集团的员工考勤管理系统

         Height          =   465
         Index           =   0
         Left            =   450
         Picture         =   "frmMain.frx":1298A
         Style           =   1  'Graphical
         TabIndex        =   53
         Top             =   75
         Width           =   1245
      End
      Begin VB.CommandButton cmdEdit 
         Caption         =   "查询(&S)"
         Height          =   465
         Index           =   4
         Left            =   6135
         TabIndex        =   57
         Top             =   120
         Visible         =   0   'False
         Width           =   1365
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑(&E)"
      Visible         =   0   'False
      Begin VB.Menu mnuEditModify 
         Caption         =   "修改(&M)"
      End
      Begin VB.Menu mnuEditDelete 
         Caption         =   "删除(&D)"
      End
   End
   Begin VB.Menu mnuList 
      Caption         =   "dd"
      Visible         =   0   'False
      Begin VB.Menu mnuListRegister 
         Caption         =   "登记此卡"
      End
      Begin VB.Menu mnuListAppend 
         Caption         =   "添加到考勤中"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim mblnIsModify As Boolean
Dim mblnIsAdd As Boolean
Dim mblnIsNeedSave As Boolean
Dim mblnCollectModify As Boolean
Dim mOldKqDate As String
Dim mOldKqTime As String
Dim mPosName As String

Const mDATEMASK = "####-##-##"
Const mTIMEMASK = "##:##"

Public mMenuIndex As Integer 'frmMdi调用

Dim mStatus As Integer 'differ leave,absent
Dim mFormatString  As String
Dim mRowBeforeSave As Integer '保存前的行数

Dim mOldName As String 'old grid text before edit

Const mMsg1 = "考勤机未打开!"
Const mMsg2 = "线路出现严重故障,请检查!"
Const mMsg3 = "数据传输出错!"
Const mMsg4 = "无数据可采集!"
Const mMsg5 = "数据已采集完毕!"

Const mRetryTimes = 3

Private Const mIntCollectCols = 7
Private Const mIntLeaveCols = 12
Private Const mIntAbsentCols = 11
Private Const mstrSHour = "8"
Private Const mstrEHour = "13"
Private Const mstrMinute = "0"

Private Const mstrAbsent = "缺席"

'*****cols of grid
'Private Const mCollectCols = 7
'Private Const mLeaveCols = 11
'Private Const mAbsentCols = 10
'*******cmdkq'其他同cmdEdit
Private Const mRefresh = 6
Private Const mCollect = 7
'*****strdata
'Private Const mTotal = 1
'Private Const mReceive = 2
'Private Const mDate = 3
'Private Const mTime = 4

'******msfGrid
Private Const mGridWorkNo = 0
Private Const mGridName = 1
Private Const mGridSex = 2
Private Const mGridDept = 3
Private Const mGridTitle = 4
Private Const mGridStartDate = 5
Private Const mGridStartTime = 6
Private Const mGridEndDate = 7
Private Const mGridEndTime = 8
Private Const mGridType = 9
Private Const mGridAllowMan = 10
Private Const mGridReason = 11
'******txtKQ
Private Const mtxtWorkNo = 0
Private Const mtxtName = 1
Private Const mtxtSex = 2
Private Const mtxtAge = 3
Private Const mtxtTitle = 4
Private Const mtxtDept = 5
Private Const mtxtSDate = 6
Private Const mtxtSHour = 7
Private Const mtxtSMinute = 8
Private Const mtxtEDate = 9
Private Const mtxtEHour = 10
Private Const mtxtEMinute = 11
Private Const mtxtReason = 12
Private Const mtxtAllowMan = 13
'*******VScrollHour
Private Const mVSStart = 0
Private Const mVSEnd = 1

Dim mKqRecord() As KQTemp '采集临时数据
Dim mColNotRegister() As KQTemp  '未登记的卡号
Dim mColInValidCard() As KQTemp '流通中的无效卡

Const mHasInValidTop = 3165
Const mHasInValidHeight = 4680
Const mValidTop = 790
Const mValidHeight = 6955

Const mMsg6 = "您确定不保存吗?"
Const mMsg7 = "出现某一未知的错误!!数据保存未成功!"
Const mMsg8 = "您确定要删除该条记录吗?"
Const mMsg9 = "抱歉,删除不成功!"

'***frmdetail.mtitle
Const mstrDui = "对"
Const mstrEmployee = "的员工"
Const mstrDoPlan = "进行排班"



Private Sub cboEdit_GotFocus()
    msfGrid.ScrollBars = flexScrollBarNone
End Sub


'Private Sub cboEdit_LostFocus()
'    cboEdit.Visible = False
'    msfGrid.ScrollBars = flexScrollBarBoth
'    msfGrid.SetFocus
'End Sub

Private Sub cmdEdit_Click(Index As Integer)
    Dim strTmp As String
    Select Case Index
        Case gCMDAPPEND
            Dim blnIsToGo As Boolean
            blnIsToGo = True
            If Not mblnIsAdd Then
                strTmp = gSTRCANCEL
                AddAction
                InitxtEdit
                txtKQ(mtxtWorkNo).SetFocus
            Else
                If mblnIsNeedSave Then
                    If MsgBox(mMsg6, vbQuestion + _
                        vbYesNo + vbDefaultButton2, gTitle) _
                        = vbNo Then
                        blnIsToGo = False
                    End If
                End If
                If blnIsToGo Then
                    strTmp = gSTRAPPEND
                    InitxtEdit
                    ChangeColorFortxtKQ False
                    mblnIsNeedSave = False
                    RefreshButton cmdEdit, gCMDEDITCANCEL
                Else
                    strTmp = gSTRCANCEL
                End If
            End If
            strTmp = strTmp & "(&A)"
            cmdEdit(gCMDAPPEND).Caption = strTmp
            If blnIsToGo Then
                mblnIsAdd = Not mblnIsAdd
            End If
        Case gCMDSAVE
            If SaveDataToDatabase Then
               AfterSave
               strTmp = gSTRMODIFY & "&M"
               cmdEdit(gCMDEDIT).Caption = strTmp
               mnuEditModify.Caption = strTmp
            End If
        Case gCMDEDIT
            If Not mblnIsModify Then
                strTmp = gSTRRESET
                ToModify
            Else
                strTmp = gSTRMODIFY
                AfterSave
            End If
            strTmp = strTmp & "(&M)"
            mnuEditModify.Caption = strTmp
            cmdEdit(gCMDEDIT).Caption = strTmp
        Case gCMDDELETE
            If DeleteForLeave Then
                If Not txtKQ(mtxtWorkNo).Locked Then InitxtEdit
                RefreshButton cmdEdit, gCMDEDITNORMAL
            End If
        Case gCMDQUERY
        Case gCMDRETURN
            If Trim(txtKQ(mtxtWorkNo)) <> Empty Then
                If MsgBox("您还没保存,要保存吗?", vbQuestion + vbYesNo, gTitle) = vbYes Then
                    cmdEdit_Click gCMDSAVE
                    Exit Sub
                End If
            End If
            Unload Me
        Case mRefresh
            RefreshHistory
    End Select
End Sub

Private Function DeleteForLeave() As Boolean
    Dim strWorkNo As String
    Dim strSDate As String
    Dim strSTime As String
    Dim strEDate As String
    Dim strETime As String
    Dim Sql As String
    
    If MsgBox(mMsg8, _
        vbQuestion + vbOKCancel + vbDefaultButton2, _
        gTitle) = vbCancel Then Exit Function
    
    On Error GoTo DeleteErr
    With msfGrid
        strWorkNo = Trim(.TextMatrix(.row, mGridWorkNo))
        strSDate = Trim(.TextMatrix(.row, mGridStartDate))
        strSTime = Trim(.TextMatrix(.row, mGridStartTime))
        strEDate = Trim(.TextMatrix(.row, mGridEndDate))
        strETime = Trim(.TextMatrix(.row, mGridEndTime))
        
        Sql = "Update "
        If mStatus = gMAINLEAVE Then
            Sql = Sql & "Leave"
        ElseIf mStatus = gMAINABSENT Then
            Sql = Sql & "Absent"
        End If
        Sql = Sql & " set F_DelFlag=" & gTRUE _
                & " where WorkNo ='" & strWorkNo _
                & "' and StartDate='" & strSDate _
                & "' and StartTime='" & strSTime _
                & "' and EndDate='" & strEDate _
                & "' and EndTime='" & strETime & "'"
        gDataBase.Execute Sql
        DeleteForLeave = True
        If .Rows = .FixedRows + 1 Then
            .Rows = .FixedRows
        Else
            .RemoveItem .row
        End If
    End With
    
    Exit Function
DeleteErr:
    MsgBox mMsg9 & vbCrLf & vbCrLf & Err.Description, vbExclamation, gTitle
    Err.Clear
    DeleteForLeave = False
End Function

Private Sub ToModify()
    With msfGrid
        Dim i As Integer
        Dim CellStr As String
        mblnIsModify = True
        For i = 0 To .Cols - 1
            CellStr = Trim(.TextMatrix(.row, i))
            Select Case i
                Case 0 To 2
                    txtKQ(i) = CellStr
                Case 3
                    txtKQ(mtxtDept) = CellStr
                Case 4
                    txtKQ(mtxtTitle) = CellStr
                Case mGridStartDate
                    txtKQ(mtxtSDate) = CellStr
                Case mGridStartTime
                    txtKQ(mtxtSHour) = Left(CellStr, 2)
                    txtKQ(mtxtSMinute) = Right(CellStr, 2)
                Case mGridEndDate
                    txtKQ(mtxtEDate) = CellStr
                Case mGridEndTime
                    txtKQ(mtxtEHour) = Left(CellStr, 2)
                    txtKQ(mtxtEMinute) = Right(CellStr, 2)
                Case mGridType
                    LookForCboByStr cboKQ, CellStr
                Case mGridAllowMan
                    txtKQ(mtxtAllowMan) = CellStr
                Case mGridReason
                    txtKQ(mtxtReason) = CellStr
            End Select
        Next
    End With
    ChangeColorFortxtKQ True
    RefreshButton cmdEdit, gCMDEDIT
    cmdEdit(mRefresh).Enabled = False
    txtKQ(mtxtWorkNo).Locked = True
    txtKQ(mtxtSDate).SetFocus
End Sub

Private Sub AfterSave()
    InitxtEdit
    ChangeColorFortxtKQ False
    RefreshButton cmdEdit, gCMDEDITNORMAL
    cmdEdit(mRefresh).Enabled = True
    mblnIsModify = False
    mblnIsAdd = False
    mblnIsNeedSave = False
    cmdEdit(gCMDAPPEND).Caption = gSTRAPPEND & "&A"
End Sub

Private Function SaveDataToDatabase() As Boolean
    Dim strWorkNo As String
    Dim strAllowMan As String
    Dim strSDate As String
    Dim strSTime As String
    Dim strEDate As String
    Dim strETime As String
    Dim intLeaveType As Integer
    Dim strReason As String
    Dim isTrans As Boolean
    
    strWorkNo = Trim(txtKQ(mtxtWorkNo))
    strAllowMan = Trim(txtKQ(mtxtAllowMan))
    strSDate = Trim(txtKQ(mtxtSDate))
    strSTime = Format(Trim(txtKQ(mtxtSHour)), "00") & ":" _
        & Format(Trim(txtKQ(mtxtSMinute)), "00")
    strEDate = Trim(txtKQ(mtxtEDate))
    strETime = Format(Trim(txtKQ(mtxtEHour)), "00") & ":" _
        & Format(Trim(txtKQ(mtxtEMinute)), "00")
    strReason = Trim(txtKQ(mtxtReason))
    getItemData cboKQ, intLeaveType
    
    If Not mblnIsModify Then
        If strWorkNo = Empty Then
            MsgBox "工号不能为空,请输入!!", , gTitle
            SaveDataToDatabase = False
            txtKQ(mtxtWorkNo).SetFocus
            Exit Function
        Else
            If Trim(txtKQ(mtxtName)) = Empty Then
                MsgBox "无效的工号,请核对后重新输入!!", , gTitle
                SaveDataToDatabase = False
                txtKQ(mtxtWorkNo).SetFocus
                Exit Function
            End If
        End If
    End If
    
    If strAllowMan = Empty Then
        If mStatus = gMAINLEAVE Then
            MsgBox "没有批准人怎么能准假呢?,请输入!!", , gTitle
        ElseIf mStatus = gMAINABSENT Then
            MsgBox "批准人不能为空,请输入!!", , gTitle
        End If
        SaveDataToDatabase = False
        txtKQ(mtxtAllowMan).SetFocus
        Exit Function
    End If
    
    If strSDate = Empty Then
        MsgBox "起始日期不能为空,请输入!!", , gTitle
        SaveDataToDatabase = False
        txtKQ(mtxtSDate).SetFocus
        Exit Function
    End If
    If strEDate = Empty Then
        MsgBox "截至日期不能为空,请输入!!", , gTitle
        SaveDataToDatabase = False
        txtKQ(mtxtEDate).SetFocus
        Exit Function
    End If
    
    If (strSDate & strSTime) >= (strEDate & strETime) Then
        MsgBox "起始日期时间不能大于或等于截至日期时间!!", , gTitle
        SaveDataToDatabase = False
        txtKQ(mtxtSDate).SetFocus
        Exit Function
    End If
    
    If Not HasThisTable(gPlanTableName) Then