其他数据库

开发平台：
Visual Basic

frmPrn.frm：源码内容
							VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmPrn 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "考勤明细报表"
   ClientHeight    =   8625
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   11910
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmPrn.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   8625
   ScaleWidth      =   11910
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   WindowState     =   2  'Maximized
   Begin VB.CommandButton Command1 
      Cancel          =   -1  'True
      Height          =   435
      Index           =   2
      Left            =   10365
      Picture         =   "frmPrn.frx":000C
      Style           =   1  'Graphical
      TabIndex        =   22
      Top             =   1350
      Width           =   1230
   End
   Begin VB.CommandButton Command1 
      Height          =   435
      Index           =   1
      Left            =   10365
      Picture         =   "frmPrn.frx":1E7D
      Style           =   1  'Graphical
      TabIndex        =   21
      Top             =   765
      Width           =   1230
   End
   Begin VB.CommandButton Command1 
      Height          =   435
      Index           =   0
      Left            =   10365
      Picture         =   "frmPrn.frx":3DE8
      Style           =   1  'Graphical
      TabIndex        =   20
      Top             =   180
      Width           =   1230
   End
   Begin VB.Frame Frame2 
      Height          =   1740
      Left            =   240
      TabIndex        =   13
      Top             =   90
      Width           =   3120
      Begin VB.OptionButton optKq 
         Caption         =   "薪假"
         Height          =   240
         Index           =   5
         Left            =   1650
         TabIndex        =   19
         Top             =   795
         Width           =   780
      End
      Begin VB.OptionButton optKq 
         Caption         =   "出差"
         Height          =   240
         Index           =   4
         Left            =   1650
         TabIndex        =   18
         Top             =   285
         Width           =   780
      End
      Begin VB.OptionButton optKq 
         Caption         =   "请假"
         Height          =   240
         Index           =   3
         Left            =   345
         TabIndex        =   17
         Top             =   1305
         Width           =   780
      End
      Begin VB.OptionButton optKq 
         Caption         =   "旷工"
         Height          =   240
         Index           =   2
         Left            =   345
         TabIndex        =   16
         Top             =   1305
         Visible         =   0   'False
         Width           =   780
      End
      Begin VB.OptionButton optKq 
         Caption         =   "迟到"
         Height          =   240
         Index           =   1
         Left            =   345
         TabIndex        =   15
         Top             =   795
         Width           =   780
      End
      Begin VB.OptionButton optKq 
         Caption         =   "正常"
         Height          =   240
         Index           =   0
         Left            =   345
         TabIndex        =   14
         Top             =   285
         Value           =   -1  'True
         Width           =   780
      End
   End
   Begin VB.Frame Frame1 
      Height          =   1740
      Left            =   3660
      TabIndex        =   6
      Top             =   90
      Width           =   6345
      Begin VB.CommandButton Command2 
         Caption         =   "…"
         Height          =   330
         Left            =   5730
         TabIndex        =   12
         Top             =   1080
         Width           =   330
      End
      Begin VB.TextBox txtEmp 
         Height          =   330
         Left            =   4380
         TabIndex        =   11
         Top             =   1080
         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             =   420
         Width           =   330
      End
      Begin VB.TextBox txtDate 
         Height          =   330
         Index           =   0
         Left            =   1725
         Locked          =   -1  'True
         TabIndex        =   0
         Top             =   420
         Width           =   1320
      End
      Begin VB.ComboBox cboDept 
         Height          =   330
         Left            =   4380
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   420
         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             =   1080
         Width           =   330
      End
      Begin VB.TextBox txtDate 
         Height          =   330
         Index           =   1
         Left            =   1725
         Locked          =   -1  'True
         TabIndex        =   2
         Top             =   1080
         Width           =   1320
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "员工:"
         Height          =   210
         Index           =   3
         Left            =   3810
         TabIndex        =   10
         Top             =   1140
         Width           =   525
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "部门:"
         Height          =   210
         Index           =   2
         Left            =   3810
         TabIndex        =   9
         Top             =   480
         Width           =   525
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "统计起始日期:"
         Height          =   210
         Index           =   0
         Left            =   315
         TabIndex        =   8
         Top             =   480
         Width           =   1365
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "统计截至日期:"
         Height          =   210
         Index           =   1
         Left            =   315
         TabIndex        =   7
         Top             =   1140
         Width           =   1365
      End
   End
   Begin MSFlexGridLib.MSFlexGrid msfGrid 
      Height          =   6300
      Left            =   255
      TabIndex        =   5
      Top             =   2115
      Width           =   11400
      _ExtentX        =   20108
      _ExtentY        =   11113
      _Version        =   393216
      FixedCols       =   0
      ScrollBars      =   2
   End
End
Attribute VB_Name = "frmPrn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const mFRSKQ = "^工  号       |<姓  名           |" _
        & "<部  门           |^考 勤 日 期                |" _
        & "^考 勤 时 间               " '5
Const mKQCOLS = 5
Const mFRSLEAVE = "^工号  |<姓名   |" _
        & "<部 门   |^起始日期     |" _
        & "^起始时间  |^截至日期     |" _
        & "^截止时间  |<请假类型 |" _
        & "<批准人   |<事由       "
Const mLEAVECOLS = 10
Const mFRSABSENT = "^工号  |<姓名       |" _
        & "<部 门       |^起始日期       |" _
        & "^起始时间    |^截止日期       |" _
        & "^截止时间    |<批准人         "
Const mABSENTCOLS = 8
Const mFRSNOTINWORK = "^工号                 |<姓名                  |" _
        & "<部 门                   |" _
        & "^日 期                             "
Const mNOTINWORKCOLS = 4
Dim mGridCols As Integer
'************OPTKQ
Const mNORMAL = 0
Const mLATE = 1
Const mNOTINWORK = 2
Const mLEAVE = 3
Const mEVECTION = 4
Const mMONEY = 5
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
            FindDetail
            Command1(1).Enabled = msfGrid.Rows > msfGrid.FixedRows
        Case 1
            Dim tmpStr As String
            If Trim(cboDept.Text) <> gALLDEPTNAME Then
                tmpStr = Trim(cboDept.Text)
            End If
            If Trim(txtEmp) <> Empty Then
                If tmpStr <> Empty Then
                    tmpStr = tmpStr & "的员工"
                End If
                tmpStr = tmpStr & Trim(txtEmp)
            End If
            
            If Trim(txtDate(0)) <> Trim(txtDate(1)) Then
                tmpStr = tmpStr & "在" & Trim(txtDate(0)) _
                    & "至" & Trim(txtDate(1)) & "期间"
            Else
                tmpStr = tmpStr & "在" & Trim(txtDate(0))
            End If
            
            Dim I As Integer
            For I = 0 To optKq.Count - 1
                If optKq(I).Value Then
                    tmpStr = tmpStr & Trim(optKq(I).Caption)
                    If I = mNORMAL Then tmpStr = tmpStr & "考勤" '正常两个自晦涩不清
                End If
            Next
            
            tmpStr = tmpStr & "记录"
            
            PrintGridNormal gOwnName & "-" & Me.Caption, _
                msfGrid, 1, tmpStr, True
        Case 2
            Unload Me
    End Select
End Sub
'
Private Sub FindDetail()
    Dim StartDate As String
    Dim EndDate As String
    Dim intDept As Integer
    Dim strDept As String
    Dim strWorkNo As String
    Dim Sql As String
    Dim IsKq As Boolean
    Dim isLeave As Boolean
    Dim IsAbsent As Boolean
    If optKq(mNORMAL).Value Or optKq(mLATE).Value Then IsKq = True
    If optKq(mLEAVE).Value Then isLeave = True
    If optKq(mEVECTION).Value Or optKq(mMONEY).Value Then IsAbsent = True
    
    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  "
    If IsKq Then
        Sql = Sql & "QryKqHistory "
    End If
    
    If isLeave Then
        Sql = Sql & "QryLeave"
    End If
    
    If IsAbsent Then
        Sql = Sql & "QryAbsent"
    End If
    
    
    If IsKq Then
        Sql = Sql & " where KqDate between '" & StartDate & "' and '" _
             & EndDate & "'"
        If optKq(mNORMAL).Value Then
            Sql = Sql & " and KqTime<='" & gLATETIME & "'"
        Else
            Sql = Sql & " and KqTime>'" & gLATETIME & "'"
        End If
    End If
    
    If isLeave Or IsAbsent Then
        Sql = Sql & " Where StartDate>='" & StartDate & "' and " _
            & " EndDate<='" & EndDate & "'"
        If IsAbsent Then
            If optKq(mEVECTION).Value Then
                Sql = Sql & " and IsEvection=" & gTRUE
            Else
                Sql = Sql & " and IsEvection=" & gFALSE
            End If
        Else
        End If
    End If
         
    If strWorkNo <> Empty Then
        Sql = Sql & " and " & "InStr(1,WorkNo,'" & strWorkNo & "',0)>0 "
    End If
    If intDept <> gMAXITEM Then Sql = Sql & " and DeptName='" & strDept & "'"
    
    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 _
                        & !DeptName & vbTab _
                        & !KqDate & vbTab & !KqTime
                End If
                If isLeave Then
                    strIn = strIn & !WorkNo & vbTab _
                        & !Name & vbTab _
                        & !DeptName & vbTab _
                        & !StartDate & vbTab _
                        & !StartTime & vbTab _
                        & !EndDate & vbTab _
                        & !EndTime & vbTab _
                        & !TypeName & vbTab _
                        & !AllowMan & vbTab _
                        & !Reason
                End If
                
                If IsAbsent Then
                    strIn = strIn & !WorkNo & vbTab _
                        & !Name & vbTab _
                        & !DeptName & vbTab _
                        & !StartDate & vbTab _
                        & !StartTime & vbTab _
                        & !EndDate & vbTab _
                        & !EndTime & vbTab _
                        & !AllowMan
                End If
                If Not .EOF Then strIn = strIn & vbCr
                .MoveNext
            End With
        Loop
        Rst.Close
    Else
        MsgBox "没有符合条件的记录", vbInformation, gTitle
    End If
    intRows = intRows + 1
    If IsKq Then intCols = mKQCOLS
    If isLeave Then intCols = mLEAVECOLS
    If IsAbsent Then intCols = mABSENTCOLS
    Dim I As Integer
    With msfGrid
        ClipToGrid msfGrid, strIn, intRows, intCols
        .MergeCells = flexMergeRestrictRows
        For I = 0 To 2
            .MergeCol(I) = True
        Next
    End With
    Exit Sub
FindErr:
    MsgBox Err.Description, vbInformation, gTitle
    Err.Clear
End Sub
Private Sub Command2_Click()
    With frmLookMan
        .Show vbModal
        txtEmp = .mWorkNo
    End With
End Sub
'
Private Sub Form_Load()
    SetGridColor msfGrid
    
    msfGrid.FormatString = mFRSKQ
    txtDate(0) = Format(Now, "yyyy-mm-dd")
    txtDate(1) = Format(Now, "yyyy-mm-dd")
    With cboDept
        .Clear
        FillCbo cboDept, aDepartment, 0
    End With
    optKq(mNORMAL).Value = True
End Sub
Private Sub optKq_Click(Index As Integer)
    With msfGrid
        .Rows = .FixedRows
        .Cols = 1
        Select Case Index
            Case mNORMAL, mLATE
                .FormatString = mFRSKQ
                mGridCols = mKQCOLS
            Case mNOTINWORK
                .FormatString = mFRSNOTINWORK
                mGridCols = mNOTINWORKCOLS
            Case mLEAVE
                .FormatString = mFRSLEAVE
                mGridCols = mLEAVECOLS
            Case mEVECTION, mMONEY
                .FormatString = mFRSABSENT
                mGridCols = mABSENTCOLS
        End Select
    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

						