其他数据库

开发平台：
Visual Basic

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

						