www.pudn.com > 考勤管理系统源码(VB含串口接口程序).zip > frmPlan.frm
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmPlan
BorderStyle = 3 'Fixed Dialog
Caption = "日常排班"
ClientHeight = 8625
ClientLeft = 45
ClientTop = 330
ClientWidth = 11910
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmPlan.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 8625
ScaleWidth = 11910
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin ComctlLib.TreeView tvwPlan
Height = 6360
Left = 135
TabIndex = 0
Top = 450
Width = 1665
_ExtentX = 2937
_ExtentY = 11218
_Version = 327682
LabelEdit = 1
Style = 6
Appearance = 1
End
Begin VB.Frame Frame1
Height = 1140
Left = 195
TabIndex = 2
Top = 7020
Width = 11460
Begin VB.CommandButton cmdPlan
Caption = "返回(&R)"
Height = 555
Index = 5
Left = 9630
TabIndex = 8
Top = 375
Width = 1530
End
Begin VB.CommandButton cmdPlan
Caption = "打印排班表(&P)"
Enabled = 0 'False
Height = 555
Index = 4
Left = 7767
TabIndex = 7
Top = 375
Width = 1530
End
Begin VB.CommandButton cmdPlan
Caption = "查看排班(&L)"
Enabled = 0 'False
Height = 555
Index = 0
Left = 315
TabIndex = 6
Top = 375
Width = 1530
End
Begin VB.CommandButton cmdPlan
Caption = "集体排班(&G)"
Enabled = 0 'False
Height = 555
Index = 1
Left = 2178
TabIndex = 5
Top = 375
Width = 1530
End
Begin VB.CommandButton cmdPlan
Caption = "单个排班(&S)"
Enabled = 0 'False
Height = 555
Index = 2
Left = 4041
TabIndex = 4
Top = 375
Width = 1530
End
Begin VB.CommandButton cmdPlan
Caption = "查找员工(&Y)"
Enabled = 0 'False
Height = 555
Index = 3
Left = 5904
TabIndex = 3
Top = 375
Width = 1530
End
End
Begin MSFlexGridLib.MSFlexGrid msfGrid
Bindings = "frmPlan.frx":000C
Height = 6375
Left = 1815
TabIndex = 1
Top = 450
Width = 9915
_ExtentX = 17489
_ExtentY = 11245
_Version = 393216
FixedCols = 0
AllowBigSelection= 0 'False
HighLight = 0
End
Begin VB.Label lblPlan
AutoSize = -1 'True
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000040C0&
Height = 240
Left = 4950
TabIndex = 9
Top = 105
Width = 120
End
End
Attribute VB_Name = "frmPlan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mNode As Node
Dim mFormatString As String
Dim mAllowGroup As Boolean
Dim mDeptID As Integer
Dim mDeptName As String
Const mLog = "R"
Const mYEAR = "年"
Const mMONTH = "月"
Const mPlanStr = "的排班情况"
Const mMsg1 = "抱歉,初始化表不成功,您不能进入排班!!"
'********
Const mLookPlan = 0
Const mGroupPlan = 1
Const mSinglePlan = 2
Const mLookEmp = 3
Const mPrintPlan = 4
Const mClosePlan = 5
'*****msfGrid
Const mGridWorkNo = 1
Const mGridName = 0
'***frmdetail.mtitle
Const mstrDui = "对"
Const mstrEmployee = "的员工"
Const mstrDoPlan = "进行排班"
Const mstrLook = "查看"
Const mstrPlan = "的排班"
Private Sub cmdPlan_Click(Index As Integer)
Select Case Index
Case mGroupPlan, mSinglePlan, mLookPlan
If msfGrid.Rows <= msfGrid.FixedRows Then Exit Sub
DoPlan Index
Case mLookEmp
DoLookEmp
Case mPrintPlan
Dim tmpStr As String
tmpStr = gOwnName & "-" & Me.Caption
PrintGridNormal tmpStr, _
msfGrid, 1, "", True
Case mClosePlan
Unload Me
End Select
End Sub
Private Sub DoLookEmp()
Dim MyfrmLookMan As frmLookMan
Dim Sql As String
Dim strWorkNo As String
Dim DeptName As String
Dim i As Integer
Dim NodX As Node
Dim H As Integer
Set MyfrmLookMan = New frmLookMan
With MyfrmLookMan
.Show vbModal
strWorkNo = Trim(.mWorkNo)
DeptName = Trim(.mDept)
End With
If strWorkNo <> Empty Then
If DeptName <> Trim(mNode.Text) Then
For i = 0 To tvwPlan.Nodes.Count - 1
If Trim(tvwPlan.Nodes(i).Text) = DeptName Then
Set NodX = tvwPlan.Nodes(i)
tvwPlan_NodeClick NodX
Exit For
End If
Next
End If
With msfGrid
CloseColor msfGrid
If .Redraw Then .Redraw = False
For i = .FixedRows To .Rows - 1
If Trim(.TextMatrix(i, mGridWorkNo)) = strWorkNo Then
For H = 0 To .Cols - 1
.row = i
.col = H
.CellBackColor = gCellSelBackColor
.CellForeColor = gCellSelForeColor
Next
Exit For
End If
Next
.Redraw = True
End With
End If
Unload MyfrmLookMan
End Sub
Private Sub DoPlan(Index As Integer)
Dim MyfrmDetail As frmDetail
Set MyfrmDetail = New frmDetail
Dim strName As String
Dim strTemp As String
With MyfrmDetail
If Index = mGroupPlan Then
If Not mAllowGroup Then Exit Sub
.mDeptID = mDeptID
.mWorkNo = Trim(msfGrid.TextMatrix _
(msfGrid.FixedRows, mGridWorkNo))
.mTitle = mstrDui & "[" & mDeptName & "]" & mstrDoPlan
.mIsToLook = False
Else
.mDeptID = Empty
.mWorkNo = Trim(msfGrid.TextMatrix _
(msfGrid.row, mGridWorkNo))
strName = Trim(msfGrid.TextMatrix(msfGrid.row, mGridName))
If Index = mSinglePlan Then
strTemp = mstrDui
Else
strTemp = mstrLook
End If
strTemp = strTemp & "[" & mDeptName & "]" & mstrEmployee _
& "[" & strName & "]"
If Index = mSinglePlan Then
.mTitle = strTemp & mstrDoPlan
.mIsToLook = False
Else
.mTitle = strTemp & mstrPlan
.mIsToLook = True
End If
End If
'.mTableName = Trim(mTableName)
'.mQryName = Trim(gCMDQUERY)
.Show vbModal
If .mNeedToRefresh Then tvwPlan_NodeClick mNode
Unload MyfrmDetail
End With
End Sub
Private Sub Form_Load()
mAllowGroup = True
If Not CreatePlanTable Then
MsgBox mMsg1, vbCritical, gTitle
End '若用unload me 会造成循环显示上面的提示
End If
Me.Caption = Format(Year(Date), "0000") & mYEAR _
& Format(Month(Date), "00") & mMONTH _
& Space(2) & Me.Caption
mFormatString = "<姓名 " & vbTab _
& "^卡号 " & vbTab
IniMyGrid
AddDataToTreeView
End Sub
Private Sub IniMyGrid()
Dim i As Integer
For i = 1 To gMaxDay
mFormatString = mFormatString & CStr(i)
If i <> gMaxDay Then mFormatString = mFormatString & vbTab
Next
SetGridColor msfGrid
msfGrid.FormatString = mFormatString
End Sub
Private Sub AddDataToTreeView()
Dim i As Integer
Dim NodX As Node
With tvwPlan
If UBound(aDepartment) < 1 Then Exit Sub
For i = 1 To UBound(aDepartment)
.Nodes.Add , , mLog & aDepartment(i).ID, _
aDepartment(i).Name
Next
End With
Set NodX = tvwPlan.Nodes(1)
tvwPlan_NodeClick NodX
End Sub
Private Sub msfGrid_DblClick()
cmdPlan_Click mLookPlan
End Sub
Private Sub tvwPlan_NodeClick(ByVal Node As ComctlLib.Node)
' Dim DeptID As Integer
' Dim QD As QueryDef
' Dim DeptRst As Recordset
Dim EmpRst As Recordset
Dim ShiftRst As Recordset
Dim Sql As String
Dim strWorkNo As String
Dim strName As String
Dim strShift As String
Dim Str As String
Dim intRows As Integer
Dim intCols As Integer
Set mNode = Node
'mNodeIndex=tvwplan.Nodes
mAllowGroup = True
mDeptID = CInt(Val(Mid(Node.Key, Len(mLog) + 1)))
mDeptName = Trim(Node.Text)
' Set QD = gDataBase.QueryDefs(mQuery)
'QD.Parameters("DeptID") = DeptID
'Set DeptRst = QD.OpenRecordset(dbOpenSnapshot)
Sql = "select distinct Name,WorkNo from " & gPlanQryName _
& " where DeptID=" & mDeptID _
& " order by WorkNo"
Set EmpRst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
While Not EmpRst.EOF
intRows = intRows + 1
strName = Trim(EmpRst!Name)
strWorkNo = Trim(EmpRst!WorkNo)
Str = Str & strName & vbTab & strWorkNo & vbTab
Sql = "select ShiftName from " & gPlanQryName _
& " where WorkNo='" & strWorkNo _
& "' order by F_Day"
Set ShiftRst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
While Not ShiftRst.EOF
strShift = IIf(IsNull(ShiftRst!ShiftName), "", Trim(ShiftRst!ShiftName))
If mAllowGroup Then
If strShift <> Empty Then mAllowGroup = False
End If
Str = Str & strShift & vbTab
ShiftRst.MoveNext
Wend
ShiftRst.Close
Set ShiftRst = Nothing
If Not EmpRst.EOF Then Str = Str & vbCr
EmpRst.MoveNext
Wend
EmpRst.Close
Set EmpRst = Nothing
intRows = intRows + 1
intCols = gMaxDay + 2 'col name and workno
ClipToGrid msfGrid, Str, intRows, intCols
ChangeTolblPlan Trim(Node.Text)
ChangeToCmdPlan
End Sub
Private Sub ChangeToCmdPlan()
Dim i As Integer
Dim IsAllowChange As Boolean
IsAllowChange = (msfGrid.Rows > msfGrid.FixedRows)
For i = 0 To cmdPlan.Count - 2
cmdPlan(i).Enabled = IsAllowChange
If IsAllowChange Then
If i = mGroupPlan Then
cmdPlan(i).Enabled = mAllowGroup
End If
End If
Next
End Sub
Private Sub ChangeTolblPlan(Str As String)
Dim intLeft As Integer
lblPlan = Str & mPlanStr
intLeft = CInt((Me.Width - Me.TextWidth(lblPlan.Caption)) / 2)
lblPlan.Left = intLeft
End Sub