frmdetail.frm

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

Attribute VB_Exposed = False
Option Explicit

Public mTitle As String
Public mWorkNo As String
Public mDeptID As String
Public mNeedToRefresh As Boolean
Public mIsToLook As Boolean

Dim mPicNotSel As Picture
Dim mPicSel As Picture
Dim mPicHeight As Integer
Dim mPicWidth As Integer

Const PICSPACE = 45
Const SHIFTPICSPACE = 340 'TOP
Const DAYPICSPACE = 40 'TOP
Const WEEKPICSPACE = 420
Const INILEFT = 135 '450
Const INITOP = 690 '1515
Const COLCOUNT = 7
'*******fraPlan
Const FRATOP = 830
Const FRALEFT = 315
Const FRAWIDTH = 5490
Const FRASPACE = 120

'******optPlan
Const OPTPLANLEFT = 240
Const OPTPLANTOP = 350
Const OPTPLANWIDTH = 500
Const OPTPLANHEIGHT = 450
Const FRASHIFTWIDTH = 3700

Const ShiftCount = 6

Const FRASHIFTPLANSPACE = 630

Const STRPLAN = "排班表"
Const STRYEAR = "年"
Const STRMONTH = "月"
Const STRPLANDETAIL = "具体排班"
Const STRPLANLOOK = "查看排班"

Const FRACMDSPACE = 400
Const mMsg1 = "抱歉,排班保存未成功!"
Const mMsg2 = "恭喜,排班保存成功!"


Private Sub SetPic()
    Set mPicNotSel = imgNotSel.Picture
    Set mPicSel = imgSel.Picture
    mPicHeight = imgNotSel.Height
    mPicWidth = imgNotSel.Width
    Dim I As Integer
    For I = 0 To lblWeek.Count - 1
        With lblWeek(I)
            .Left = INILEFT + (mPicWidth + PICSPACE) * I _
                + (mPicWidth - Me.TextWidth(.Caption)) / 2
            .Top = INITOP - WEEKPICSPACE
        End With
    Next
End Sub

Private Sub cmdPlan_Click(Index As Integer)
    Select Case Index
        Case 0
            If SaveData Then
                mNeedToRefresh = True
                Me.Hide
            End If
        Case 1
            mNeedToRefresh = False
            Me.Hide
    End Select
End Sub

Private Function SaveData() As Boolean
    Dim EmpRst As Recordset
    Dim DeptID As Integer
    Dim Sql As String
    Dim strWorkNo As String
    Dim IsTrans As Boolean
    On Error GoTo SaveErr
    BeginTrans
    IsTrans = True
    If Trim(mDeptID) <> Empty Then
        DeptID = CInt(Val(mDeptID))
        Sql = "select WorkNo from Employee where DeptID=" & DeptID
        Set EmpRst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
        While Not EmpRst.EOF
            strWorkNo = Trim(EmpRst!WorkNo)
            If Not SaveDataToDatabase(strWorkNo) Then GoTo SaveErr
            EmpRst.MoveNext
        Wend
        EmpRst.Close
        Set EmpRst = Nothing
    Else
        If Trim(mWorkNo) <> Empty Then
            strWorkNo = Trim(mWorkNo)
            If Not SaveDataToDatabase(strWorkNo) Then GoTo SaveErr
        End If
    End If
    CommitTrans
    IsTrans = False
    SaveData = True
    
    MsgBox mMsg2, vbInformation, gTitle
    Exit Function
SaveErr:
    If IsTrans Then Rollback
    MsgBox mMsg1 & vbCrLf & Err.Description, vbCritical, gTitle
    Err.Clear
    SaveData = False
End Function

Private Function SaveDataToDatabase(strWorkNo As String) As Boolean
    Dim Sql As String
    Dim I As Integer
    Dim IntShift As Integer
    Dim intDay As Integer
    On Error GoTo SaveDataErr
    For I = 0 To lblDay.Count - 1
        intDay = CInt(Val(lblDay(I)))
        IntShift = CInt(Val(lblShift(I).Tag))
        Sql = "Update " & gPlanTableName & " set F_Shift=" & IntShift _
            & " where WorkNo='" & strWorkNo & "' and F_Day=" & intDay
        gDataBase.Execute Sql
    Next
    SaveDataToDatabase = True
    Exit Function
SaveDataErr:
    Err.Clear
    SaveDataToDatabase = False
    'Resume Next
End Function

Private Sub Form_Load()
'    Dim Str As String
'    Str = App.Path + "\data\kq.mdb"
'    Set gDataBase = Workspaces(0).OpenDatabase(Str, False, False, ";pwd=wsh2000")
    
    fraPlan.Caption = Year(Date) & STRYEAR _
        & Format(Month(Date), "00") & STRMONTH _
        & Space(0) & STRPLAN
    SetPic
    SetDesk
    
    SetlblTitle
    SetCaption
End Sub

Private Sub SetCaption()
    Dim Str As String
    If mIsToLook Then
        Str = STRPLANLOOK
    Else
        Str = STRPLANDETAIL
    End If
    Me.Caption = Str
End Sub

Private Sub SetlblTitle()
    With lblTitle
        .Caption = mTitle
        .Left = (Me.Width - Me.TextWidth(Trim(.Caption))) / 2
    End With
End Sub

Private Sub ClearImages()
    Dim Count As Integer
    Count = imgPlan.Count
    While Count <> 1
        Unload imgPlan(Count - 1)
        Unload lblShift(Count - 1)
        Unload lblDay(Count - 1)
        Count = imgPlan.Count
    Wend
    Count = optShift.Count
    While Count <> 1
        Unload optShift(Count - 1)
    Wend
End Sub

Private Sub SetDesk()
    Dim I As Integer
    Dim DayRow As Integer
    Dim DayCol As Integer
'    Dim Row As Integer
    Dim Cols As Integer
    Dim FirstWeekDay As Integer
    
    ClearImages
    
    For I = 1 To gMaxDay - 1
        Load imgPlan(I)
        Load lblShift(I)
        Load lblDay(I)
    Next
    
    GetShift
    
    FirstWeekDay = Weekday(DateSerial(Year(Date), Month(Date), 1))
    DayRow = 0
    Cols = FirstWeekDay - 1
    For I = 0 To gMaxDay - 1
        DayCol = Cols Mod COLCOUNT
        DayRow = Cols \ COLCOUNT
        imgPlan(I).Left = INILEFT + (mPicWidth + PICSPACE) * DayCol
        imgPlan(I).Top = INITOP + (mPicHeight + PICSPACE) * DayRow
        imgPlan(I).Visible = True
        Cols = Cols + 1
        
        With lblDay(I)
            .Caption = I + 1
            .Left = imgPlan(I).Left + (mPicWidth - Me.TextWidth(.Caption)) / 2
            .Top = imgPlan(I).Top + DAYPICSPACE
            .Visible = True
            .ZOrder 0
        End With
        
        With lblShift(I)
            .Left = imgPlan(I).Left + (mPicWidth - Me.TextWidth("A")) / 2
            .Top = imgPlan(I).Top + SHIFTPICSPACE
            .Visible = True
            .ZOrder 0
        End With
    Next
    
    If Not mIsToLook Then
        Dim Rst As Recordset
        Set Rst = gDataBase.OpenRecordset("select ID,ShiftName " _
            & "from Shift   where ID<>" & gNoShift _
            & " order by ID", dbOpenSnapshot)
        For I = 1 To Rst.RecordCount '- 1
            Load optShift(I)
        Next
        'SHIFTCOUNT
        
        I = 0
        DayRow = 0
        Cols = 0
        Dim H As Integer
        While Not Rst.EOF
            DayCol = Cols Mod ShiftCount
            DayRow = Cols \ ShiftCount
            With optShift(I)
                .Caption = Trim(Rst!ShiftName)
                .Tag = CStr(Rst!ID)
                If Rst!ID <= UBound(aInnerShift) Then
                    For H = 1 To UBound(aInnerShift)
                        If Rst!ID = aInnerShift(H).ID Then
                            .ToolTipText = aInnerShift(H).Note
                            Exit For
                        End If
                    Next
                End If
                If I = 0 Then
                    .Left = OPTPLANLEFT
                    .Top = OPTPLANTOP
                Else
                    .Left = OPTPLANLEFT + (OPTPLANWIDTH + PICSPACE) * DayCol 'optShift(0).Width
                    .Top = OPTPLANTOP + (OPTPLANHEIGHT + PICSPACE) * DayRow 'optShift(0).Width
                    .Visible = True
                End If
            End With
            I = I + 1
            Cols = I
            Rst.MoveNext
        Wend
        Rst.Close
        Set Rst = Nothing
    End If
    'Next
    
    
    '******fraPlan
    With fraPlan
        .Left = FRALEFT
        .Top = FRATOP
        .Width = FRAWIDTH
        .Height = imgPlan(imgPlan.Count - 1).Top + mPicHeight _
            + PICSPACE + FRASPACE
    End With
    With fraShift
        .Left = fraPlan.Left + fraPlan.Width + FRASHIFTPLANSPACE
        If mIsToLook Then
            Me.Width = .Left - 200
        End If
        .Top = fraPlan.Top
        .Height = fraPlan.Height
        .Width = FRASHIFTWIDTH
    End With
    
    With fraCmd
        .Top = fraPlan.Top + fraPlan.Height + FRACMDSPACE
        .Left = (Me.Width - .Width) / 2
        Me.Height = .Top + .Height + FRACMDSPACE + 200
        cmdPlan(0).Visible = Not mIsToLook
        If mIsToLook Then
            cmdPlan(1).Left = (.Width - cmdPlan(1).Width) / 2
        End If
    End With
End Sub

Private Sub GetShift()
    If mWorkNo = Empty Then Exit Sub
    Dim Rst As Recordset
    Dim Sql As String
    Dim I As Integer
    Sql = "select ShiftName,ID from " & gPlanQryName _
        & " where WorkNo='" & mWorkNo & "'" _
        & " order by F_Day"
    Set Rst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
    I = 0
    While Not Rst.EOF
        With lblShift(I)
            .Caption = IIf(IsNull(Rst!ShiftName), "", Trim(Rst!ShiftName))
            .Tag = IIf(IsNull(Rst!ID), gNoShift, CStr(Rst!ID))
        End With
        Rst.MoveNext
        I = I + 1
    Wend
    Rst.Close
    Set Rst = Nothing
End Sub

Private Function GetPicture(isSel As Boolean) As Picture
    If isSel Then
        Set GetPicture = mPicSel
    Else
        Set GetPicture = mPicNotSel
    End If
End Function

Private Sub imgPlan_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    With imgTemp
        Set imgTemp = GetPicture(True)
        .Left = imgPlan(Index).Left
        .Top = imgPlan(Index).Top
        .Width = imgPlan(Index).Width
        .Height = imgPlan(Index).Height
        .Tag = Index
        If Not .Visible Then .Visible = True
    End With
    
    If Not mIsToLook Then
        Dim I As Integer
        Dim intIndex As Integer
        For I = 0 To optShift.Count - 1
            If optShift(I).Value Then
                intIndex = I
                Exit For
            End If
        Next
        With lblShift(Index)
            .Caption = optShift(intIndex).Caption
            .Tag = optShift(intIndex).Tag
        End With
    End If
End Sub

Private Sub lblDay_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    imgPlan_MouseDown Index, Button, Shift, X, Y
End Sub

Private Sub lblShift_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    imgPlan_MouseDown Index, Button, Shift, X, Y
End Sub