www.pudn.com > 考勤管理系统源码(VB含串口接口程序).zip > frmFlow.frm
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmFlow
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 = "frmFlow.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7200
ScaleWidth = 8880
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command1
Cancel = -1 'True
Height = 435
Index = 2
Left = 7290
Picture = "frmFlow.frx":000C
Style = 1 'Graphical
TabIndex = 17
Top = 1395
Width = 1230
End
Begin VB.CommandButton Command1
Height = 435
Index = 1
Left = 7290
Picture = "frmFlow.frx":1E7D
Style = 1 'Graphical
TabIndex = 16
Top = 795
Width = 1230
End
Begin VB.CommandButton Command1
Height = 435
Index = 0
Left = 7290
Picture = "frmFlow.frx":3DE8
Style = 1 'Graphical
TabIndex = 15
Top = 195
Width = 1230
End
Begin VB.Frame Frame1
Height = 1785
Left = 285
TabIndex = 6
Top = 75
Width = 6615
Begin VB.OptionButton optSel
Caption = "查询全部打卡人员"
Height = 285
Index = 1
Left = 3990
TabIndex = 14
Top = 1365
Value = -1 'True
Width = 2175
End
Begin VB.OptionButton optSel
Caption = "只查询迟到人员"
Height = 285
Index = 0
Left = 315
TabIndex = 13
Top = 1365
Width = 1815
End
Begin VB.CommandButton Command2
Caption = "…"
Height = 330
Left = 5910
TabIndex = 12
Top = 862
Width = 330
End
Begin VB.TextBox txtEmp
Height = 330
Left = 4560
TabIndex = 11
Top = 862
Width = 1350
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 = 3030
TabIndex = 1
TabStop = 0 'False
Top = 345
Width = 330
End
Begin VB.TextBox txtDate
Height = 330
Index = 0
Left = 1725
Locked = -1 'True
TabIndex = 0
Top = 345
Width = 1320
End
Begin VB.ComboBox cboDept
Height = 330
Left = 4560
Style = 2 'Dropdown List
TabIndex = 4
Top = 345
Width = 1665
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 = 3030
TabIndex = 3
TabStop = 0 'False
Top = 862
Width = 330
End
Begin VB.TextBox txtDate
Height = 330
Index = 1
Left = 1725
Locked = -1 'True
TabIndex = 2
Top = 862
Width = 1320
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "员工:"
Height = 210
Index = 3
Left = 3990
TabIndex = 10
Top = 915
Width = 525
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "部门:"
Height = 210
Index = 2
Left = 3990
TabIndex = 9
Top = 405
Width = 525
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "统计起始日期:"
Height = 210
Index = 0
Left = 315
TabIndex = 8
Top = 405
Width = 1365
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "统计截至日期:"
Height = 210
Index = 1
Left = 315
TabIndex = 7
Top = 922
Width = 1365
End
End
Begin MSFlexGridLib.MSFlexGrid msfGrid
Height = 4770
Left = 255
TabIndex = 5
Top = 2115
Width = 8340
_ExtentX = 14711
_ExtentY = 8414
_Version = 393216
FixedCols = 0
ScrollBars = 2
End
End
Attribute VB_Name = "frmFlow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mFormatString As String
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)) > Trim(txtDate(1)) Then
MsgBox Trim(Label1(0)) & "不能大于" & Trim(Label1(1)), 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
' PrintGridNormal gOwnName & "-" & Me.Caption, _
' msfGrid, 1, "", True
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
'打印条件
Str = Trim(Label1(0)) & Space(1) & Trim(txtDate(0)) _
& Space(5) & Trim(Label1(1)) & Space(1) & Trim(txtDate(1)) _
& 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
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) _
; Trim(.TextMatrix(0, 6)) '30
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) _
; Trim(.TextMatrix(i, 6)) '30
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)
Sql = " Select * from QryKqHistory "
Sql = Sql & " where format(KqDate,'yyyy-mm-dd') between '" _
& StartDate & "' and '" _
& EndDate & "'"
If strWorkNo <> Empty Then
Sql = Sql & " and " & "InStr(1,WorkNo,'" & strWorkNo & "',0)>0 "
End If
If intDept <> gMAXITEM Then Sql = Sql & " and DeptName='" & strDept & "'"
If optSel(0).Value Then Sql = Sql & " and format(KqTime,'hh:mm')>'" _
& gLATETIME & "' "
Sql = Sql & " and F_DelFlag=" & gFALSE
Sql = Sql & " order by Workno,DeptName"
Dim Rst As Recordset
Dim strIn As String
Dim intRows As Integer
Dim intCols As Integer
Set Rst = gDataBase.OpenRecordset(Sql)
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 _
& Format(!KqDate, "yyyy-mm-dd") & 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 = 7
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(1) & vbTab _
& "<姓 名" & Space(4) & vbTab _
& "^性别" & Space(0) & vbTab _
& "<部 门" & Space(5) & vbTab _
& "<职 务" & Space(5) & vbTab _
& "^考勤日期" & Space(8) & vbTab _
& "^考勤时间" & Space(8) '7
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
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