www.pudn.com > 考勤管理系统源码(VB含串口接口程序).zip > frmDyn.frm
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmDyn
BorderStyle = 3 'Fixed Dialog
Caption = "日考勤动态报表"
ClientHeight = 7200
ClientLeft = 45
ClientTop = 330
ClientWidth = 8880
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmDyn.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7200
ScaleWidth = 8880
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command1
Cancel = -1 'True
Height = 525
Index = 2
Left = 7290
Picture = "frmDyn.frx":000C
Style = 1 'Graphical
TabIndex = 15
Top = 1590
Width = 1230
End
Begin VB.CommandButton Command1
Height = 525
Index = 1
Left = 7290
Picture = "frmDyn.frx":1E7D
Style = 1 'Graphical
TabIndex = 14
Top = 892
Width = 1230
End
Begin VB.CommandButton Command1
Height = 525
Index = 0
Left = 7290
Picture = "frmDyn.frx":3DE8
Style = 1 'Graphical
TabIndex = 13
Top = 195
Width = 1230
End
Begin VB.Frame Frame1
Height = 2025
Left = 285
TabIndex = 5
Top = 75
Width = 6615
Begin VB.OptionButton optSel
Caption = "查询未打卡者"
Height = 285
Index = 2
Left = 390
TabIndex = 20
Top = 1508
Width = 1965
End
Begin VB.ComboBox cboDept
Height = 330
Left = 4440
Style = 2 'Dropdown List
TabIndex = 19
Top = 892
Width = 1860
End
Begin VB.CommandButton Command2
Caption = "…"
Height = 330
Left = 5970
TabIndex = 18
Top = 1485
Width = 330
End
Begin VB.CheckBox chkSel
Caption = "查询未打卡者"
Height = 285
Index = 1
Left = 2175
TabIndex = 17
Top = 1095
Visible = 0 'False
Width = 1560
End
Begin VB.CheckBox chkSel
Caption = "查询迟到者"
Height = 285
Index = 0
Left = 2175
TabIndex = 16
Top = 750
Visible = 0 'False
Width = 1365
End
Begin VB.OptionButton optSel
Caption = "查询全部打卡人员"
Height = 285
Index = 1
Left = 390
TabIndex = 12
Top = 323
Value = -1 'True
Width = 2055
End
Begin VB.OptionButton optSel
Caption = "查询迟到者"
Height = 285
Index = 0
Left = 405
TabIndex = 11
Top = 915
Width = 1530
End
Begin VB.TextBox txtEmp
Height = 330
Left = 4440
TabIndex = 10
Top = 1485
Width = 1530
End
Begin VB.CommandButton cmdSel
Caption = "…"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Index = 0
Left = 5970
TabIndex = 1
TabStop = 0 'False
Top = 300
Width = 330
End
Begin VB.TextBox txtDate
Height = 330
Index = 0
Left = 4440
Locked = -1 'True
TabIndex = 0
Top = 300
Width = 1530
End
Begin VB.CommandButton cmdSel
Caption = "…"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Index = 1
Left = 6015
TabIndex = 3
TabStop = 0 'False
Top = 675
Visible = 0 'False
Width = 330
End
Begin VB.TextBox txtDate
Height = 330
Index = 1
Left = 4665
Locked = -1 'True
TabIndex = 2
Top = 675
Visible = 0 'False
Width = 1350
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "员工卡号:"
Height = 210
Index = 3
Left = 3450
TabIndex = 9
Top = 1545
Width = 945
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "部 门:"
Height = 210
Index = 2
Left = 3450
TabIndex = 8
Top = 952
Width = 945
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "统计日期:"
Height = 210
Index = 0
Left = 3450
TabIndex = 7
Top = 360
Width = 945
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "统计截至日期:"
Height = 210
Index = 1
Left = 3225
TabIndex = 6
Top = 735
Visible = 0 'False
Width = 1365
End
End
Begin MSFlexGridLib.MSFlexGrid msfGrid
Height = 4485
Left = 255
TabIndex = 4
Top = 2400
Width = 8340
_ExtentX = 14711
_ExtentY = 7911
_Version = 393216
FixedCols = 0
ScrollBars = 2
End
End
Attribute VB_Name = "frmDyn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mFormatString As String
'*****OPTSEL
Const mALL = 1
Const mLATE = 0
Const mNOTCARD = 2
'***CHKSEL
'Const mLATE = 0
'Const mABNORMAL = 1
Private Sub cboDept_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
SendKeyTab KeyCode
End If
End Sub
Private Sub cmdSel_Click(Index As Integer)
frmRiLi.Show vbModal
If frmRiLi.mRetDate <> Empty Then
txtDate(Index) = frmRiLi.mRetDate
End If
End Sub
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0
If Trim(txtDate(0)) = Empty Then
MsgBox Trim(Label1(0)) & "不能为空", vbInformation, gTitle
txtDate(0).SetFocus
Exit Sub
End If
Me.MousePointer = vbHourglass
Me.Enabled = False
FindFlow
Me.Enabled = True
Me.MousePointer = 0
Command1(1).Enabled = msfGrid.Rows > msfGrid.FixedRows
Case 1
If MsgBox("请准备好打印机，按[是]开始打印...", _
vbYesNo, gTitle) = vbNo Then Exit Sub
Dim oldPaperSize As Integer
oldPaperSize = Printer.PaperSize
Printer.PaperSize = 9 'A4
PrintFlow Printer
Printer.PaperSize = oldPaperSize
Case 2
Unload Me
End Select
End Sub
Private Sub PrintFlow(objPrint As Printer)
Dim CurX As Single
Dim CurY As Single
Dim FixedX As Integer
Dim RowH As Integer '行高
Dim TopH As Integer '顶边距
Dim DataRows As Integer
Dim ForTimes As Integer
Dim Str As String
DataRows = msfGrid.Rows - 1
Const Rows = 35
Const Sr = 56.7
FixedX = Sr * 5
Dim i As Integer
Dim OldFontSize As Integer
Dim Lines As Integer
Dim StartLine As Integer
On Error GoTo PrintErr
With objPrint
RowH = .TextHeight("A") * 2
OldFontSize = .FontSize
TopH = 20 * Sr
For ForTimes = 1 To DataRows \ Rows + 1
'打印标题
CurY = TopH
CurX = FixedX
Str = Trim(Me.Caption)
CurX = (.Width - .TextWidth(Str) - FixedX - 200) / 2
.CurrentX = CurX
.CurrentY = CurY
.FontSize = 16
.Font.Bold = True
objPrint.Print Str
.FontBold = False
'打印条件
If optSel(mNOTCARD).Value Then
Str = optSel(mNOTCARD).Caption & Space(5) & Trim(Label1(0)) & Space(1) & Trim(txtDate(0))
Else
If optSel(mALL).Value Then
Str = optSel(mALL).Caption
Else
Str = optSel(mLATE).Caption
End If
Str = Str & Space(5) & Trim(Label1(0)) & Space(1) & Trim(txtDate(0)) _
& Space(5) & Trim(Label1(2)) & Space(1) & Trim(cboDept.Text)
If Trim(txtEmp) <> Empty Then
Str = Str & Space(5) & Trim(Label1(3)) & Space(1) & Trim(txtEmp)
End If
End If
CurY = CurY + RowH + 400
CurX = FixedX
.FontItalic = True
.CurrentX = CurX
.CurrentY = CurY
.FontSize = 11
objPrint.Print Str
.FontItalic = False
'直线
.CurrentX = FixedX
CurY = CurY + RowH - 100
.CurrentY = CurY
objPrint.Line (FixedX, CurY)-(Printer.Width - FixedX - 100, CurY), RGB(0, 0, 0)
'打印明细栏
.FontBold = True
.FontSize = 13
.CurrentX = FixedX
CurY = CurY + RowH - 180
.CurrentY = CurY
With msfGrid
objPrint.Print Trim(.TextMatrix(0, 0)); Tab(12) _
; Trim(.TextMatrix(0, 1)); Tab(23) _
; Trim(.TextMatrix(0, 2)); Tab(30) _
; Trim(.TextMatrix(0, 3)); Tab(42) _
; Trim(.TextMatrix(0, 4)); Tab(53) _
; Trim(.TextMatrix(0, 5)); Tab(70)
End With
'.Print Str
.FontSize = 12
.FontBold = False
'打印正文
If ForTimes = DataRows \ Rows + 1 Then
Lines = DataRows Mod Rows
StartLine = DataRows \ Rows + 1
Else
Lines = Rows
StartLine = ForTimes
End If
.CurrentX = FixedX
CurY = CurY + RowH
.CurrentY = CurY
For i = (StartLine - 1) * Rows + 1 To (StartLine - 1) * Rows + Lines 'StartLine To Lines
With msfGrid
objPrint.Print Trim(.TextMatrix(i, 0)); Tab(14) _
; Trim(.TextMatrix(i, 1)); Tab(27) _
; Trim(.TextMatrix(i, 2)); Tab(33) _
; Trim(.TextMatrix(i, 3)); Tab(47) _
; Trim(.TextMatrix(i, 4)); Tab(60) _
; Trim(.TextMatrix(i, 5)); Tab(80)
End With
.CurrentX = FixedX
CurY = CurY + RowH - 20
.CurrentY = CurY
'.print Str
Next
.FontSize = 11
.CurrentX = FixedX
CurY = 14985 - 50
.CurrentY = CurY
objPrint.Line (FixedX, CurY)-(Printer.Width - FixedX - 100, CurY), RGB(0, 0, 0)
.CurrentY = 14985
.CurrentX = FixedX
objPrint.Print Space(80) & "第" & ForTimes & "/" & DataRows \ Rows + 1 & "页"
If TypeOf objPrint Is Printer Then
.EndDoc
Else
'.c
End If
Next
.FontSize = OldFontSize
End With
Exit Sub
PrintErr:
MsgBox Err.Description, vbCritical, gTitle
Err.Clear
If TypeOf objPrint Is Printer Then
objPrint.KillDoc
Else
End If
End Sub
Private Sub FindFlow()
Dim StartDate As String
Dim EndDate As String
Dim intDept As Integer
Dim strDept As String
Dim strWorkNo As String
Dim Sql As String
On Error GoTo FindErr
StartDate = Trim(txtDate(0))
' EndDate = Trim(txtDate(1))
getItemData cboDept, intDept
strDept = Trim(cboDept.Text)
strWorkNo = Trim(txtEmp)
Dim Rst As Recordset
If optSel(mNOTCARD).Value Then
Dim Qry As QueryDef
Set Qry = gDataBase.QueryDefs("QryKG")
Qry.Parameters(0) = StartDate
Set Rst = Qry.OpenRecordset(dbOpenSnapshot)
Else
Sql = " Select * from QryKqHistory "
Sql = Sql & " where format(KqDate,'yyyy-mm-dd')='" _
& StartDate & "'"
If optSel(mLATE).Value Then Sql = Sql & " and format(KqTime,'hh:mm')>'" _
& gLATETIME & "' "
If strWorkNo <> Empty Then
Sql = Sql & " and " & "InStr(1,WorkNo,'" & strWorkNo & "',0)>0 "
End If
If intDept <> gMAXITEM Then Sql = Sql & " and DeptName='" & strDept & "'"
Set Rst = gDataBase.OpenRecordset(Sql)
End If
Dim strIn As String
Dim intRows As Integer
Dim intCols As Integer
If Rst.RecordCount > 0 Then
Do While Not Rst.EOF
intRows = intRows + 1
With Rst
'If IsKq Then
strIn = strIn & !WorkNo & vbTab _
& !Name & vbTab & !Sex & vbTab _
& !DeptName & vbTab & !TitleName & vbTab _
& !KqTime
'End If
If Not .EOF Then strIn = strIn & vbCr
.MoveNext
End With
Loop
Rst.Close
'Unload Me
Else
MsgBox "没有符合条件的记录", vbInformation, gTitle
End If
intRows = intRows
intCols = 6
Dim i As Integer
With msfGrid
'.Rows = .FixedRows
ClipToGrid msfGrid, strIn, intRows + 1, intCols
.MergeCells = flexMergeRestrictRows
For i = 0 To .Cols - 2
.MergeCol(i) = True
Next
End With
Exit Sub
FindErr:
MsgBox "查询未成功!" & vbCrLf & Err.Description, vbExclamation, gTitle
Err.Clear
Me.Enabled = True
Me.MousePointer = 0
End Sub
Private Sub Command2_Click()
With frmLookMan
.Show vbModal
txtEmp = .mWorkNo
End With
End Sub
Private Sub Form_Load()
SetGridColor msfGrid
mFormatString = "^工号" & Space(3) & vbTab _
& "<姓 名" & Space(6) & vbTab _
& "^性别" & Space(3) & vbTab _
& "<部 门" & Space(8) & vbTab _
& "<职 务" & Space(8) & vbTab _
& "^考勤时间" & Space(11) '6
msfGrid.FormatString = mFormatString
txtDate(0) = Format(Now, "yyyy-mm-dd")
txtDate(1) = Format(Now, "yyyy-mm-dd")
With cboDept
.Clear
FillCbo cboDept, aDepartment, 0
End With
optSel_Click mALL
End Sub
Private Sub optSel_Click(Index As Integer)
Dim blnTemp As Boolean
blnTemp = Not optSel(mNOTCARD).Value
Label1(2).Enabled = blnTemp
cboDept.Enabled = blnTemp
Label1(3).Enabled = blnTemp
txtEmp.Enabled = blnTemp
Command2.Enabled = blnTemp
' Dim blnTemp As Boolean
' blnTemp = Not optSel(mALL).Value
' chkSel(0).Enabled = blnTemp
' If blnTemp Then
' chkSel(0).Value = 1
' Else
' chkSel(0).Value = 0
' chkSel(1).Value = 0
' End If
' chkSel(1).Enabled = blnTemp
End Sub
Private Sub txtDate_GotFocus(Index As Integer)
GotFocus txtDate(Index)
End Sub
Private Sub txtDate_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
SendKeyTab KeyCode
End If
End Sub