frmchange.frm

考勤管理系统源码

        Exit Sub
    End If
    
    Dim OneShift As String
    Dim TwoShift As String
    OneShift = Trim(txtOne(mlblShift))
    TwoShift = Trim(txtTwo(mlblShift))
    
    If OneShift = TwoShift Then
        MsgBox mMsg2, vbInformation, gTitle
        Exit Sub
    End If
    
    Dim OneShiftID As Integer
    Dim OneWorkNo As String
    Dim OneDay As Integer
    Dim OneDate As String
    Dim TwoDate As String
    Dim TwoDay As Integer
    Dim TwoWorkNo As String
    Dim TwoShiftID As Integer
    Dim IsTrans As Boolean
    Dim AllowMan As String
    Dim Sql As String
    Dim OperateDate As String
    
    On Error GoTo AllowErr
    AllowMan = Trim(txtAllow)
    OneShiftID = CInt(Val(txtOne(mlblShift).Tag))
    TwoShiftID = CInt(Val(txtTwo(mlblShift).Tag))
    OneWorkNo = Trim(txtOne(mlblName).Tag)
    TwoWorkNo = Trim(txtTwo(mlblName).Tag)
    OneDate = Trim(txtOne(mlblDate))
    TwoDate = Trim(txtTwo(mlblDate))
    OneDay = Day(CDate(OneDate))
    TwoDay = Day(CDate(TwoDate))
    OperateDate = Format(Date, "yyyy-mm-dd")
    
    
    BeginTrans
    IsTrans = True
    Sql = " insert into ChangePlan  " _
        & "(WorkNo,ChangeDate,AllowMan,OperateMan," _
        & "OperateDate,SourceWorkNo) values('" _
        & OneWorkNo & "','" & OneDate & "','" _
        & AllowMan & "','" & gUserID & "','" _
        & OperateDate & "','" & TwoWorkNo & "')"
    gDataBase.Execute Sql
    Sql = " insert into ChangePlan  " _
        & "(WorkNo,ChangeDate,AllowMan,OperateMan," _
        & "OperateDate,SourceWorkNo) values('" _
        & TwoWorkNo & "','" & TwoDate & "','" _
        & AllowMan & "','" & gUserID _
        & "','" & OperateDate & "','" _
        & OneWorkNo & "')"
    gDataBase.Execute Sql
    Sql = "update " & gPlanTableName & " set F_Shift=" _
        & TwoShiftID & " where WorkNo='" & OneWorkNo _
        & "' and F_Day=" & OneDay
    gDataBase.Execute Sql
    
    Sql = "update " & gPlanTableName & " set F_Shift=" _
        & OneShiftID & " where WorkNo='" & TwoWorkNo _
        & "' and F_Day=" & TwoDay
    gDataBase.Execute Sql
    
    CommitTrans
    IsTrans = False
    MsgBox mMsg5, vbInformation, gTitle
    IniText
    Exit Sub
AllowErr:
    If IsTrans Then Rollback
    MsgBox mMsg4 & vbCrLf & vbCrLf _
        & Err.Description, vbExclamation, gTitle
    Err.Clear
End Sub

Private Sub IniText()
    Dim I As Integer
    For I = 0 To txtOne.Count - 1
        txtOne(I) = Empty
        txtOne(I).Tag = Empty
    Next
    For I = 0 To txtTwo.Count - 1
        txtTwo(I) = Empty
        txtOne(I).Tag = Empty
    Next
    txtAllow = Empty
End Sub

Private Sub cmdReturn_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim Str As String
    
    Str = App.Path & "/Data/Hand.ico"
    If Dir(Str) <> Empty Then
        Set mHandIco = LoadPicture(Str)
    Else
        Set mHandIco = Nothing
    End If
    
    SetIco
    
    '    Dim Str As String
'    Str = App.Path + "\data\kq.mdb"
'    Set gDataBase = Workspaces(0).OpenDatabase(Str, False, False, ";pwd=wsh2000")
'    SetPlanTableName
'    gUserID = "Wsh"
End Sub

Private Sub SetIco()
    Dim I As Integer
    For I = 0 To lblOne.Count - 2
        lblOne(I).MousePointer = 99
        Set lblOne(I).MouseIcon = mHandIco
    Next
    For I = 0 To lblTwo.Count - 2
        lblTwo(I).MousePointer = 99
        Set lblTwo(I).MouseIcon = mHandIco
    Next
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    OutMouseMove
End Sub


Private Sub OutMouseMove()
    If lblOne(mOldIndex).ForeColor = OVERCOLOR Then
        With lblOne(mOldIndex)
            .ForeColor = OUTCOLOR
            .Left = .Left - OFFSETX
            .Top = .Top - OFFSETY
        End With
    End If
    If lblTwo(mOldIndex).ForeColor = OVERCOLOR Then
        With lblTwo(mOldIndex)
            .ForeColor = OUTCOLOR
            .Left = .Left - OFFSETX
            .Top = .Top - OFFSETY
        End With
    End If
    mOldIndex = MAXCOUNT
End Sub
Private Sub MouseMove(lblTemp As Label, Index As Integer)
    If Index = lblOne.Count - 1 Then Exit Sub
    If mOldIndex = Index Then Exit Sub
    With lblTemp
        .Left = .Left + OFFSETX
        .Top = .Top + OFFSETY
        .ForeColor = OVERCOLOR
    End With
    mOldIndex = Index
End Sub


Private Sub fraOne_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    OutMouseMove
End Sub

Private Sub fraTwo_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    OutMouseMove
End Sub

Private Sub lblOne_Click(Index As Integer)
    If Index = mlblShift Then Exit Sub
    Select Case Index
        Case mlblDept, mlblName
            Dim MyfrmLookMan  As frmLookMan
            Set MyfrmLookMan = New frmLookMan
            With MyfrmLookMan
                .Show vbModal
                txtOne(mlblDept) = .mDept
                txtOne(mlblName) = .mName
                txtOne(mlblName).Tag = .mWorkNo
            End With
            Unload MyfrmLookMan
        Case mlblDate
            lblDateClick txtOne(Index)
    End Select
    ShowShift txtOne(mlblName), txtOne(mlblDate), txtOne(mlblShift)
End Sub

Private Sub lblOne_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    MouseMove lblOne(Index), Index
End Sub

Private Sub lblTwo_Click(Index As Integer)
    If Index = mlblShift Then Exit Sub
    Select Case Index
        Case mlblDept, mlblName
            Dim MyfrmLookMan  As frmLookMan
            Set MyfrmLookMan = New frmLookMan
            With MyfrmLookMan
                .Show vbModal
                txtTwo(mlblDept) = .mDept
                txtTwo(mlblName) = .mName
                txtTwo(mlblName).Tag = .mWorkNo
            End With
            Unload MyfrmLookMan
        Case mlblDate
            lblDateClick txtTwo(Index)
    End Select
    ShowShift txtTwo(mlblName), txtTwo(mlblDate), txtTwo(mlblShift)
End Sub

Private Sub ShowShift(txtName As TextBox, txtDate As TextBox, txtShift As TextBox)
    If Trim(txtName) = Empty Or Trim(txtDate) = Empty Then Exit Sub
    
DateErr:
    Dim DateIsValid As Boolean
    If Month(CDate(txtDate)) <> Month(Date) Then
        DateIsValid = False
    Else
        DateIsValid = True
    End If
    If Not DateIsValid Then
        MsgBox mMsg1, vbCritical, gTitle
        lblDateClick txtDate
        GoTo DateErr
        Exit Sub
    End If
    
    Dim strWorkNo As String
    Dim intDay As Integer
    Dim Rst As Recordset
    Dim Sql As String
    
    txtShift = ""
    strWorkNo = Trim(txtName.Tag)
    intDay = Day(CDate(txtDate))
    Sql = "select ID,ShiftName from " & gPlanQryName & " where " _
        & " WorkNo='" & strWorkNo & "' and F_Day=" _
        & intDay
    Set Rst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
    If Rst.RecordCount > 0 Then
        If Rst!ID = gNoShift Then
            txtShift = mNotDefine
            txtShift.Tag = gNoShift
        Else
            txtShift = IIf(IsNull(Rst!ShiftName), mNotDefine, Trim(Rst!ShiftName))
            txtShift.Tag = Rst!ID
        End If
    End If
    Rst.Close
    Set Rst = Nothing
End Sub

Private Sub lblTwo_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    MouseMove lblTwo(Index), Index
End Sub

Private Sub lblDateClick(lblTemp As TextBox)
    Dim myfrmRiLi As frmRiLi
    Set myfrmRiLi = New frmRiLi
    With myfrmRiLi
        .Show vbModal
        If .mRetDate <> Empty Then
            lblTemp = .mRetDate
        End If
    End With
    Unload myfrmRiLi
End Sub

Private Sub txtAllow_Change()
    cmdAllow.Enabled = (Trim(txtAllow) <> Empty)
End Sub