www.pudn.com > 考勤管理系统源码(VB含串口接口程序).zip > frmDetail.frm
VERSION 5.00
Begin VB.Form frmDetail
BorderStyle = 3 'Fixed Dialog
Caption = "具体排班"
ClientHeight = 6150
ClientLeft = 45
ClientTop = 330
ClientWidth = 10440
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmDetail.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6150
ScaleWidth = 10440
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.Frame fraCmd
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 600
Left = 4440
TabIndex = 13
Top = 5400
Width = 3000
Begin VB.CommandButton cmdPlan
Caption = "保存(&S)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 525
Index = 0
Left = 0
TabIndex = 15
Top = 0
Width = 1275
End
Begin VB.CommandButton cmdPlan
Caption = "返回(&R)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 525
Index = 1
Left = 1688
TabIndex = 14
Top = 0
Width = 1275
End
End
Begin VB.Frame fraPlan
Caption = "排班表"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4185
Left = 315
TabIndex = 3
Top = 830
Width = 5490
Begin VB.Image imgTemp
Height = 630
Left = 1935
Top = 4035
Visible = 0 'False
Width = 720
End
Begin VB.Label lblWeek
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "日"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808000&
Height = 240
Index = 0
Left = 300
TabIndex = 12
Top = 1425
Width = 270
End
Begin VB.Label lblWeek
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "一"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808000&
Height = 240
Index = 1
Left = 1050
TabIndex = 11
Top = 1425
Width = 270
End
Begin VB.Label lblWeek
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "二"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808000&
Height = 240
Index = 2
Left = 1800
TabIndex = 10
Top = 1425
Width = 270
End
Begin VB.Label lblWeek
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "三"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808000&
Height = 240
Index = 3
Left = 2550
TabIndex = 9
Top = 1425
Width = 270
End
Begin VB.Label lblWeek
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "四"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808000&
Height = 240
Index = 4
Left = 3300
TabIndex = 8
Top = 1425
Width = 270
End
Begin VB.Label lblWeek
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "五"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808000&
Height = 240
Index = 5
Left = 4050
TabIndex = 7
Top = 1425
Width = 270
End
Begin VB.Label lblWeek
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "六"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808000&
Height = 240
Index = 6
Left = 4800
TabIndex = 6
Top = 1425
Width = 270
End
Begin VB.Label lblShift
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "*"
ForeColor = &H00FF0000&
Height = 240
Index = 0
Left = 345
TabIndex = 5
Top = 615
Width = 120
End
Begin VB.Label lblDay
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 210
Index = 0
Left = 345
TabIndex = 4
Top = 360
Width = 135
End
Begin VB.Image imgPlan
Height = 660
Index = 0
Left = 75
Picture = "frmDetail.frx":000C
Top = 225
Visible = 0 'False
Width = 705
End
End
Begin VB.Frame fraShift
Caption = "请选择班次"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4320
Left = 6435
TabIndex = 1
Top = 830
Width = 3705
Begin VB.OptionButton optShift
BackColor = &H00C0C0C0&
Caption = "J"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 450
Index = 0
Left = 240
Style = 1 'Graphical
TabIndex = 2
Top = 330
Width = 500
End
End
Begin VB.Image imgNotSel
Height = 660
Left = 3060
Picture = "frmDetail.frx":044E
Top = 6120
Visible = 0 'False
Width = 705
End
Begin VB.Image imgSel
Height = 660
Left = 3930
Picture = "frmDetail.frx":0890
Top = 6105
Visible = 0 'False
Width = 705
End
Begin VB.Label lblTitle
AutoSize = -1 'True
BackColor = &H00C0C0C0&
Caption = "2000年5月排班情况"
ForeColor = &H000040C0&
Height = 240
Left = 3840
TabIndex = 0
Top = 210
Width = 2040
End
End
Attribute VB_Name = "frmDetail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
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