frmdyn.frm

这是温州现代集团的员工考勤管理系统

        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