www.pudn.com > 考勤管理系统源码(VB含串口接口程序).zip > 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