其他数据库

开发平台：
Visual Basic

frmMonth.frm：源码内容
							VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmMonth 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "月统计报表"
   ClientHeight    =   7320
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10500
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmMonth.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7320
   ScaleWidth      =   10500
   StartUpPosition =   1  '所有者中心
   Begin ComctlLib.StatusBar stbMsg 
      Align           =   2  'Align Bottom
      Height          =   450
      Left            =   0
      TabIndex        =   14
      Top             =   6870
      Width           =   10500
      _ExtentX        =   18521
      _ExtentY        =   794
      SimpleText      =   ""
      _Version        =   327682
      BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} 
         NumPanels       =   1
         BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            AutoSize        =   1
            Object.Width           =   18468
            Key             =   ""
            Object.Tag             =   ""
            Object.ToolTipText     =   "警告信息"
         EndProperty
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      MouseIcon       =   "frmMonth.frx":000C
   End
   Begin VB.CommandButton Command1 
      Height          =   435
      Index           =   0
      Left            =   8955
      Picture         =   "frmMonth.frx":0326
      Style           =   1  'Graphical
      TabIndex        =   13
      Top             =   210
      Width           =   1230
   End
   Begin VB.CommandButton Command1 
      Height          =   435
      Index           =   1
      Left            =   8955
      Picture         =   "frmMonth.frx":211A
      Style           =   1  'Graphical
      TabIndex        =   12
      Top             =   757
      Width           =   1230
   End
   Begin VB.CommandButton Command1 
      Cancel          =   -1  'True
      Height          =   435
      Index           =   2
      Left            =   8955
      Picture         =   "frmMonth.frx":4085
      Style           =   1  'Graphical
      TabIndex        =   11
      Top             =   1305
      Width           =   1230
   End
   Begin VB.Frame Frame1 
      Height          =   1650
      Left            =   6075
      TabIndex        =   4
      Top             =   90
      Width           =   2535
      Begin VB.ComboBox cboMonth 
         Height          =   330
         Left            =   720
         Style           =   2  'Dropdown List
         TabIndex        =   16
         Top             =   240
         Width           =   1665
      End
      Begin VB.ComboBox cboDept 
         Height          =   330
         Left            =   720
         Style           =   2  'Dropdown List
         TabIndex        =   7
         Top             =   697
         Width           =   1665
      End
      Begin VB.TextBox txtEmp 
         Height          =   330
         Left            =   720
         TabIndex        =   6
         Top             =   1155
         Width           =   1350
      End
      Begin VB.CommandButton Command2 
         Caption         =   "…"
         Height          =   330
         Left            =   2070
         TabIndex        =   5
         Top             =   1155
         Width           =   330
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "月份:"
         Height          =   210
         Index           =   0
         Left            =   150
         TabIndex        =   15
         Top             =   300
         Width           =   525
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "部门:"
         Height          =   210
         Index           =   2
         Left            =   150
         TabIndex        =   9
         Top             =   757
         Width           =   525
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "员工:"
         Height          =   210
         Index           =   3
         Left            =   150
         TabIndex        =   8
         Top             =   1215
         Width           =   525
      End
   End
   Begin VB.Frame fra1 
      Height          =   1650
      Left            =   255
      TabIndex        =   0
      Top             =   90
      Width           =   5610
      Begin VB.OptionButton optKq 
         Caption         =   "全部(包括以上两者)"
         Height          =   270
         Index           =   2
         Left            =   180
         TabIndex        =   3
         Top             =   1200
         Width           =   2190
      End
      Begin VB.OptionButton optKq 
         Caption         =   "正常考勤(包括正常出勤,休息)"
         Height          =   270
         Index           =   1
         Left            =   180
         TabIndex        =   2
         Top             =   765
         Width           =   4005
      End
      Begin VB.OptionButton optKq 
         Caption         =   "非正常考勤(包括请假,出差,有薪假期,旷工,迟到等)"
         Height          =   270
         Index           =   0
         Left            =   180
         TabIndex        =   1
         Top             =   330
         Value           =   -1  'True
         Width           =   5130
      End
   End
   Begin MSFlexGridLib.MSFlexGrid msfGrid 
      Height          =   4635
      Left            =   240
      TabIndex        =   10
      Top             =   1995
      Width           =   9960
      _ExtentX        =   17568
      _ExtentY        =   8176
      _Version        =   393216
      FixedCols       =   0
      AllowBigSelection=   0   'False
      HighLight       =   2
      ScrollBars      =   2
      AllowUserResizing=   1
   End
End
Attribute VB_Name = "frmMonth"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mSelQryName As String
Const mFormatString = "^工号      |<姓 名     |<部 门      " _
    & "|<日期      |<类型       |<备注                             "
'*****optKq
Const mABNORMAL = 0
Const mNORMAL = 1
Const mALL = 2
'****msfGrid
Const mWorkNo = 0
Const mName = 1
Const mDept = 2
Const mDATE = 3
Const mTYPE = 4
Const mNote = 5
Const mGridCols = 6
'Const
'Const mKUANGGONG = "旷工"
Const mMonthStr = "月统计报表"
Const mSTARTTIMESTR = "起始时间 "
Const mENDTIMESTR = "截至时间 "
Const mWHOLEDAYSTR = "整天"
Const mTOSTR = "-"
Const mINWORKSTR = "上班"
Const mOUTWORKSTR = "下班"
Const mMsg1 = "系统正在统计当中,请您休息一下..."
Const mMsg2 = "统计完成,请您继续作您的工作!!"
Const mMsg3 = "抱歉,统计未完成!"
Const mMsg4 = "该记录被删除"
Const mMsg5 = "没有生成排班表或排班表已被删除,统计不能进行!!!"
Dim mSql As String
Dim mRst As Recordset
Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0
            If Not CheckQryIsExist Then
                MsgBox cboMonth.Text & mMsg5, vbInformation, gTitle
                Exit Sub
            End If
            stbMsg.Panels(1).Text = mMsg1
            Dim Fr As frmMsg
            Set Fr = New frmMsg
            Fr.Label1 = mMsg1
            Fr.Show
            Fr.Refresh
            Me.Enabled = False
            Me.MousePointer = 11
            If FindPlan Then
                stbMsg.Panels(1).Text = mMsg2
                Me.Enabled = True
                Me.MousePointer = 0
            End If
            Unload Fr
        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 optKq(mNORMAL).Value Then
                tmpStr = tmpStr & "正常考勤"
            End If
            If optKq(mABNORMAL).Value Then
                tmpStr = tmpStr & "非正常考勤"
            End If
            If optKq(mALL).Value Then
                tmpStr = tmpStr & "全部考勤"
            End If
            tmpStr = tmpStr & "的记录"
            
            PrintGridNormal gOwnName & "-" & Me.Caption, _
                msfGrid, 1, tmpStr, True
        Case 2
            Unload Me
    End Select
End Sub
Private Function CheckQryIsExist() As Boolean
    Dim tmpTableName As String
    tmpTableName = Right(Year(Date), 2) & Val(cboMonth.Text)
    mSelQryName = gQRY & tmpTableName
    If HasThisQuery(mSelQryName) Then
        Me.Caption = Year(Date) & "年" _
            & Format(Val(cboMonth.Text), _
            "00") & "月  " & mMonthStr
        CheckQryIsExist = True
    Else
        CheckQryIsExist = False
    End If
End Function
Private Sub Command2_Click()
    Dim Frm As frmLookMan
    Set Frm = New frmLookMan
    With Frm
        .Show vbModal
        txtEmp = .mWorkNo
    End With
End Sub
Private Sub Form_Load()
    SetGridColor msfGrid
    msfGrid.FormatString = mFormatString
    With cboMonth
        .Clear
        Dim I As Integer
        For I = 1 To Month(Date)
            .AddItem Format(I, "00") & " 月"
        Next
        .ListIndex = Month(Date) - 1
    End With
    With cboDept
        .Clear
        FillCbo cboDept, aDepartment, 0
    End With
'gPlanTableName
End Sub
Private Function FindPlan() As Boolean
    Dim intDeptID As Integer
    Dim strWorkNo As String
    Dim strDept As String
    Dim WhereFlag As Boolean
    Dim Str As String
    Dim intRows As Integer
    
    'On Error GoTo FindErr
    getItemData cboDept, intDeptID
    strDept = Trim(cboDept.Text)
    strWorkNo = Trim(txtEmp)
    
    mSql = "select * from " & mSelQryName 'gPlanQryName
    If strWorkNo <> Empty Then
        mSql = mSql & JoinSqlStr(strWorkNo, WhereFlag, "WorkNo", True)
    End If
    If intDeptID <> gMAXITEM Then mSql = mSql & JoinSqlStr(intDeptID, WhereFlag, "DeptID", False)
    mSql = mSql & " order by WorkNo,F_Day"
    Set mRst = gDataBase.OpenRecordset(mSql)
    Dim IsContinue As Boolean
    Dim IntShift As Integer
    'Dim strWorkNo As String
    Dim strDate As String
    Dim strKqTime As String
    Dim blnNormal As Boolean
    Dim blnIsAll As Boolean
    Dim blnIsNormal As Boolean
    'Dim intRows As Long
    blnIsAll = (optKq(mALL).Value = True)
    blnIsNormal = (optKq(mNORMAL).Value = True)
    
    With mRst
        While Not .EOF
            IsContinue = True
            IntShift = !ID
            strWorkNo = Trim(!WorkNo)
            strKqTime = Empty
            strDate = Year(Date) & "-" _
                & Format(Month(Date), "00") & "-" _
                & Format(CStr(!F_Day), "00")
                
            blnNormal = IsNormal(IntShift, strWorkNo, strDate, strKqTime)
            If blnIsAll Then
                IsContinue = True
            Else
                If blnIsNormal Then
                    If Not blnNormal Then IsContinue = False
                Else
                    If blnNormal Then IsContinue = False
                End If
            End If
            
            If IsContinue Then
                intRows = intRows + 1
                Str = Str & strWorkNo & vbTab & _
                    IIf(IsNull(!Name), "", Trim(!Name)) & vbTab
                intDeptID = !DeptID
                Str = Str & GetDept(intDeptID) & vbTab _
                    & !F_Day & vbTab
                    
                If blnIsAll Then
                    If blnNormal Then
                        GetNormalKq Str, IntShift, strKqTime
                    Else
                        GetAbNormal Str, IntShift, strKqTime, strDate, strWorkNo
                    End If
                Else
                    If blnIsNormal Then '正常
                        GetNormalKq Str, IntShift, strKqTime
                    Else '非正常
                        GetAbNormal Str, IntShift, strKqTime, strDate, strWorkNo
                    End If
                End If
                If Not .EOF Then Str = Str & vbCr
            End If
            .MoveNext
        Wend
    End With
    intRows = intRows + msfGrid.FixedRows
    ClipToGrid msfGrid, Str, intRows, mGridCols
    With msfGrid
        .MergeCells = flexMergeRestrictRows
        .MergeCol(mWorkNo) = True
        .MergeCol(mName) = True
        .MergeCol(mDept) = True
    End With
    FindPlan = True
    Exit Function
FindErr:
    MsgBox mMsg3 & vbCrLf & Err.Description, vbCritical, gTitle
    stbMsg.Panels(1).Text = mMsg3
    FindPlan = False
    Err.Clear
    Me.Enabled = True
    Me.MousePointer = 0
End Function
Private Sub GetAbNormal(Str As String, IntShift As Integer, strKqTime As String, strDate As String, strWorkNo As String)
    Select Case IntShift
        Case gNOSHIFT '未排班
            Str = Str & gNOSHIFTNAME & vbTab
        Case GSHIFTLEAVEID, GSHIFTEVECTIONID, GSHIFTMONEYID
            If IntShift = GSHIFTLEAVEID Then '请假
                Str = Str & GSHIFTLEAVESTR & vbTab
                GetNote Str, True, strDate, strWorkNo, False
            Else
                If IntShift = GSHIFTEVECTIONID Then '出差
                    Str = Str & GSHIFTEVECTIONSTR & vbTab
                    GetNote Str, False, strDate, strWorkNo, True
                ElseIf IntShift = GSHIFTMONEYID Then '有薪假期
                    Str = Str & GSHIFTMONEYSTR & vbTab
                    GetNote Str, False, strDate, strWorkNo, False
                End If
            End If
        Case Else
            If strKqTime <> Empty Then '迟到
                Str = Str & gWORKLATE & vbTab & strKqTime
            Else '旷工
                Str = Str & gNOTINWORK & vbTab
            End If
    End Select
End Sub
Private Sub GetNote(Str As String, isLeave As Boolean, strDate As String, strWorkNo As String, isEvection As Boolean)
    Dim Sql As String
    Dim WhereFlag As Boolean
    Sql = Sql & "select StartTime,EndTime,StartDate,EndDate from "
    If isLeave Then
        Sql = Sql & "Leave"
        WhereFlag = False
    Else
        Sql = Sql & "Absent"
        Sql = Sql & " Where IsEvection="
        If isEvection Then
            Sql = Sql & gTRUE
        Else
            Sql = Sql & gFALSE
        End If
        WhereFlag = True
    End If
    If WhereFlag Then
        Sql = Sql & " and "
    Else
        Sql = Sql & " Where "
    End If
    Sql = Sql & " WorkNo='" & strWorkNo _
        & "' and StartDate<='" & strDate _
        & "' and EndDate>='" & strDate & "'" _
        & " and F_DelFlag=" & gFALSE _
        & " order by StartTime"
    Dim Rst As Recordset
    Set Rst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
    If Rst.RecordCount > 0 Then
        With Rst
            If strDate = Trim(!StartDate) And strDate = Trim(!EndDate) Then '在同一天之内
                Str = Str & mSTARTTIMESTR & Trim(!StartTime) _
                    & Space(1) & mENDTIMESTR & Trim(!EndTime)
            Else
                If strDate = Trim(!StartDate) Then '此天等于起始日期
                    Str = Str & mSTARTTIMESTR & Trim(!StartTime) _
                        & Space(1) & mTOSTR & Space(1) & mOUTWORKSTR
                ElseIf strDate = Trim(!EndDate) Then '此天等于截至日期
                    Str = Str & mINWORKSTR & Space(1) _
                        & mTOSTR & Space(1) & mENDTIMESTR & Trim(!EndTime)
                Else '当中
                    Str = Str & mWHOLEDAYSTR
                End If
            End If
        End With
    Else
        Str = Str & mMsg4
    End If
    Rst.Close
    Set Rst = Nothing
End Sub
Private Sub GetNormalKq(Str As String, IntShift As Integer, strKqTime As String)
    If IntShift = GSHIFTRESTID Then '休息
        Str = Str & GSHIFTRESTSTR & vbTab
    Else '正常出勤
        Str = Str & gNORMALKQSTR & vbTab & strKqTime
    End If
End Sub
Private Function IsNormal(IntShift As Integer, strWorkNo As String, strDate As String, strKqTime As String) As Boolean
    If IntShift = GSHIFTRESTID Then
        IsNormal = True
        Exit Function
    Else
        If IsNormalKq(IntShift, strWorkNo, strDate, strKqTime) Then
            IsNormal = True
            Exit Function
        End If
    End If
    IsNormal = False
End Function
Private Function GetDept(intDeptID As Integer) As String
    Dim I As Integer
    For I = 0 To UBound(aDepartment)
        With aDepartment(I)
            If .ID = intDeptID Then
                GetDept = Trim(.Name)
                Exit Function
            End If
        End With
    Next
    GetDept = Empty
End Function

						