www.pudn.com > VB-KAOQINXITONG.zip > frmWkTmRetouch.frm
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{CFBDEFBA-4F23-11D7-910C-00000E55E64F}#5.0#0"; "BNListTree.ocx"
Object = "{B9D938CE-50EE-40B2-9FA2-79A3112F4788}#4.2#0"; "BNCtrlGroup.ocx"
Begin VB.Form frmWkTmRetouch
ClientHeight = 4230
ClientLeft = 2085
ClientTop = 2280
ClientWidth = 4230
Icon = "frmWkTmRetouch.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 4230
ScaleWidth = 4230
StartUpPosition = 2 '屏幕中心
Begin MSComctlLib.ProgressBar ProgressBar1
Align = 2 'Align Bottom
Height = 135
Left = 0
TabIndex = 15
Top = 3795
Visible = 0 'False
Width = 4230
_ExtentX = 7461
_ExtentY = 238
_Version = 393216
Appearance = 0
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 300
Left = 0
TabIndex = 14
Top = 3930
Width = 4230
_ExtentX = 7461
_ExtentY = 529
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 2
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 4392
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin VB.ListBox lstEvents
Height = 2940
Left = 4515
TabIndex = 13
Top = 60
Width = 4035
End
Begin VB.Frame Frame1
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 3825
Left = 0
TabIndex = 1
Top = -75
Width = 4185
Begin BNListTreeProj.BNListTree BNListTree1
Height = 330
Left = 240
TabIndex = 2
Top = 270
Width = 3840
_ExtentX = 6773
_ExtentY = 503
BeginProperty ToolTipFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TreeHeight = 211
TreePos = 1
TreeVisible = 0 'False
SizeLock = 0 'False
BarWidth = 187
Text = ""
End
Begin VB.Timer tmrExcute
Enabled = 0 'False
Interval = 100
Left = 3555
Top = 3870
End
Begin BNCtrlGroup.BNButton cmdStop
Height = 375
Left = 1440
TabIndex = 6
Tag = "Stop"
Top = 3030
Width = 1200
_ExtentX = 2117
_ExtentY = 661
Caption = "停 止"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin BNCtrlGroup.BNButton cmdExit
Cancel = -1 'True
Height = 375
Left = 2670
TabIndex = 7
Tag = "Exit"
Top = 3030
Width = 1200
_ExtentX = 2117
_ExtentY = 661
Caption = "退 出"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin BNCtrlGroup.BNButton cmdCalWkTm
Height = 375
Left = 210
TabIndex = 5
Tag = "Excute"
Top = 3030
Width = 1200
_ExtentX = 2117
_ExtentY = 661
Caption = "计 算"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin MSComCtl2.DTPicker dtpRange
Height = 330
Index = 1
Left = 1290
TabIndex = 4
Top = 1740
Width = 2805
_ExtentX = 4948
_ExtentY = 582
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 23789568
CurrentDate = 36455
End
Begin MSComCtl2.DTPicker dtpRange
Height = 330
Index = 0
Left = 1290
TabIndex = 3
Top = 1270
Width = 2805
_ExtentX = 4948
_ExtentY = 582
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 23789568
CurrentDate = 36455
MaxDate = 44196
MinDate = 35431
End
Begin BNCtrlGroup.BNComboBox cobEmployee
Height = 330
Left = 1305
TabIndex = 0
Top = 800
Width = 2805
_ExtentX = 0
_ExtentY = 0
BackColor = 14737632
BackColor = 14737632
BackColor = 14737632
End
Begin VB.CheckBox chkAutoSign
Alignment = 1 'Right Justify
Appearance = 0 'Flat
Caption = "自动签卡:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 18
Top = 2265
Width = 1335
End
Begin BNCtrlGroup.BNButton cmdFind
Height = 375
Index = 0
Left = 2565
TabIndex = 8
Tag = "See"
Top = 2205
Width = 1530
_ExtentX = 2699
_ExtentY = 661
Caption = "按卡号查找"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin VB.Line Line1
BorderColor = &H80000010&
BorderStyle = 6 'Inside Solid
Index = 3
X1 = 30
X2 = 4155
Y1 = 2865
Y2 = 2865
End
Begin VB.Line Line1
BorderColor = &H80000005&
BorderStyle = 6 'Inside Solid
Index = 2
X1 = 30
X2 = 4185
Y1 = 2880
Y2 = 2880
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "部 门:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 0
Left = 120
TabIndex = 11
Top = 360
Width = 840
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "员 工:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 1
Left = 120
TabIndex = 12
Top = 840
Width = 840
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "开始日期:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 120
TabIndex = 10
Top = 1320
Width = 945
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "结束日期:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 120
TabIndex = 9
Top = 1800
Width = 945
End
End
Begin BNCtrlGroup.BNButton cmdClear
Height = 345
Left = 4545
TabIndex = 16
Tag = "Delete"
Top = 3300
Width = 1335
_ExtentX = 2355
_ExtentY = 609
Caption = "清除事件"
CapAlign = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin BNCtrlGroup.BNButton cmdSave
Height = 345
Left = 6015
TabIndex = 17
Tag = "Save"
Top = 3300
Width = 1335
_ExtentX = 2355
_ExtentY = 609
Caption = "保存事件"
CapAlign = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
End
Attribute VB_Name = "frmWkTmRetouch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'以下是关于表 T6621a001(考勤明细) 中的字段定义
'A0186: 状态标志 C6675: 夜班工时 E6649: 工伤 E6682: 旷工2
'A0187: 加班类型 C6680: 额定正班工时 E6651: 公休假 E6683: 旷工3
'A0189: 员工编号 E0122: 机构编号 E6653: 补休假 E6684: 旷工4
'B0110: 单位编号 E6600: 考勤登记时间 E6655: 厂休假 E6685: 旷工5
'C6609: 日正班段工时 E6602: 日正班段加班 E6656: 停工 E6686: 旷工6
'C6610: 星期 E6603: 特卡工时 E6657: 计生假 E6687: 旷工7
'C6616: 休日工时 E6604: 应上工时 E6658: 年假 E6688: 旷工8
'C6617: 日加班工时 E6606: 出勤工时 E6659: 婚检假 E6691: 早退1
'C6618: 法定假工时 E6608: 标准工时 E6660: 其他假1 E6692: 早退2
'C6621: 班次时间1 E6609: 平日特卡工时 E6661: 产检假 E6693: 早退3
'C6622: 班次时间2 E6610: 休日特卡工时 E6662: 放假 E6694: 早退4
'C6623: 班次时间3 E6611: 节假日特卡工时 E6663: 其他假2 E6695: 扣罚5
'C6624: 班次时间4 E6623: 旷工工时 E6664: 其他假3 E6696: 扣罚6
'C6625: 班次时间5 E6625: 报表出勤天数 E6665: 出差 E6697: 扣罚7
'C6626: 班次时间6 E6626: 出勤天数 E6667: 外勤 E6698: 扣罚8
'C6627: 班次时间7 E6627: 迟到工时 E6671: 迟到1 E6699: 班次代码
'C6628: 班次时间8 E6630: 加班段工时 E6672: 迟到2 ID: 索引
'C6630: 班次调整工时 E6633: 早退工时 E6673: 迟到3 W0075: 状态
'C6631: 打卡1 E6635: 调休工时 E6674: 迟到4 W0076: 状态2
'C6632: 打卡2 E6636: 总扣罚工时 E6675: 扣罚1 W0030: 备注
'C6633: 打卡3 E6637: 病假 E6676: 扣罚2 W6622: 早班天数
'C6634: 打卡4 E6639: 事假 E6677: 扣罚3 W6623: 白班天数
'C6635: 打卡5 E6641: 婚假 E6678: 扣罚4 W6624: 夜班天数
'C6636: 打卡6 E6643: 产假 E6679: 有工时假 W6646: 工作状态标志
'C6637: 打卡7 E6645: 丧假 E6680: 无工时假 W6648: 特卡起始时间
'C6638: 打卡8 E6647: 探亲假 E6681: 旷工1 W6649: 特卡结束时间
Option Explicit
Dim mbStop As Boolean
Dim mlWidth As Long
Dim mlCardID As Long
Dim mTDateRange As DateRange
Dim msEmpNum As String
Dim madoEmployeeRS As ADODB.Recordset
Dim madoResultRS As ADODB.Recordset
Dim madoSwitchRS As ADODB.Recordset
Dim mTWorkChange() As WorkChange
Dim msDebugFields As String
Private Sub Form_Unload(Cancel As Integer)
Set madoEmployeeRS = Nothing
Set madoResultRS = Nothing
Set madoSwitchRS = Nothing
SavePickStruct BNListTree1, mTDateRange, cobEmployee
End Sub
'本段程序加编号的原因是：一旦计算出错，便知道在哪行
Private Sub tmrExcute_Timer()
Dim sCondition As String
Dim sSQL As String
Dim bSelectAll As Boolean
Dim l As Long
Dim lTemp As Long
Dim sinTemp As Single
Dim i As Integer
Dim bFlag As Boolean
Dim iSaturday() As Integer
Dim sSplitMan
Dim DRange As DateRange
10 On Error GoTo ErrLabel
' 关闭定时器,避免代码重复执行.
20 tmrExcute.Enabled = False
' 在计算过程中,计算机根据此标志决定是否继续计算,如果此标志置位,则停止计算.
30 mbStop = False
'|***************************** 选择员工开始 ************************************
'|*
'|* 如果所给出的条件无效,则根本不进行计算!函数退出.
40 If Not IsValidSQL(BNListTree1.UnitList, BNListTree1.DeptList, _
cobEmployee.Text, mTDateRange.DStart, mTDateRange.DEnd, cobEmployee.ListCount) Then GoTo StopCalcute
' 如果经过检验有效,则继续进行计算.此时,将选择员工列表中显示的值.
' 在后面,我们会看到,如果显示的值为VALUE_ALL_STR,则计算员工列表中所有
'的员工,否则,只计算显示出的那个员工.
' 得到员工列表中的数值
'判断部门是否全部被选择了
50 If BNListTree1.Nodes.Count = BNListTree1.SelectedCount Then
60 bSelectAll = True
70 End If
80 msEmpNum = gclsCommon.CBNGetFirstData(cobEmployee.Text)
90 If msEmpNum = VALUE_ALL_STR Then
' 如果显示为VALUE_ALL_STR,则通过函数 CBNGetComboList 来得到全部员工的工号列表,
'用逗号分割,后面,通过转换,将这些合法的员工直接放到 SQL 查询语句中.
100 msEmpNum = gclsCommon.CBNGetComboList(cobEmployee)
110 End If
120 sSplitMan = Split(msEmpNum, ",")
130 ReDim iSaturday(UBound(sSplitMan))
'|*
'|**************************** 选择员工结束 ************************************
' 置鼠标忙标志
140 Screen.MousePointer = vbHourglass
'置位进度工具条
150 ProgressBar1.Value = 0
160 StatusBar1.Panels(1).Text = "正在修正出勤"
' 在计算时,将使某些按纽失效
170 cmdCalWkTm.Enabled = False
180 cmdExit.Enabled = False
'|************************* 加载考勤明细数据开始 ************************************
'|*
190 StatusBar1.Panels(1).Text = "加载考勤明细数据"
200 sSQL = gclsCommon.CBNGetCondition(BNListTree1.UnitList, BNListTree1.DeptList, msEmpNum, _
"E6600", gclsInclude.MyDateOf(mTDateRange.DStart), gclsInclude.MyDateOf(mTDateRange.DEnd))
210 sSQL = IIf(sSQL = "", "", " WHERE " & sSQL)
220 sSQL = gclsCommon.CBNCSql(Trim("SELECT * FROM T6621A001 " & sSQL))
230 Set madoResultRS = New ADODB.Recordset
240 madoResultRS.Open sSQL, gDBRecordConn, adOpenStatic, adLockOptimistic
250 If madoResultRS.RecordCount = 0 Then
260 MsgBox "指定的范围内没有考勤数据，请先计算后在运行本修正程序！"
270 GoTo StopCalcute
280 End If
'|*
'|************************* 加载考勤明细数据结束 ************************************
'|************************* 加载换班状态开始 ************************************
'|*
290 StatusBar1.Panels(1).Text = "加载换班状态数据"
300 sSQL = gclsCommon.CBNGetCondition(BNListTree1.UnitList, BNListTree1.DeptList, msEmpNum, _
"W6616,W6617", gclsInclude.MyDateOf(mTDateRange.DStart), gclsInclude.MyDateOf(mTDateRange.DEnd))
310 sSQL = IIf(sSQL = "", "", " WHERE " & sSQL)
320 sSQL = gclsCommon.CBNCSql(Trim("SELECT * FROM T6650A001 " & sSQL))
330 Set madoSwitchRS = New ADODB.Recordset
340 madoSwitchRS.Open sSQL, gDBRecordConn, adOpenStatic, adLockOptimistic
'|*
'|************************* 加载考勤明细数据结束 ************************************
'|************************* 加载工时调换数据开始 ************************************
'|*
350 sCondition = gclsCommon.CBNGetCondition(BNListTree1.UnitList, BNListTree1.DeptList, msEmpNum, _
"W6616", gclsInclude.MyDateOf(mTDateRange.DStart), gclsInclude.MyDateOf(mTDateRange.DEnd))
360 sCondition = IIf(sCondition = "", "", " WHERE" & sCondition)
370 StatusBar1.Panels(1).Text = "正在加载工时调换数据"
380 If sCondition <> "" Then
390 i = InStr(1, sCondition, "(W6616")
400 sSQL = Mid(sCondition, i)
410 sSQL = Left(sCondition, i - 1) & "(" & sSQL & " OR " & Replace(sSQL, "W6616", "W6617") & ") ORDER BY A0189"
420 mTWorkChange = GetWorkChange(sSQL)
430 Else
440 ReDim mTWorkChange(0)
450 End If
'|*
'|************************* 加载工时调换数据结束 ************************************
460 For i = 1 To UBound(mTWorkChange)
'情况1、6 ，在表T6650A001中，如果存在该调换数据，则在成功调换后将标志A0196=1
470 If mTWorkChange(i).FromDate < mTDateRange.DStart Or mTWorkChange(i).FromDate > mTDateRange.DEnd Then
' MsgBox "情况1、6" '(模式1)
480 If LoCanSwitchWork(1, mTWorkChange(i), sinTemp) Then
490 If sinTemp > 0 Then
500 LoWorkTo mTWorkChange(i), sinTemp
510 End If
520 End If
'情况2和情况5，在表T6650A001中写入新的调换数据，并将标志A0196=0
530 ElseIf mTWorkChange(i).ToDate < mTDateRange.DStart Or mTWorkChange(i).ToDate > mTDateRange.DEnd Then
' MsgBox "情况2、5" '(模式2)
540 If LoWorkFrom(mTWorkChange(i), sinTemp) Then '如果调换成功
550 If LoCanSwitchWork(2, mTWorkChange(i), sinTemp) Then
560 End If
570 End If
'情况3和情况4，成功调换后在表T6650A001中写入新的调换数据，并将标志A0196=1
580 Else '情况3、4
' MsgBox "情况3、4" '(模式3)
'如果有休工时，则调换休工时即可
590 If LoWorkFrom(mTWorkChange(i), sinTemp) Then '如果调换成功
600 If LoCanSwitchWork(3, mTWorkChange(i), sinTemp) Then
610 LoWorkTo mTWorkChange(i), sinTemp
620 Else
630 MsgBox "LoCanSwitchWork Err"
640 End If
650 Else
660 MsgBox "LoWorkFrom Err"
670 End If
680 End If
690 Next i
700 If gTAttendCtl.MustAddTime = 0 Then GoTo LastProcessLabel
710 madoResultRS.Filter = 0
' 将进度条的最大值设置为要计算的员工值,这样,每计算一个员工,进度条将增加一个值
720 ProgressBar1.Max = madoResultRS.RecordCount
730 ProgressBar1.Visible = True
740 With madoResultRS
750 For l = 1 To .RecordCount
760 DoEvents
770 If mbStop Then GoTo StopCalcute
780 StatusBar1.Panels(1).Text = "出勤修正" & !A0189 & "的数据"
790 If !E6606 = 0 And !C6616 = 0 Then GoTo NextLabel '没有日工时也没有休日工时
800 ProgressBar1.Value = l
810 If (!W6646 And WK_SATURDAY) > 0 And (!W6646 And WK_REST) > 0 Then '周六超过八小时的都是特卡
' 本代码仅针对客户B,林朝2002-7-3日邮件说:
' 对于月薪,加班类型为9的问题,修正:
' 1.星期六的加班段加班算调休,同平时一样,不应算加班工资,例:17:00-18:00
'这一小时是有加班费,18:00之后的加班不计加班费.
' 2.星期天加班算调休,不算加班费。
' 3.当月有5个星期六的,最后一个星期六的加班工时算调休,或者可以不来上班,
'来上班的可以算调休,总之每个月的休工时,只能是算4个星期六的加班工时.
' 但是,在2002-7-10日,客户B的林朝打电话说,休日的工时只计算每月最多4个周六
'9小时内的工时,对于周日以及超出4个周六的工时,则全部记为调休.
820 If !A0187 = 9 Then 'A0187: 加班类型
830 For i = 0 To UBound(iSaturday)
840 If sSplitMan(i) = !A0189 Then
850 lTemp = i
860 Exit For
870 End If
880 Next i
890 If !C6616 > 0 Then 'C6616:休日工时
'2003-1-15日根据林朝的要求将以下的为改为5
900 If iSaturday(lTemp) < 5 Then '只计算前4周的周六工时
910 iSaturday(lTemp) = iSaturday(lTemp) + 1
920 Else
930 GoTo RestProcessLabel
940 End If
950 End If
960 End If
970 If !C6616 > !E6608 Then
980 !W6646 = !W6646 Or WK_SPECARD
990 If !A0187 = 9 Then
1000 If !C6616 > !C6680 Then 'C6680: 正班工时
1010 !E6603 = !C6680 - !E6608
1020 !E6635 = !C6616 - !E6608 - !E6603
1030 If !E6635 < 0 Then !E6635 = 0
1040 Else
1050 !E6603 = !C6616 - !E6608 'E6608: 标准工时
1060 End If
1070 Else
1080 !E6603 = !C6616 - !E6608
1090 End If
1100 !C6616 = !E6608 'C6616: 休日工时
1110 !E6630 = !E6630 - !E6603 - !E6635: If !E6630 < 0 Then !E6630 = 0 'E6630: 加班段工时
1120 !C6609 = !E6608 'C6609: 日正班段工时
1130 !E6602 = 0 'E6602: 日正班段加班
1140 !E6610 = !E6603
1150 If gTAttendCtl.FeastRestToDay Then
1160 !E6606 = !C6616
1170 End If
1180 LoCalculateSpeCard WK_SATURDAY
1190 End If
1200 ElseIf !W6646 And WK_FEAST Then
1210 If !C6618 > gTAttendCtl.MustAddTime Then '法定假超过3小时为特卡
1220 !W6646 = !W6646 Or WK_SPECARD
1230 !E6603 = !C6618 - gTAttendCtl.MustAddTime
1240 !C6618 = gTAttendCtl.MustAddTime
1250 !E6606 = !E6606 - !E6603
1260 !E6630 = !E6630 - !E6603
1270 !E6611 = !E6603
1280 .Update
1290 LoCalculateSpeCard WK_FEAST
1300 End If
1310 ElseIf !C6616 > 0 Then '周日全天都是特卡
RestProcessLabel:
1320 If !A0187 = 9 Then
1330 !W6646 = !W6646 Or WK_SWITCHREST
1340 !E6635 = !C6616
1350 Else
1360 !W6646 = !W6646 Or WK_SPECARD
1370 !E6603 = !C6616
1380 !E6610 = !E6603
1390 End If
1400 !C6609 = 0 'C6609: 日正班段工时
1410 !C6616 = 0 'C6616: 休日工时
1420 !E6630 = 0 'E6630: 加班段工时
1430 !E6625 = 0 'E6625:
1440 LoCalculateSpeCard WK_REST
1450 ElseIf !C6617 > gTAttendCtl.MustAddTime Then '日加班工时
1460 !W6646 = !W6646 Or WK_SPECARD
1470 !E6603 = !C6617 - gTAttendCtl.MustAddTime 'E6603: 特卡段工时
1480 !C6617 = !C6617 - !E6603
1490 !E6630 = !E6630 - !E6603 'E6630: 加班段工时
1500 If !E6630 < 0 Then
1510 !C6609 = !C6609 + !E6630 'C6609: 日正班段工时
1520 !E6602 = !E6602 + !E6630: If !E6602 < 0 Then !E6602 = 0 'E6602: 日正班段加班
1530 !E6630 = 0
1540 End If
1550 !E6606 = !E6606 - !E6603 'E6606: 出勤工时
1560 !E6609 = !E6603
1570 .Update
1580 LoCalculateSpeCard WK_OVERTIME
1590 End If
NextLabel:
1600 For i = 1 To CLASS_SEC * 2
1610 If .Fields("C663" & i) > 0 Then
1620 gDBRecordConn.Execute gclsCommon.CBNCSql("UPDATE T0109A001 SET W1113 = '0' WHERE (A0189 = '" & !A0189 & "') AND (W0031 = #" & .Fields("C663" & i) & "#) AND (W1113 <> '1')")
1630 End If
1640 Next i
1650 .MoveNext
1660 Next l
1670 End With
LastProcessLabel:
'将表中所有的打卡数据为零的项置为空
1680 For i = 1 To CLASS_SEC * 2
1690 sSQL = gclsCommon.CBNGetCondition(BNListTree1.UnitList, BNListTree1.DeptList, msEmpNum, _
"E6600", gclsInclude.MyDateOf(mTDateRange.DStart), gclsInclude.MyDateOf(mTDateRange.DEnd))
1700 sSQL = IIf(sSQL = "", "", " AND " & sSQL)
1710 If gTAppLicInfo.SoftNetwork Then
1720 sSQL = "UPDATE T6621A001 SET C663" & i & " = NULL WHERE (C663" & i & " = '1899-12-30')" & sSQL
1730 Else
1740 sSQL = "UPDATE T6621A001 SET C663" & i & " = NULL WHERE (C663" & i & " = #0#)" & sSQL
1750 End If
1760 gDBRecordConn.Execute sSQL
1770 Next i
StopCalcute:
1780 StatusBar1.Panels(1).Text = "出勤修正计算完毕"
1790 Screen.MousePointer = vbNormal
1800 msEmpNum = ""
1810 mbStop = False
1820 cmdCalWkTm.Enabled = True
1830 cmdExit.Enabled = True
1840 ProgressBar1.Visible = False
1850 Exit Sub
ErrLabel:
LoShowErr "发生错误,错误号=" & Err & ",错误原因=" & Err.Description & ",位置=" & Erl
LoShowErr "错误位置:员工号=" & msEmpNum & ",错误模块=cmdCalWkTmClick"
Resume Next
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdStop_Click()
mbStop = True
End Sub
Private Sub dtpRange_Click(Index As Integer)
Select Case Index
Case 0
mTDateRange.DStart = dtpRange(Index).Value
If mTDateRange.DStart > mTDateRange.DEnd Then
dtpRange(1 - Index).Value = mTDateRange.DStart
mTDateRange.DEnd = mTDateRange.DStart
End If
Case 1
mTDateRange.DEnd = dtpRange(Index).Value
If mTDateRange.DStart > mTDateRange.DEnd Then
dtpRange(1 - Index).Value = mTDateRange.DEnd
mTDateRange.DStart = mTDateRange.DEnd
End If
End Select
End Sub
Private Sub dtpRange_Change(Index As Integer)
dtpRange_Click Index
End Sub
Private Sub lstEvents_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 0 Then ' 如果没有按钮被按下
lstEvents.ToolTipText = gclsInclude.MyGetLstText(lstEvents, x, y)
End If
End Sub
Private Sub Form_Load()
On Error GoTo ErrLabel
LoSetButtonTag
SetIcon Me
mbStop = False
BNListTree1.RefuseDeptList = gTOperRight.RefuseDeptRight
gclsCommon.CBNFillBNListTree BNListTree1
LoadPickStruct BNListTree1, mTDateRange, cobEmployee
dtpRange(0).Value = mTDateRange.DStart
dtpRange(1).Value = mTDateRange.DEnd
mlCardID = 0
Caption = "员工考勤计算修正"
mlWidth = Me.Width
msDebugFields = "A0186,A0187,A0189,B0110,C6609,C6610,C6616,C6617,C6618,C6621,C6622,C6623,C6624,C6625,C6626,C6630," & _
"C6631,C6632,C6633,C6634,C6635,C6636,C6675,C6680,E0122,E6600,E6602,E6603,E6604,E6606,E6608," & _
"E6623,E6626,E6627,E6630,E6633,E6635,E6636,E6699,W0030,W6646,W6648,W6649"
Exit Sub
ErrLabel:
LoShowErr "发生错误,错误号=" & Err & ",错误原因=" & Err.Description & ",错误模块=FormLoad"
End Sub
Private Sub Form_Resize()
If Me.Width > 8805 Then
lstEvents.Width = Me.Width - lstEvents.Left - 200
Else
lstEvents.Width = 4035
End If
End Sub
Private Sub cmdClear_Click()
lstEvents.Clear
Me.Width = mlWidth
End Sub
Private Sub cmdCalWkTm_Click()
tmrExcute.Enabled = True
End Sub
Private Sub cmdFind_Click(Index As Integer)
Dim sSQL As String
Dim sField As String
Dim sDeptSQL As String
Dim bCancle As Boolean
Dim sRet As String
sRet = Switch(Index = 0, gTPickStruct.TempNumberLists, Index = 1, gTPickStruct.TempNameLists)
sField = Switch(Index = 0, "A0189", Index = 1, "A0101")
sSQL = gclsCommon.CBNShowSearchWindows(sField, , bCancle, , sRet, sRet)
If sSQL <> "" Then
If sRet <> "" Then
If Index = 0 Then
gTPickStruct.TempNumberLists = sRet
ElseIf Index = 1 Then
gTPickStruct.TempNameLists = sRet
End If
End If
BNListTree1.Text = ""
LoListEmployee "", "", sSQL
Else
If bCancle Then
StatusBar1.Panels(1).Text = "未输入有效的员工"
Else
MsgBox "未输入有效的员工", vbCritical
End If
End If
End Sub
Private Sub LoSetButtonTag()
cmdStop.Tag = "IMG047"
cmdExit.Tag = "IMG029"
cmdCalWkTm.Tag = "IMG028"
cmdClear.Tag = "IMG021"
cmdSave.Tag = "IMG041"
cmdFind(0).Tag = "IMG031"
End Sub
Private Sub LoShowErr(ByVal fsMsg As String)
If Width < 8410 Then
Width = lstEvents.Left + lstEvents.Width + 300
End If
lstEvents.AddItem fsMsg
End Sub
Private Sub LoListEmployee(ByVal fsUnitNo As String, _
ByVal fsDeptNo As String, _
Optional fsEmpList As String)
cobEmployee.Clear
cobEmployee.AddItem VALUE_ALL_STR
cobEmployee.ItemData(cobEmployee.NewIndex) = 0
StatusBar1.Panels(1).Text = "正在加载员工数据"
If Len(fsEmpList) > 0 Then
gclsCommon.CBNFillEmpCombo cobEmployee, "", "", fsEmpList
ElseIf Len(fsUnitNo) + Len(fsDeptNo) > 0 Then
gclsCommon.CBNFillEmpCombo cobEmployee, fsUnitNo, fsDeptNo
End If
If cobEmployee.ListCount > 0 Then cobEmployee.ListIndex = 0
StatusBar1.Panels(1).Text = "加载员工数据完毕"
End Sub
Private Sub BNListTree1_NodeSelect(ByVal UnitLists As String, ByVal DeptLists As String)
If Len(UnitLists) + Len(DeptLists) = 0 Then Exit Sub
LoListEmployee UnitLists, DeptLists
End Sub
Private Function LoCanSwitchWork(fiMode As Integer, fTWorkChange As WorkChange, fsinActValue As Single) As Boolean
'情况1、6(模式1)，在表T6650A001中，如果存在该调换数据，则在成功调换后将标志A0186=1
'情况2、5(模式2)，在表T6650A001中写入新的调换数据，并将标志A0186=0
'情况3、4(模式3)，成功调换后在表T6650A001中写入新的调换数据，并将标志A0186=1
'以下是关于表 T6650A001(工时调换状态) 中的字段定义
'A0186: 状态标志 W6606: 工时数 W6617: 工时被调日期
'A0189: 员工编号 W6616: 工时调换日期
With madoSwitchRS
madoResultRS.Filter = gclsCommon.CBNCSql("A0189 = '" & fTWorkChange.EmplyeeNum & "' AND E6600 = #" & gclsCommon.CBNGetStandDate(fTWorkChange.ToDate) & "#")
LoCanSwitchWork = madoResultRS.RecordCount > 0 '表示可以调换
.Filter = gclsCommon.CBNCSql("(A0189 = '" & fTWorkChange.EmplyeeNum & _
"') AND (W6616 = #" & gclsCommon.CBNGetStandDate(fTWorkChange.ToDate) & "#" & _
") AND (W6617 = #" & gclsCommon.CBNGetStandDate(fTWorkChange.FromDate) & "#)")
Select Case fiMode
Case 1
If .RecordCount > 0 Then
!A0186 = 1
fsinActValue = !W6606
.Update
Else
LoCanSwitchWork = False
End If
Case 2, 3
If .RecordCount = 0 Then
.AddNew
!A0189 = fTWorkChange.EmplyeeNum
!W6617 = fTWorkChange.FromDate
!W6616 = fTWorkChange.ToDate
End If
!W6606 = fsinActValue
!A0186 = IIf(LoCanSwitchWork, IIf(fiMode = 2, 0, 1), 0)
.Update
End Select
End With
End Function
Private Function LoWorkFrom(fTWorkChange As WorkChange, fsinRet As Single) As Boolean
Dim i As Integer
Dim lWorktime As Long
fsinRet = 0
With madoResultRS
.Filter = gclsCommon.CBNCSql("A0189 = '" & fTWorkChange.EmplyeeNum & "' AND E6600 = #" & gclsCommon.CBNGetStandDate(fTWorkChange.FromDate) & "#")
If .RecordCount > 0 Then
If !W6646 And WK_FEAST Then '对于法定假工时，加班部分为：法定假工时+休日工时
If fTWorkChange.FromWorkMode = WK_OVERTIME Then
fsinRet = IIf(!C6618 + !C6616 + !E6602 > fTWorkChange.Value, fTWorkChange.Value, !C6618 + !C6616 + !E6602) 'C6618: 法定假工时;C6616: 休日工时;E6602: 日正班段加班
!C6618 = !C6618 - fsinRet
If !C6618 < 0 Then
!C6616 = !C6616 + !C6618: !C6618 = 0
If !C6616 < 0 Then
!E6602 = !E6602 + !C6616: !C6616 = 0
End If
End If
!E6630 = !E6630 - fsinRet: If !E6630 < 0 Then !E6630 = 0
!E6606 = !E6606 - fsinRet
ElseIf fTWorkChange.FromWorkMode = WK_NORMAL Then
fsinRet = IIf(!E6608 > fTWorkChange.Value, fTWorkChange.Value, !E6608) 'E6608: 标准工时
!E6606 = !E6606 - fsinRet: If !E6606 < 0 Then !E6606 = 0 'E6606: 出勤工时
!C6609 = !C6609 - fsinRet 'C6609: 日正班段工时
If !C6609 < !E6602 Then !C6609 = !E6602 'E6602: 日正班段加班
ElseIf fTWorkChange.FromWorkMode = WK_ALLSWITCH Then
fsinRet = !E6606
!C6609 = 0
!E6630 = 0
!E6602 = 0
!C6618 = 0
!C6616 = 0
!C6617 = 0
For i = 1 To CLASS_SEC * 2
.Fields("C663" & i) = 0
Next i
!E6626 = 0
End If
lWorktime = 0
ElseIf !C6616 > 0 Then '对于休日只有休日工时，因此不必理会是哪种工时
fsinRet = IIf(!C6616 > fTWorkChange.Value, fTWorkChange.Value, !C6616)
!E6606 = !E6606 - fsinRet: If !E6606 < 0 Then !E6606 = 0 'E6606: 出勤工时
If fTWorkChange.FromWorkMode = WK_OVERTIME Then
!C6675 = !C6675 - fsinRet: If !C6675 < 0 Then !C6675 = 0 'C6675: 夜班工时
!E6630 = !E6630 - fsinRet 'E6630: 加班段工时
If !E6630 < 0 Then
!C6609 = !C6609 + !E6630: If !C6609 < 0 Then !C6609 = 0 'C6609: 日正班段工时
!E6630 = 0
End If
ElseIf fTWorkChange.FromWorkMode = WK_NORMAL Then
!C6609 = !C6609 - fsinRet 'C6609: 日正班段工时
If !C6609 < 0 Then
!E6630 = !E6630 + !C6609: If !E6630 < 0 Then !E6630 = 0 'E6630: 加班段工时
!C6609 = 0
End If
ElseIf fTWorkChange.FromWorkMode = WK_ALLSWITCH Then
fsinRet = !C6616
!C6609 = 0
!E6630 = 0
!E6602 = 0
!C6617 = 0
For i = 1 To CLASS_SEC * 2
.Fields("C663" & i) = 0
Next i
!E6626 = 0
End If
!C6616 = !C6616 - fsinRet
lWorktime = !C6616
ElseIf !E6606 > 0 Then 'E6606: 出勤工时
If fTWorkChange.FromWorkMode = WK_OVERTIME Then
fsinRet = IIf(!C6617 > fTWorkChange.Value, fTWorkChange.Value, !C6617) 'C6617: 日加班工时
!E6606 = !E6606 - fsinRet: If !E6606 < 0 Then !E6606 = 0 'E6606: 出勤工时
!C6617 = !C6617 - fsinRet: If !C6617 < 0 Then !C6617 = 0 'C6617: 日加班工时
!E6630 = !E6630 - fsinRet 'E6630: 加班段工时
If !E6630 < 0 Then '还要扣除正班段的加班
!E6602 = !E6602 + !E6630 'E6602: 日正班段加班
!C6609 = !C6609 + !E6630 'C6609: 日正班段工时
!E6630 = 0
End If
!C6675 = !C6675 - fsinRet: If !C6675 < 0 Then !C6675 = 0 'C6675: 夜班工时
ElseIf fTWorkChange.FromWorkMode = WK_NORMAL Then
fsinRet = IIf(!C6609 - !E6602 > fTWorkChange.Value, fTWorkChange.Value, !C6609 - !E6602) 'C6609: 日正班段工时;E6602: 日正班段加班
!E6606 = !E6606 - fsinRet: If !E6606 < 0 Then !E6606 = 0 'E6606: 出勤工时
!C6609 = !C6609 - fsinRet 'C6609: 日正班段工时
If !C6609 < !E6602 Then !C6609 = !E6602 'E6602: 日正班段加班
ElseIf fTWorkChange.FromWorkMode = WK_ALLSWITCH Then
fsinRet = !E6606
!E6606 = 0 'E6606: 出勤工时
!C6609 = 0 'C6609: 日正班段工时
!E6602 = 0 'E6602: 日正班段加班
!C6617 = 0 'C6617: 日加班工时
For i = 1 To CLASS_SEC * 2
.Fields("C663" & i) = 0
Next i
!E6626 = 0
End If
lWorktime = !E6606
ElseIf !E6699 = NO_CLASS Then '对于无班次,工时交换失败
LoWorkFrom = False
Exit Function
End If
If !E6608 > 0 Then !E6626 = lWorktime / !E6608
If !E6626 > 1 Then !E6626 = 1
If fsinRet > 0 Then !W0030 = !W0030 & GetNote(WK_TOCLASS, fsinRet & "T" & Day(fTWorkChange.ToDate))
!W6646 = !W6646 Or WK_FROMCLASS
!E6625 = !E6626
If Left(!W0030, 1) = "," Then !W0030 = Mid(!W0030, 2)
LoMakeOneDayCard
.Update
LoWorkFrom = True
End If
End With
End Function
Private Function LoWorkTo(fTWorkChange As WorkChange, fsinValue As Single) As Boolean
If fsinValue = 0 Then Exit Function
With madoResultRS
.Filter = gclsCommon.CBNCSql("A0189 = '" & fTWorkChange.EmplyeeNum & "' AND E6600 = #" & gclsCommon.CBNGetStandDate(fTWorkChange.ToDate) & "#")
If .RecordCount > 0 Then
LoWorkTo = True
!E6623 = 0 'E6623: 旷工工时
!E6627 = 0 'E6627: 迟到工时
!E6633 = 0 'E6633: 早退工时
!E6636 = 0 'E6636: 总扣罚工时
!E6626 = Round(!E6626 + fsinValue / !E6608, 1) 'E6626: 出勤天数
If !E6626 > 1 Then !E6626 = 1
If !E6606 < 0 Then !E6606 = 0 'E6606: 出勤工时
!W6646 = !W6646 Or WK_TOCLASS
If !E6699 = NO_CLASS Then '对于无班次，则直接将该数据填入结果表中
!E6606 = !E6606 + fsinValue 'E6606: 出勤工时
If fTWorkChange.ToWorkMode = WK_OVERTIME Then
!C6617 = !C6617 + fsinValue 'C6617: 日加班工时
!E6630 = !E6630 + fsinValue 'E6630: 加班段工时
ElseIf fTWorkChange.ToWorkMode = WK_NORMAL Then
!C6609 = !C6609 + fsinValue 'C6609: 日正班段工时
ElseIf fTWorkChange.ToWorkMode = WK_ALLSWITCH Then '全天调换
!C6609 = !C6609 + fsinValue 'C6609: 日正班段工时
End If
!W6646 = !W6646 Or WK_TOCLASS
ElseIf !W6646 And WK_REST Then '如果是周日或周六
If gTAttendCtl.FeastRestToDay Then !E6606 = !E6606 + fsinValue 'E6606: 出勤工时
!C6609 = !C6609 + fsinValue 'C6609: 日正班段工时
!C6616 = !C6616 + fsinValue 'C6616: 休日工时
Else
!E6606 = !E6606 + fsinValue 'E6606: 出勤工时
If fTWorkChange.ToWorkMode = WK_OVERTIME Then
!C6617 = !C6617 + fsinValue 'C6617: 日加班工时
!E6630 = !E6630 + fsinValue 'E6630: 加班段工时
ElseIf fTWorkChange.ToWorkMode = WK_NORMAL Then
!C6609 = !C6609 + fsinValue 'C6609: 日正班段工时
If !C6609 > !E6608 Then 'E6608: 标准工时
!E6602 = !C6609 - !E6608 'E6602: 日正班段加班
!C6617 = !E6630 + !E6602 'C6617: 日加班工时
End If
ElseIf fTWorkChange.ToWorkMode = WK_ALLSWITCH Then '全天调换
'需要重新计算加班以及正班时间,根据当天的班次情况重新安排工时
!C6609 = IIf(!E6606 > !C6680, !C6680, !E6606) 'C6680: 正班工时;C6609: 日加班工时
!E6602 = !C6609 - !E6608: If !E6602 < 0 Then !E6602 = 0 'E6602: 日正班段加班;E6608: 标准工时
!E6630 = !E6606 - !C6609 'E6630: 加班段工时
!C6617 = !E6602 + !E6630 'C6617: 日加班工时
End If
End If
If !W6646 And WK_ABSENT Then !W6646 = !W6646 Xor WK_ABSENT '有旷工
If !W6646 And WK_LATE Then !W6646 = !W6646 Xor WK_LATE '有旷工
If !W6646 And WK_EARLY Then !W6646 = !W6646 Xor WK_EARLY '有旷工
If !W6646 And WK_PUNISH Then !W6646 = !W6646 Xor WK_PUNISH '有旷工
'修改备注，去掉缺卡显示
!W0030 = gclsInclude.MyTrimSymbol(gclsInclude.MyReplace(!W0030 & ",", "缺卡*,", ""))
LoMakeOneDayCard
If fsinValue > 0 Then !W0030 = !W0030 & GetNote(WK_FROMCLASS, _
Switch(fTWorkChange.ToWorkMode = WK_OVERTIME, "加", _
fTWorkChange.ToWorkMode = WK_NORMAL, "正", _
fTWorkChange.ToWorkMode = WK_ALLSWITCH, "全") & _
fsinValue & "F" & Day(fTWorkChange.FromDate))
If Left(!W0030, 1) = "," Then !W0030 = Mid(!W0030, 2)
.Update
End If
End With
End Function
'根据工时以及班次用计算机自动做出一天的卡数据
Private Sub LoMakeOneDayCard()
Dim iCount As Integer
Dim i As Integer
Dim lWorktime As Long
Dim lTotal As Long
Dim sRndSeed(2) As String
Dim DInsertTime() As Date '插入的数据，能显示的卡
Dim bFlag As Boolean
With madoResultRS
sRndSeed(0) = !A0189
sRndSeed(1) = !E6600
ReDim DInsertTime(0)
iCount = !A0186 And 7 '本班次共iCount段
For i = 1 To iCount * 2
.Fields("C663" & i) = 0
Next i
If !W6646 And WK_FEAST Then
lWorktime = 60 * (!C6616 + !C6618)
ElseIf !C6616 > 0 Then
lWorktime = 60 * !C6616
Else
lWorktime = 60 * !E6606
End If
For i = 1 To iCount
bFlag = False
lTotal = lTotal + DateDiff("n", .Fields("C662" & (2 * i - 1)), .Fields("C662" & (2 * i)))
sRndSeed(2) = 2 * i - 1
.Fields("C663" & (2 * i - 1)) = DateAdd("s", -gclsInclude.MyGetFixRandom(sRndSeed) * 200, .Fields("C662" & (2 * i - 1)))
sRndSeed(2) = 2 * i
If lWorktime >= lTotal Then
If i = iCount Then
.Fields("C663" & (2 * i)) = DateAdd("s", 60 * (lWorktime - lTotal) + gclsInclude.MyGetFixRandom(sRndSeed) * 200, .Fields("C662" & (2 * i - 1)))
bFlag = True
Else
.Fields("C663" & (2 * i)) = DateAdd("s", gclsInclude.MyGetFixRandom(sRndSeed) * 200, .Fields("C662" & (2 * i)))
End If
Else
.Fields("C663" & (2 * i)) = DateAdd("s", 60 * (lWorktime - lTotal) + gclsInclude.MyGetFixRandom(sRndSeed) * 200, .Fields("C662" & (2 * i)))
bFlag = True
End If
If DateDiff("n", .Fields("C663" & (2 * i - 1)), .Fields("C663" & (2 * i))) < 20 Then '20分钟以内
.Fields("C663" & (2 * i - 1)) = 0
.Fields("C663" & (2 * i)) = 0
End If
If DInsertTime(0) > 0 Then ReDim Preserve DInsertTime(UBound(DInsertTime) + 1)
DInsertTime(UBound(DInsertTime)) = .Fields("C663" & (2 * i - 1))
ReDim Preserve DInsertTime(UBound(DInsertTime) + 1)
DInsertTime(UBound(DInsertTime)) = .Fields("C663" & (2 * i))
If bFlag Then Exit For
Next i
lTotal = 0
For i = 1 To iCount
lTotal = lTotal + DateDiff("n", .Fields("C663" & (2 * i - 1)), .Fields("C663" & (2 * i)))
Next i
' StatusBar1.Panels(1).Text = "正在插入特卡打卡数据"
For i = 0 To UBound(DInsertTime)
If DInsertTime(i) > 0 Then
gDBRecordConn.Execute "INSERT INTO T0109A001(A0199,W0031,A0189,W1001,W1002,W1028,W1113) VALUES('-1','" & _
DInsertTime(i) & "','" & !A0189 & "',0,1,0,'1')"
End If
Next i
End With
End Sub
Private Function LoCalculateSpeCard(ByVal fWorkState As WorkState) As Boolean
Dim i As Integer
Dim j As Integer
Dim iCount As Integer
Dim lTotal As Long
Dim lLast As Long
Dim iSplit As Integer
Dim TDateRange As DateRange
Dim DInsertTime() As Date '插入的数据，能显示的卡
Dim sRndSeed(2) As String
With madoResultRS
' .Update
iCount = !A0186 And 7 '本班次共iCount段
lTotal = 0
ReDim DInsertTime(0)
sRndSeed(0) = !A0189
sRndSeed(1) = !E6600
Select Case fWorkState
Case WK_SATURDAY, WK_OVERTIME, WK_FEAST
For i = 1 To iCount
If .Fields("C663" & (i * 2 - 1)) > 0 And .Fields("C663" & (i * 2)) > 0 Then '如果有两次的打卡记录
If !A0186 And 2 ^ (i + 2) Then '表示有加班段
If .Fields("C663" & (i * 2 - 1)) > .Fields("C663" & (i * 2)) Then '如果上班推迟
TDateRange.DStart = .Fields("C663" & (i * 2 - 1))
TDateRange.DEnd = .Fields("C663" & (i * 2))
Else
TDateRange.DStart = .Fields("C662" & (i * 2 - 1))
TDateRange.DEnd = .Fields("C663" & (i * 2))
End If
Else
TDateRange.DStart = .Fields("C662" & (i * 2 - 1))
TDateRange.DEnd = .Fields("C662" & (i * 2))
End If
End If
lLast = DateDiff("n", TDateRange.DStart, TDateRange.DEnd)
lTotal = lTotal + lLast
'先不考虑
If (lTotal >= 60 * (!C6609 + !E6630)) Then 'C6609:日正班段工时;E6630:加班段工时;C6630:班次调整工时
If i <> iCount Then
For j = iCount To 1 Step -1
If .Fields("C663" & (j * 2 - 1)) > 0 And .Fields("C663" & (j * 2)) > 0 Then '如果有两次的打卡记录
TDateRange.DEnd = .Fields("C663" & (j * 2))
Exit For
End If
Next j
End If
!W6649 = TDateRange.DEnd
iSplit = i * 2
For j = iSplit To 2 * CLASS_SEC: .Fields("C663" & j) = 0: Next j
.Fields("C662" & iSplit) = DateAdd("n", 60 * (!C6609 + !E6630) + lLast - lTotal, TDateRange.DStart)
If iCount = 1 Then '对于只有一个打卡时段的情况
If gclsInclude.MyCountsOfTime(.Fields("C662" & iSplit - 1), .Fields("C662" & iSplit), #12:00:00 PM#) > 0 Then
If DateDiff("h", .Fields("C662" & iSplit - 1), !E6600 + #12:00:00 PM#) > 1 And _
DateDiff("h", !E6600 + #12:00:00 PM#, .Fields("C662" & iSplit)) > 1 Then '如果包括吃中饭的时间
.Fields("C662" & iSplit) = DateAdd("h", 1, .Fields("C662" & iSplit))
End If
End If
If gclsInclude.MyCountsOfTime(.Fields("C662" & iSplit - 1), .Fields("C662" & iSplit), #5:00:00 PM#) > 0 Then
If DateDiff("h", .Fields("C662" & iSplit - 1), !E6600 + #5:00:00 PM#) > 1 And _
DateDiff("h", !E6600 + #5:00:00 PM#, .Fields("C662" & iSplit)) > 1 Then '如果包括吃午饭的时间
.Fields("C662" & iSplit) = DateAdd("h", 1, .Fields("C662" & iSplit))
End If
End If
If gclsInclude.MyCountsOfTime(.Fields("C662" & iSplit - 1), .Fields("C662" & iSplit), #11:00:00 PM#) > 0 Then
If DateDiff("h", .Fields("C662" & iSplit - 1), !E6600 + #11:00:00 PM#) > 1 And _
DateDiff("h", !E6600 + #11:00:00 PM#, .Fields("C662" & iSplit)) > 1 Then '如果包括吃晚饭的时间
.Fields("C662" & iSplit) = DateAdd("n", 30, .Fields("C662" & iSplit))
End If
End If
End If
sRndSeed(2) = iSplit
.Fields("C663" & iSplit) = DateAdd("s", gclsInclude.MyGetFixRandom(sRndSeed) * 400, .Fields("C662" & iSplit))
Debug.Print gclsCommon.CBNGetTblStructNote("T6621A001", 2, True, gclsCommon.CBNCSql("A0189 = '" & _
!A0189 & "' AND E6600 = #" & gclsCommon.CBNGetStandDate(!E6600) & "#"))
If !W6649 > 0 Then
If Minute(!W6649) > 30 Then
TDateRange.DEnd = Format(!W6649, "YYYY-MM-DD HH:30:00")
Else
TDateRange.DEnd = Format(!W6649, "YYYY-MM-DD HH:00:00")
End If
sRndSeed(2) = iSplit + 1
!W6648 = DateAdd("s", -20 - gclsInclude.MyGetFixRandom(sRndSeed) * 300 - (!E6635 + !E6603) * 3600, TDateRange.DEnd) 'E6635:调休工时;E6603:特卡工时
End If
Exit For
End If
Next i
Case WK_REST
'休日取一首一尾
iSplit = 1
For i = 1 To iCount
If .Fields("C663" & (i * 2 - 1)) > 0 And .Fields("C663" & (i * 2)) > 0 Then
!W6648 = .Fields("C663" & (i * 2 - 1))
Exit For
End If
Next i
For i = iCount To 1 Step -1
If .Fields("C663" & (i * 2 - 1)) > 0 And .Fields("C663" & (i * 2)) > 0 Then
!W6649 = .Fields("C663" & (i * 2))
Exit For
End If
Next i
For i = 1 To CLASS_SEC * 2: .Fields("C663" & i) = 0: Next i
'将以上的第一个时间作为特卡的下班时间，第二个为上班时间
'规定：在T0109A001中，当W1113=1或当W1113=3时为计算机自动加入的特卡，
'但当W1113=1时是需要显示的；当W1113=3时，表示被设置为特卡，不需要显示。
'当W1113=4时，为原始的打卡记录，但被标记为特卡，不显示。
End Select
.Update
If .Fields("C663" & iSplit) > 0 Then
If DInsertTime(0) > 0 Then
ReDim Preserve DInsertTime(UBound(DInsertTime) + 1)
End If
End If
DInsertTime(UBound(DInsertTime)) = .Fields("C663" & iSplit)
' StatusBar1.Panels(1).Text = "正在插入特卡打卡数据"
For i = 0 To UBound(DInsertTime)
If DInsertTime(i) > 0 Then
gDBRecordConn.Execute "INSERT INTO T0109A001(A0199,W0031,A0189,W1001,W1002,W1028,W1113) VALUES('-1','" & _
DInsertTime(i) & "','" & !A0189 & "',0,1,0,'1')"
End If
Next i
End With
End Function