www.pudn.com > 考勤管理系统源码(VB含串口接口程序).zip > frmMonth.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 frmMonth
BorderStyle = 3 'Fixed Dialog
Caption = "月统计报表"
ClientHeight = 7320
ClientLeft = 45
ClientTop = 330
ClientWidth = 10500
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmMonth.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7320
ScaleWidth = 10500
StartUpPosition = 1 '所有者中心
Begin ComctlLib.StatusBar stbMsg
Align = 2 'Align Bottom
Height = 450
Left = 0
TabIndex = 14
Top = 6870
Width = 10500
_ExtentX = 18521
_ExtentY = 794
SimpleText = ""
_Version = 327682
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 1
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 1
Object.Width = 18468
Key = ""
Object.Tag = ""
Object.ToolTipText = "警告信息"
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MouseIcon = "frmMonth.frx":000C
End
Begin VB.CommandButton Command1
Height = 435
Index = 0
Left = 8955
Picture = "frmMonth.frx":0326
Style = 1 'Graphical
TabIndex = 13
Top = 210
Width = 1230
End
Begin VB.CommandButton Command1
Height = 435
Index = 1
Left = 8955
Picture = "frmMonth.frx":211A
Style = 1 'Graphical
TabIndex = 12
Top = 757
Width = 1230
End
Begin VB.CommandButton Command1
Cancel = -1 'True
Height = 435
Index = 2
Left = 8955
Picture = "frmMonth.frx":4085
Style = 1 'Graphical
TabIndex = 11
Top = 1305
Width = 1230
End
Begin VB.Frame Frame1
Height = 1650
Left = 6075
TabIndex = 4
Top = 90
Width = 2535
Begin VB.ComboBox cboMonth
Height = 330
Left = 720
Style = 2 'Dropdown List
TabIndex = 16
Top = 240
Width = 1665
End
Begin VB.ComboBox cboDept
Height = 330
Left = 720
Style = 2 'Dropdown List
TabIndex = 7
Top = 697
Width = 1665
End
Begin VB.TextBox txtEmp
Height = 330
Left = 720
TabIndex = 6
Top = 1155
Width = 1350
End
Begin VB.CommandButton Command2
Caption = "…"
Height = 330
Left = 2070
TabIndex = 5
Top = 1155
Width = 330
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "月份:"
Height = 210
Index = 0
Left = 150
TabIndex = 15
Top = 300
Width = 525
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "部门:"
Height = 210
Index = 2
Left = 150
TabIndex = 9
Top = 757
Width = 525
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "员工:"
Height = 210
Index = 3
Left = 150
TabIndex = 8
Top = 1215
Width = 525
End
End
Begin VB.Frame fra1
Height = 1650
Left = 255
TabIndex = 0
Top = 90
Width = 5610
Begin VB.OptionButton optKq
Caption = "全部(包括以上两者)"
Height = 270
Index = 2
Left = 180
TabIndex = 3
Top = 1200
Width = 2190
End
Begin VB.OptionButton optKq
Caption = "正常考勤(包括正常出勤,休息)"
Height = 270
Index = 1
Left = 180
TabIndex = 2
Top = 765
Width = 4005
End
Begin VB.OptionButton optKq
Caption = "非正常考勤(包括请假,出差,有薪假期,旷工,迟到等)"
Height = 270
Index = 0
Left = 180
TabIndex = 1
Top = 330
Value = -1 'True
Width = 5130
End
End
Begin MSFlexGridLib.MSFlexGrid msfGrid
Height = 4635
Left = 240
TabIndex = 10
Top = 1995
Width = 9960
_ExtentX = 17568
_ExtentY = 8176
_Version = 393216
FixedCols = 0
AllowBigSelection= 0 'False
HighLight = 2
ScrollBars = 2
AllowUserResizing= 1
End
End
Attribute VB_Name = "frmMonth"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mSelQryName As String
Const mFormatString = "^工号 |<姓 名 |<部 门 " _
& "|<日期 |<类型 |<备注 "
'*****optKq
Const mABNORMAL = 0
Const mNORMAL = 1
Const mALL = 2
'****msfGrid
Const mWorkNo = 0
Const mName = 1
Const mDept = 2
Const mDATE = 3
Const mTYPE = 4
Const mNote = 5
Const mGridCols = 6
'Const
'Const mKUANGGONG = "旷工"
Const mMonthStr = "月统计报表"
Const mSTARTTIMESTR = "起始时间 "
Const mENDTIMESTR = "截至时间 "
Const mWHOLEDAYSTR = "整天"
Const mTOSTR = "-"
Const mINWORKSTR = "上班"
Const mOUTWORKSTR = "下班"
Const mMsg1 = "系统正在统计当中,请您休息一下..."
Const mMsg2 = "统计完成,请您继续作您的工作!!"
Const mMsg3 = "抱歉,统计未完成!"
Const mMsg4 = "该记录被删除"
Const mMsg5 = "没有生成排班表或排班表已被删除,统计不能进行!!!"
Dim mSql As String
Dim mRst As Recordset
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0
If Not CheckQryIsExist Then
MsgBox cboMonth.Text & mMsg5, vbInformation, gTitle
Exit Sub
End If
stbMsg.Panels(1).Text = mMsg1
Dim Fr As frmMsg
Set Fr = New frmMsg
Fr.Label1 = mMsg1
Fr.Show
Fr.Refresh
Me.Enabled = False
Me.MousePointer = 11
If FindPlan Then
stbMsg.Panels(1).Text = mMsg2
Me.Enabled = True
Me.MousePointer = 0
End If
Unload Fr
Case 1
Dim tmpStr As String
If Trim(cboDept.Text) <> gALLDEPTNAME Then
tmpStr = Trim(cboDept.Text)
End If
If Trim(txtEmp) <> Empty Then
If tmpStr <> Empty Then
tmpStr = tmpStr & "的员工"
End If
tmpStr = tmpStr & Trim(txtEmp)
End If
If optKq(mNORMAL).Value Then
tmpStr = tmpStr & "正常考勤"
End If
If optKq(mABNORMAL).Value Then
tmpStr = tmpStr & "非正常考勤"
End If
If optKq(mALL).Value Then
tmpStr = tmpStr & "全部考勤"
End If
tmpStr = tmpStr & "的记录"
PrintGridNormal gOwnName & "-" & Me.Caption, _
msfGrid, 1, tmpStr, True
Case 2
Unload Me
End Select
End Sub
Private Function CheckQryIsExist() As Boolean
Dim tmpTableName As String
tmpTableName = Right(Year(Date), 2) & Val(cboMonth.Text)
mSelQryName = gQRY & tmpTableName
If HasThisQuery(mSelQryName) Then
Me.Caption = Year(Date) & "年" _
& Format(Val(cboMonth.Text), _
"00") & "月 " & mMonthStr
CheckQryIsExist = True
Else
CheckQryIsExist = False
End If
End Function
Private Sub Command2_Click()
Dim Frm As frmLookMan
Set Frm = New frmLookMan
With Frm
.Show vbModal
txtEmp = .mWorkNo
End With
End Sub
Private Sub Form_Load()
SetGridColor msfGrid
msfGrid.FormatString = mFormatString
With cboMonth
.Clear
Dim I As Integer
For I = 1 To Month(Date)
.AddItem Format(I, "00") & " 月"
Next
.ListIndex = Month(Date) - 1
End With
With cboDept
.Clear
FillCbo cboDept, aDepartment, 0
End With
'gPlanTableName
End Sub
Private Function FindPlan() As Boolean
Dim intDeptID As Integer
Dim strWorkNo As String
Dim strDept As String
Dim WhereFlag As Boolean
Dim Str As String
Dim intRows As Integer
'On Error GoTo FindErr
getItemData cboDept, intDeptID
strDept = Trim(cboDept.Text)
strWorkNo = Trim(txtEmp)
mSql = "select * from " & mSelQryName 'gPlanQryName
If strWorkNo <> Empty Then
mSql = mSql & JoinSqlStr(strWorkNo, WhereFlag, "WorkNo", True)
End If
If intDeptID <> gMAXITEM Then mSql = mSql & JoinSqlStr(intDeptID, WhereFlag, "DeptID", False)
mSql = mSql & " order by WorkNo,F_Day"
Set mRst = gDataBase.OpenRecordset(mSql)
Dim IsContinue As Boolean
Dim IntShift As Integer
'Dim strWorkNo As String
Dim strDate As String
Dim strKqTime As String
Dim blnNormal As Boolean
Dim blnIsAll As Boolean
Dim blnIsNormal As Boolean
'Dim intRows As Long
blnIsAll = (optKq(mALL).Value = True)
blnIsNormal = (optKq(mNORMAL).Value = True)
With mRst
While Not .EOF
IsContinue = True
IntShift = !ID
strWorkNo = Trim(!WorkNo)
strKqTime = Empty
strDate = Year(Date) & "-" _
& Format(Month(Date), "00") & "-" _
& Format(CStr(!F_Day), "00")
blnNormal = IsNormal(IntShift, strWorkNo, strDate, strKqTime)
If blnIsAll Then
IsContinue = True
Else
If blnIsNormal Then
If Not blnNormal Then IsContinue = False
Else
If blnNormal Then IsContinue = False
End If
End If
If IsContinue Then
intRows = intRows + 1
Str = Str & strWorkNo & vbTab & _
IIf(IsNull(!Name), "", Trim(!Name)) & vbTab
intDeptID = !DeptID
Str = Str & GetDept(intDeptID) & vbTab _
& !F_Day & vbTab
If blnIsAll Then
If blnNormal Then
GetNormalKq Str, IntShift, strKqTime
Else
GetAbNormal Str, IntShift, strKqTime, strDate, strWorkNo
End If
Else
If blnIsNormal Then '正常
GetNormalKq Str, IntShift, strKqTime
Else '非正常
GetAbNormal Str, IntShift, strKqTime, strDate, strWorkNo
End If
End If
If Not .EOF Then Str = Str & vbCr
End If
.MoveNext
Wend
End With
intRows = intRows + msfGrid.FixedRows
ClipToGrid msfGrid, Str, intRows, mGridCols
With msfGrid
.MergeCells = flexMergeRestrictRows
.MergeCol(mWorkNo) = True
.MergeCol(mName) = True
.MergeCol(mDept) = True
End With
FindPlan = True
Exit Function
FindErr:
MsgBox mMsg3 & vbCrLf & Err.Description, vbCritical, gTitle
stbMsg.Panels(1).Text = mMsg3
FindPlan = False
Err.Clear
Me.Enabled = True
Me.MousePointer = 0
End Function
Private Sub GetAbNormal(Str As String, IntShift As Integer, strKqTime As String, strDate As String, strWorkNo As String)
Select Case IntShift
Case gNOSHIFT '未排班
Str = Str & gNOSHIFTNAME & vbTab
Case GSHIFTLEAVEID, GSHIFTEVECTIONID, GSHIFTMONEYID
If IntShift = GSHIFTLEAVEID Then '请假
Str = Str & GSHIFTLEAVESTR & vbTab
GetNote Str, True, strDate, strWorkNo, False
Else
If IntShift = GSHIFTEVECTIONID Then '出差
Str = Str & GSHIFTEVECTIONSTR & vbTab
GetNote Str, False, strDate, strWorkNo, True
ElseIf IntShift = GSHIFTMONEYID Then '有薪假期
Str = Str & GSHIFTMONEYSTR & vbTab
GetNote Str, False, strDate, strWorkNo, False
End If
End If
Case Else
If strKqTime <> Empty Then '迟到
Str = Str & gWORKLATE & vbTab & strKqTime
Else '旷工
Str = Str & gNOTINWORK & vbTab
End If
End Select
End Sub
Private Sub GetNote(Str As String, isLeave As Boolean, strDate As String, strWorkNo As String, isEvection As Boolean)
Dim Sql As String
Dim WhereFlag As Boolean
Sql = Sql & "select StartTime,EndTime,StartDate,EndDate from "
If isLeave Then
Sql = Sql & "Leave"
WhereFlag = False
Else
Sql = Sql & "Absent"
Sql = Sql & " Where IsEvection="
If isEvection Then
Sql = Sql & gTRUE
Else
Sql = Sql & gFALSE
End If
WhereFlag = True
End If
If WhereFlag Then
Sql = Sql & " and "
Else
Sql = Sql & " Where "
End If
Sql = Sql & " WorkNo='" & strWorkNo _
& "' and StartDate<='" & strDate _
& "' and EndDate>='" & strDate & "'" _
& " and F_DelFlag=" & gFALSE _
& " order by StartTime"
Dim Rst As Recordset
Set Rst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
If Rst.RecordCount > 0 Then
With Rst
If strDate = Trim(!StartDate) And strDate = Trim(!EndDate) Then '在同一天之内
Str = Str & mSTARTTIMESTR & Trim(!StartTime) _
& Space(1) & mENDTIMESTR & Trim(!EndTime)
Else
If strDate = Trim(!StartDate) Then '此天等于起始日期
Str = Str & mSTARTTIMESTR & Trim(!StartTime) _
& Space(1) & mTOSTR & Space(1) & mOUTWORKSTR
ElseIf strDate = Trim(!EndDate) Then '此天等于截至日期
Str = Str & mINWORKSTR & Space(1) _
& mTOSTR & Space(1) & mENDTIMESTR & Trim(!EndTime)
Else '当中
Str = Str & mWHOLEDAYSTR
End If
End If
End With
Else
Str = Str & mMsg4
End If
Rst.Close
Set Rst = Nothing
End Sub
Private Sub GetNormalKq(Str As String, IntShift As Integer, strKqTime As String)
If IntShift = GSHIFTRESTID Then '休息
Str = Str & GSHIFTRESTSTR & vbTab
Else '正常出勤
Str = Str & gNORMALKQSTR & vbTab & strKqTime
End If
End Sub
Private Function IsNormal(IntShift As Integer, strWorkNo As String, strDate As String, strKqTime As String) As Boolean
If IntShift = GSHIFTRESTID Then
IsNormal = True
Exit Function
Else
If IsNormalKq(IntShift, strWorkNo, strDate, strKqTime) Then
IsNormal = True
Exit Function
End If
End If
IsNormal = False
End Function
Private Function GetDept(intDeptID As Integer) As String
Dim I As Integer
For I = 0 To UBound(aDepartment)
With aDepartment(I)
If .ID = intDeptID Then
GetDept = Trim(.Name)
Exit Function
End If
End With
Next
GetDept = Empty
End Function