frmshift.frm

一个用VB开发的考勤管理系统... 希望大家来看看..提出见意.. 谢谢.

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmShift 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "班次定义"
   ClientHeight    =   5910
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10095
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmShift.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5910
   ScaleWidth      =   10095
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   960
      Left            =   225
      TabIndex        =   1
      Top             =   4770
      Width           =   9645
      Begin VB.CommandButton Command1 
         Height          =   510
         Index           =   4
         Left            =   6114
         Picture         =   "frmShift.frx":000C
         Style           =   1  'Graphical
         TabIndex        =   6
         Top             =   315
         Width           =   1245
      End
      Begin VB.CommandButton Command1 
         Height          =   510
         Index           =   0
         Left            =   390
         Picture         =   "frmShift.frx":1F77
         Style           =   1  'Graphical
         TabIndex        =   5
         Top             =   315
         Width           =   1245
      End
      Begin VB.CommandButton Command1 
         Height          =   510
         Index           =   1
         Left            =   8025
         Picture         =   "frmShift.frx":3D16
         Style           =   1  'Graphical
         TabIndex        =   4
         Top             =   315
         Width           =   1245
      End
      Begin VB.CommandButton Command1 
         Height          =   510
         Index           =   2
         Left            =   2298
         Picture         =   "frmShift.frx":5B87
         Style           =   1  'Graphical
         TabIndex        =   3
         Top             =   315
         Width           =   1245
      End
      Begin VB.CommandButton Command1 
         Height          =   510
         Index           =   3
         Left            =   4206
         Picture         =   "frmShift.frx":796A
         Style           =   1  'Graphical
         TabIndex        =   2
         Top             =   315
         Width           =   1245
      End
   End
   Begin MSFlexGridLib.MSFlexGrid msfGrid 
      Height          =   4485
      Left            =   255
      TabIndex        =   0
      Top             =   180
      Width           =   9645
      _ExtentX        =   17013
      _ExtentY        =   7911
      _Version        =   393216
      FixedCols       =   0
      AllowBigSelection=   0   'False
      HighLight       =   0
      AllowUserResizing=   2
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
End
Attribute VB_Name = "frmShift"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim mFormatString As String
Const mKq = "考勤"
Const mKqMethod = "计勤方式"
Const mOn = "段上班 "
Const mOff = "段下班 "
Const mStrName = "班次名称"
Const mStrID = "班次号"
Const mStandard = "标准"
Const mAdd = "加班"
Const mStrTrue = "√"
Const mStrFalse = "－"
Public mIsToRefresh As Boolean
Const mMsg1 = "您是否确定要删除该班次?(是/否)"
Const mMsg2 = "如果您删除了该班次,则您的排班会受到严重影响" _
    & vbCrLf & vbCrLf & "您是否真的要删除该班次?(是/否)"
Const mMsg3 = "抱歉,班次删除未成功!!"
Const mMsg4 = "祝贺,班次删除成功!!"
Const mMsg5 = "内置班次不能"
Const mMsg6 = "删除"
Const mMsg7 = "修改"

Const mintSave = 0
Const mintDelete = 3
Const mintModify = 2


Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0, 2
            EditAddS Index
        Case 1
            Unload Me
        Case 3
            DeleteAdds
        Case 4
            Dim tmpStr As String
            tmpStr = gOwnName & "-班次表"
            PrintGridNormal tmpStr, _
                msfGrid, 2, "", True
    End Select
End Sub

Private Sub DeleteAdds()
    With msfGrid
        If .row = .FixedRows - 1 Then Exit Sub
        Dim IntID As Integer
        IntID = Trim(.TextMatrix(.row, .Cols - 1))
        If IntID <= UBound(aInnerShift) Then
            MsgBox mMsg5 & mMsg6, vbExclamation, gTitle
            Exit Sub
        End If
        If MsgBox(mMsg1, vbQuestion + vbYesNo + vbDefaultButton2, gTitle) = vbNo Then Exit Sub
        If MsgBox(mMsg2, vbCritical + vbYesNo + vbDefaultButton2, gTitle) = vbNo Then Exit Sub
        
        Dim Sql As String
        Sql = "Update Shift set F_DelFlag=-1 where ID=" & IntID
        gDataBase.Execute Sql
        If gDataBase.RecordsAffected <= 0 Then
            MsgBox mMsg3, vbInformation, gTitle
        Else
            MsgBox mMsg4, vbInformation, gTitle
            If .Rows = .FixedRows + 1 Then
                .Rows = .FixedRows
            Else
                .RemoveItem .row
            End If
        End If
        RefreshBtn
    End With
End Sub

Private Sub RefreshBtn()
    With msfGrid
        Command1(mintDelete).Enabled = (.Rows <> .FixedRows)
        Command1(mintModify).Enabled = (.Rows <> .FixedRows)
    End With
End Sub

Private Sub EditAddS(Index As Integer)
    With frmAddS
        If Index = 2 Then
            Dim Str As String
            Dim i As Integer
            Dim j As Integer
            Dim IntJ As Integer
            Dim IntID As Integer
            IntID = CInt(Val(msfGrid.TextMatrix(msfGrid.row, _
                msfGrid.Cols - 1)))
            If IntID <= UBound(aInnerShift) Then
                MsgBox mMsg5 & mMsg7, vbExclamation, gTitle
                Exit Sub
            End If
            .mIsModify = True
            .mShiftID = IntID
            .txtShift(0) = Trim(msfGrid.TextMatrix(msfGrid.row, 0))
            .txtDate(0) = Left(Trim(msfGrid.TextMatrix(msfGrid.row, 1)), 2)
            .txtDate(1) = Right(Trim(msfGrid.TextMatrix(msfGrid.row, 1)), 2)
            .chkDate(0).Value = IIf(Trim(msfGrid.TextMatrix(msfGrid.row _
                , 2)) = mStrTrue, 1, 0)
            .txtDate(2) = Left(Trim(msfGrid.TextMatrix(msfGrid.row, 3)), 2)
            .txtDate(3) = Right(Trim(msfGrid.TextMatrix(msfGrid.row, 3)), 2)
            .chkDate(1).Value = IIf(Trim(msfGrid.TextMatrix(msfGrid.row _
                , 4)) = mStrTrue, 1, 0)
                
            
            For j = 1 To 4
                IntJ = j * 5
                Str = Trim(msfGrid.TextMatrix(msfGrid.row, IntJ))
                If Str = Empty Then
                    .cboMethod(j - 1).ListIndex = -1
                Else
                    For i = 0 To .cboMethod(j - 1).ListCount - 1
                        If Trim(.cboMethod(j - 1).List(i)) = Str Then
                            .cboMethod(j - 1).ListIndex = i
                            Exit For
                        End If
                    Next
                End If
            Next
           
            
            .txtDate(4) = Left(Trim(msfGrid.TextMatrix(msfGrid.row, 6)), 2)
            .txtDate(5) = Right(Trim(msfGrid.TextMatrix(msfGrid.row, 6)), 2)
            .chkDate(2).Value = IIf(Trim(msfGrid.TextMatrix(msfGrid.row _
                , 7)) = mStrTrue, 1, 0)
            .txtDate(6) = Left(Trim(msfGrid.TextMatrix(msfGrid.row, 8)), 2)
            .txtDate(7) = Right(Trim(msfGrid.TextMatrix(msfGrid.row, 8)), 2)
            .chkDate(3).Value = IIf(Trim(msfGrid.TextMatrix(msfGrid.row _
                , 9)) = mStrTrue, 1, 0)
                
            
            .txtDate(8) = Left(Trim(msfGrid.TextMatrix(msfGrid.row, 11)), 2)
            .txtDate(9) = Right(Trim(msfGrid.TextMatrix(msfGrid.row, 11)), 2)
            .chkDate(4).Value = IIf(Trim(msfGrid.TextMatrix(msfGrid.row _
                , 12)) = mStrTrue, 1, 0)
            .txtDate(10) = Left(Trim(msfGrid.TextMatrix(msfGrid.row, 13)), 2)
            .txtDate(11) = Right(Trim(msfGrid.TextMatrix(msfGrid.row, 13)), 2)
            .chkDate(5).Value = IIf(Trim(msfGrid.TextMatrix(msfGrid.row _
                , 14)) = mStrTrue, 1, 0)
            
                
            .txtDate(12) = Left(Trim(msfGrid.TextMatrix(msfGrid.row, 16)), 2)
            .txtDate(12) = Right(Trim(msfGrid.TextMatrix(msfGrid.row, 16)), 2)
            .chkDate(6).Value = IIf(Trim(msfGrid.TextMatrix(msfGrid.row _
                , 17)) = mStrTrue, 1, 0)
            .txtDate(13) = Left(Trim(msfGrid.TextMatrix(msfGrid.row, 18)), 2)
            .txtDate(14) = Right(Trim(msfGrid.TextMatrix(msfGrid.row, 18)), 2)
            .chkDate(7).Value = IIf(Trim(msfGrid.TextMatrix(msfGrid.row _
                , 19)) = mStrTrue, 1, 0)
            
        End If
        .Show vbModal
        If mIsToRefresh Then GetDataFromDatabase
    End With
End Sub

Private Sub Form_Load()
    mFormatString = "^" & mStrName & vbTab _
        & "^A" & mOn & vbTab & "^" & mKq & vbTab _
        & "^A" & mOff & vbTab & "^" & mKq & vbTab & "^" & mKqMethod & vbTab _
        & "^B" & mOn & vbTab & "^" & mKq & vbTab _
        & "^B" & mOff & vbTab & "^" & mKq & vbTab & "^" & mKqMethod & vbTab _
        & "^C" & mOn & vbTab & "^" & mKq & vbTab _
        & "^C" & mOff & vbTab & "^" & mKq & vbTab & "^" & mKqMethod & vbTab _
        & "^D" & mOn & vbTab & "^" & mKq & vbTab _
        & "^D" & mOff & vbTab & "^" & mKq & vbTab & "^" & mKqMethod & vbTab _
        & "<" & mStrID  '22
    SetGridColor msfGrid
    msfGrid.FormatString = mFormatString
    msfGrid.ColWidth(msfGrid.Cols - 1) = 0
    
'    Dim Str As String
'    Str = App.Path + "\data\kq.mdb"
'    Set gDataBase = Workspaces(0).OpenDatabase(Str, False, False, ";pwd=wsh2000")
    
    GetDataFromDatabase
    RefreshBtn
End Sub


Private Sub GetDataFromDatabase()
    Dim Rst As Recordset
    Dim Str As String
    Dim Sql As String
    
    Sql = "select * from Shift where F_DelFlag=0 order by ID"
    Set Rst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
    Dim intRows As Integer
    While Not Rst.EOF
        With Rst
            If !ID <> gNOSHIFT Then '缺省 空班次
                intRows = intRows + 1
                Str = Str & Trim(!ShiftName) & vbTab & _
                    IIf(IsNull(!F_1On), "", Trim(!F_1On)) & vbTab & _
                    IIf(!F_1OnIsKq, mStrTrue, mStrFalse) & vbTab & _
                    IIf(IsNull(!F_1Off), "", Trim(!F_1Off)) & vbTab & _
                    IIf(!F_1OffIsKq, mStrTrue, mStrFalse) & vbTab
                If !F_1OnIsKq Or !F_1OffIsKq Then
                    Str = Str & IIf(!F_1IsAdd, mAdd, mStandard) & vbTab
                Else
                    Str = Str & "" & vbTab
                End If
                Str = Str & IIf(IsNull(!F_2On), "", Trim(!F_2On)) & vbTab & _
                    IIf(!F_2OnIsKq, mStrTrue, mStrFalse) & vbTab & _
                    IIf(IsNull(!F_2Off), "", Trim(!F_2Off)) & vbTab & _
                    IIf(!F_2OffIsKq, mStrTrue, mStrFalse) & vbTab
                If !F_2OnIsKq Or !F_2OffIsKq Then
                    Str = Str & IIf(!F_2IsAdd, mAdd, mStandard) & vbTab
                Else
                    Str = Str & "" & vbTab
                End If
                Str = Str & IIf(IsNull(!F_3On), "", Trim(!F_3On)) & vbTab & _
                    IIf(!F_3OnIsKq, mStrTrue, mStrFalse) & vbTab & _
                    IIf(IsNull(!F_3Off), "", Trim(!F_3Off)) & vbTab & _
                    IIf(!F_3OffIsKq, mStrTrue, mStrFalse) & vbTab
                If !F_3OnIsKq Or !F_3OffIsKq Then
                    Str = Str & IIf(!F_3IsAdd, mAdd, mStandard) & vbTab
                Else
                    Str = Str & "" & vbTab
                End If
                Str = Str & IIf(IsNull(!F_4On), "", Trim(!F_4On)) & vbTab & _
                    IIf(!F_4OnIsKq, mStrTrue, mStrFalse) & vbTab & _
                    IIf(IsNull(!F_4Off), "", Trim(!F_4Off)) & vbTab & _
                    IIf(!F_4OffIsKq, mStrTrue, mStrFalse) & vbTab
                If !F_4OnIsKq Or !F_4OffIsKq Then
                    Str = Str & IIf(!F_4IsAdd, mAdd, mStandard) & vbTab
                Else
                    Str = Str & "" & vbTab
                End If
                Str = Str & CInt(!ID)
                
                
                If Not .EOF Then Str = Str & vbCr
            End If
            .MoveNext
        End With
    Wend
    Rst.Close
    Set Rst = Nothing
    
    Dim intCols As Integer
    intRows = intRows + 1
    intCols = 22
    ClipToGrid msfGrid, Str, intRows, intCols
    
End Sub

Private Sub msfGrid_DblClick()
    Command1_Click 2
End Sub