其他数据库

开发平台：
Visual Basic

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

						