Other Databases

Development Platform:
Visual Basic

frmMain.frm：Code Content
							VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{FE0065C0-1B7B-11CF-9D53-00AA003C9CB6}#1.1#0"; "COMCT232.OCX"
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Begin VB.Form frmMain 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   8190
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   11880
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmMain.frx":0000
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   8190
   ScaleWidth      =   11880
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin MSMask.MaskEdBox medTime 
      Height          =   345
      Left            =   3795
      TabIndex        =   70
      Top             =   5145
      Visible         =   0   'False
      Width           =   765
      _ExtentX        =   1349
      _ExtentY        =   609
      _Version        =   393216
      BackColor       =   -2147483624
      MaxLength       =   5
      Mask            =   "##:##"
      PromptChar      =   "_"
   End
   Begin MSMask.MaskEdBox medDate 
      Height          =   360
      Left            =   3555
      TabIndex        =   69
      Top             =   4605
      Visible         =   0   'False
      Width           =   1215
      _ExtentX        =   2143
      _ExtentY        =   635
      _Version        =   393216
      BackColor       =   -2147483624
      MaxLength       =   10
      Mask            =   "####-##-##"
      PromptChar      =   "_"
   End
   Begin VB.TextBox txtEdit 
      BackColor       =   &H80000018&
      Height          =   360
      Left            =   3375
      MaxLength       =   4
      TabIndex        =   1
      Top             =   4050
      Visible         =   0   'False
      Width           =   1275
   End
   Begin MSFlexGridLib.MSFlexGrid msfGrid 
      Height          =   4680
      Left            =   180
      TabIndex        =   0
      Top             =   3195
      Width           =   11535
      _ExtentX        =   20346
      _ExtentY        =   8255
      _Version        =   393216
      Rows            =   20
      FixedCols       =   0
      BackColor       =   -2147483624
      BackColorFixed  =   12632256
      ForeColorFixed  =   12582912
      BackColorBkg    =   -2147483624
      FormatString    =   "<sdfsdddsdsdsdsd"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Frame fraList 
      Height          =   2235
      Left            =   210
      TabIndex        =   43
      Top             =   795
      Visible         =   0   'False
      Width           =   11520
      Begin VB.ListBox lstInValidCard 
         Height          =   1530
         Left            =   5925
         TabIndex        =   45
         Top             =   495
         Width           =   5310
      End
      Begin VB.ListBox lstNotRegister 
         Height          =   1530
         Left            =   255
         TabIndex        =   44
         Top             =   495
         Width           =   5310
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "记录总数:"
         Height          =   210
         Index           =   1
         Left            =   9120
         TabIndex        =   51
         Top             =   225
         Width           =   945
      End
      Begin VB.Label lblInvalidCard 
         AutoSize        =   -1  'True
         Caption         =   "0"
         Height          =   210
         Left            =   10260
         TabIndex        =   50
         Top             =   240
         Width           =   105
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "记录总数:"
         Height          =   210
         Index           =   0
         Left            =   3255
         TabIndex        =   49
         Top             =   225
         Width           =   945
      End
      Begin VB.Label lblNotRegister 
         AutoSize        =   -1  'True
         Caption         =   "0"
         Height          =   210
         Left            =   4395
         TabIndex        =   48
         Top             =   225
         Width           =   105
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "采集到无效流通卡记录列表"
         Height          =   210
         Index           =   1
         Left            =   5925
         TabIndex        =   47
         Top             =   225
         Width           =   2520
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "采集到卡未登记记录列表"
         Height          =   210
         Index           =   0
         Left            =   240
         TabIndex        =   46
         Top             =   225
         Width           =   2310
      End
   End
   Begin VB.Frame fraEdit 
      Height          =   2235
      Left            =   210
      TabIndex        =   2
      Top             =   795
      Visible         =   0   'False
      Width           =   11520
      Begin VB.TextBox txtKQ 
         Height          =   330
         Index           =   13
         Left            =   9375
         MaxLength       =   12
         TabIndex        =   30
         Top             =   1235
         Width           =   1830
      End
      Begin VB.PictureBox picHour 
         BackColor       =   &H00FFFFFF&
         Height          =   345
         Index           =   1
         Left            =   9360
         ScaleHeight     =   285
         ScaleWidth      =   555
         TabIndex        =   41
         Top             =   255
         Width           =   615
         Begin VB.TextBox txtKQ 
            Alignment       =   2  'Center
            BorderStyle     =   0  'None
            Height          =   315
            Index           =   7
            Left            =   30
            TabIndex        =   20
            Text            =   "1"
            Top             =   45
            Width           =   240
         End
         Begin ComCtl2.UpDown VScrollHour 
            Height          =   315
            Index           =   0
            Left            =   285
            TabIndex        =   21
            TabStop         =   0   'False
            Top             =   -15
            Width           =   270
            _ExtentX        =   476
            _ExtentY        =   556
            _Version        =   327681
            BuddyControl    =   "txtKQ(7)"
            BuddyDispid     =   196622
            BuddyIndex      =   7
            OrigLeft        =   300
            OrigTop         =   -15
            OrigRight       =   570
            OrigBottom      =   300
            Max             =   23
            SyncBuddy       =   -1  'True
            Wrap            =   -1  'True
            BuddyProperty   =   65547
            Enabled         =   -1  'True
         End
      End
      Begin VB.PictureBox picHour 
         BackColor       =   &H00FFFFFF&
         Height          =   345
         Index           =   0
         Left            =   9360
         ScaleHeight     =   285
         ScaleWidth      =   555
         TabIndex        =   40
         Top             =   738
         Width           =   615
         Begin ComCtl2.UpDown VScrollMinite 
            Height          =   315
            Index           =   0
            Left            =   285
            TabIndex        =   26
            TabStop         =   0   'False
            Top             =   -15
            Width           =   270
            _ExtentX        =   476
            _ExtentY        =   556
            _Version        =   327681
            BuddyControl    =   "txtKQ(10)"
            BuddyDispid     =   196622
            BuddyIndex      =   10
            OrigLeft        =   285
            OrigTop         =   -15
            OrigRight       =   555
            OrigBottom      =   300
            Max             =   23
            SyncBuddy       =   -1  'True
            Wrap            =   -1  'True
            BuddyProperty   =   65547
            Enabled         =   -1  'True
         End
         Begin VB.TextBox txtKQ 
            Alignment       =   2  'Center
            BorderStyle     =   0  'None
            Height          =   315
            Index           =   10
            Left            =   15
            TabIndex        =   25
            Text            =   "1"
            Top             =   30
            Width           =   255
         End
      End
      Begin VB.PictureBox picMinite 
         BackColor       =   &H00FFFFFF&
         Height          =   345
         Index           =   1
         Left            =   10380
         ScaleHeight     =   285
         ScaleWidth      =   555
         TabIndex        =   37
         Top             =   248
         Width           =   615
         Begin ComCtl2.UpDown VScrollHour 
            Height          =   300
            Index           =   1
            Left            =   285
            TabIndex        =   23
            TabStop         =   0   'False
            Top             =   0
            Width           =   270
            _ExtentX        =   476
            _ExtentY        =   529
            _Version        =   327681
            BuddyControl    =   "txtKQ(8)"
            BuddyDispid     =   196622
            BuddyIndex      =   8
            OrigLeft        =   285
            OrigRight       =   555
            OrigBottom      =   300
            Max             =   59
            SyncBuddy       =   -1  'True
            Wrap            =   -1  'True
            BuddyProperty   =   65547
            Enabled         =   -1  'True
         End
         Begin VB.TextBox txtKQ 
            Alignment       =   2  'Center
            BorderStyle     =   0  'None
            Height          =   315
            Index           =   8
            Left            =   30
            TabIndex        =   22
            Text            =   "1"
            Top             =   45
            Width           =   255
         End
      End
      Begin VB.PictureBox picMinite 
         BackColor       =   &H00FFFFFF&
         DrawStyle       =   2  'Dot
         DrawWidth       =   17015
         Height          =   345
         Index           =   0
         Left            =   10380
         ScaleHeight     =   285
         ScaleWidth      =   555
         TabIndex        =   34
         Top             =   738
         Width           =   615
         Begin ComCtl2.UpDown VScrollMinite 
            Height          =   315
            Index           =   1
            Left            =   285
            TabIndex        =   28
            TabStop         =   0   'False
            Top             =   -15
            Width           =   270
            _ExtentX        =   476
            _ExtentY        =   556
            _Version        =   327681
            BuddyControl    =   "txtKQ(11)"
            BuddyDispid     =   196622
            BuddyIndex      =   11
            OrigLeft        =   285
            OrigTop         =   -15
            OrigRight       =   555
            OrigBottom      =   300
            Max             =   59
            SyncBuddy       =   -1  'True
            Wrap            =   -1  'True
            BuddyProperty   =   65547
            Enabled         =   -1  'True
         End
         Begin VB.TextBox txtKQ 
            Alignment       =   2  'Center
            BorderStyle     =   0  'None
            Height          =   315
            Index           =   11
            Left            =   45
            TabIndex        =   27
            Text            =   "1"
            Top             =   45
            Width           =   225
         End
      End
      Begin VB.TextBox txtKQ 
         Height          =   330
         Index           =   9
         Left            =   6585
         Locked          =   -1  'True
         TabIndex        =   24
         Top             =   745
         Width           =   1410
      End
      Begin VB.ComboBox cboKQ 
         Enabled         =   0   'False
         Height          =   330
         Left            =   6585
         Style           =   2  'Dropdown List
         TabIndex        =   29
         Top             =   1235
         Width           =   1425
      End
      Begin VB.TextBox txtKQ 
         Height          =   330
         Index           =   12
         Left            =   1230
         MaxLength       =   50
         TabIndex        =   31
         Top             =   1725
         Width           =   9990
      End
      Begin VB.TextBox txtKQ 
         Height          =   330
         Index           =   6
         Left            =   6585
         Locked          =   -1  'True
         TabIndex        =   19
         Top             =   255
         Width           =   1410
      End
      Begin VB.TextBox txtKQ 
         Enabled         =   0   'False
         Height          =   330
         Index           =   5
         Left            =   3915
         Locked          =   -1  'True
         TabIndex        =   18
         Top             =   1235
         Width           =   1410
      End
      Begin VB.TextBox txtKQ 
         Enabled         =   0   'False
         Height          =   330
         Index           =   4
         Left            =   1230
         Locked          =   -1  'True
         TabIndex        =   17
         Top             =   1235
         Width           =   1410
      End
      Begin VB.TextBox txtKQ 
         Enabled         =   0   'False
         Height          =   330
         Index           =   3
         Left            =   3915
         Locked          =   -1  'True
         TabIndex        =   16
         Top             =   745
         Width           =   1410
      End
      Begin VB.TextBox txtKQ 
         Enabled         =   0   'False
         Height          =   330
         Index           =   2
         Left            =   1230
         Locked          =   -1  'True
         TabIndex        =   15
         Top             =   745
         Width           =   1410
      End
      Begin VB.TextBox txtKQ 
         Enabled         =   0   'False
         Height          =   330
         Index           =   1
         Left            =   3915
         Locked          =   -1  'True
         TabIndex        =   14
         Top             =   255
         Width           =   1410
      End
      Begin VB.TextBox txtKQ 
         Height          =   330
         Index           =   0
         Left            =   1230
         TabIndex        =   13
         Top             =   255
         Width           =   1410
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "批 准 人:"
         Height          =   210
         Index           =   10
         Left            =   8325
         TabIndex        =   42
         Top             =   1290
         Width           =   945
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "分"
         Height          =   210
         Index           =   15
         Left            =   11055
         TabIndex        =   39
         Top             =   315
         Width           =   210
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "时"
         Height          =   210
         Index           =   14
         Left            =   10035
         TabIndex        =   38
         Top             =   315
         Width           =   210
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "分"
         Height          =   210
         Index           =   13
         Left            =   11055
         TabIndex        =   36
         Top             =   802
         Width           =   210
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "时"
         Height          =   210
         Index           =   12
         Left            =   10035
         TabIndex        =   35
         Top             =   795
         Width           =   210
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "截止日期:"
         Height          =   210
         Index           =   11
         Left            =   5610
         TabIndex        =   33
         Top             =   805
         Width           =   945
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "截止时间:"
         Height          =   210
         Index           =   8
         Left            =   8325
         TabIndex        =   32
         Top             =   805
         Width           =   945
      End
      Begin VB.Label lblReason 
         AutoSize        =   -1  'True
         Caption         =   "请假事由:"
         Height          =   210
         Left            =   240
         TabIndex        =   12
         Top             =   1785
         Width           =   945
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "请假类别:"
         Height          =   210
         Index           =   9
         Left            =   5610
         TabIndex        =   11
         Top             =   1295
         Width           =   945
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "起始时间:"
         Height          =   210
         Index           =   7
         Left            =   8325
         TabIndex        =   10
         Top             =   315
         Width           =   945
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "起始日期:"
         Height          =   210
         Index           =   6
         Left            =   5610
         TabIndex        =   9
         Top             =   315
         Width           =   945
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "部    门:"
         Height          =   210
         Index           =   5
         Left            =   2940
         TabIndex        =   8
         Top             =   1295
         Width           =   945
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "职    务:"
         Height          =   210
         Index           =   4
         Left            =   240
         TabIndex        =   7
         Top             =   1295
         Width           =   945
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "年    龄:"
         Height          =   210
         Index           =   3
         Left            =   2940
         TabIndex        =   6
         Top             =   805
         Width           =   945
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "性    别:"
         Height          =   210
         Index           =   2
         Left            =   240
         TabIndex        =   5
         Top             =   805
         Width           =   945
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "姓    名:"
         Height          =   210
         Index           =   1
         Left            =   2940
         TabIndex        =   4
         Top             =   315
         Width           =   945
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "工    号:"
         Height          =   210
         Index           =   0
         Left            =   240
         TabIndex        =   3
         Top             =   315
         Width           =   945
      End
   End
   Begin VB.PictureBox picMain 
      Height          =   660
      Left            =   210
      ScaleHeight     =   600
      ScaleWidth      =   11430
      TabIndex        =   60
      Top             =   75
      Width           =   11490
      Begin VB.CommandButton cmdKq 
         BackColor       =   &H00C0C0C0&
         Height          =   465
         Index           =   6
         Left            =   7848
         Picture         =   "frmMain.frx":000C
         Style           =   1  'Graphical
         TabIndex        =   68
         Top             =   75
         UseMaskColor    =   -1  'True
         Width           =   1245
      End
      Begin VB.CommandButton cmdKq 
         BackColor       =   &H00C0C0C0&
         Height          =   465
         Index           =   5
         Left            =   9705
         Picture         =   "frmMain.frx":1CFA
         Style           =   1  'Graphical
         TabIndex        =   67
         Top             =   75
         UseMaskColor    =   -1  'True
         Width           =   1245
      End
      Begin VB.CommandButton cmdKq 
         BackColor       =   &H00FFFFFF&
         Caption         =   "查找(&Q)"
         Height          =   465
         Index           =   4
         Left            =   7395
         TabIndex        =   66
         Top             =   120
         UseMaskColor    =   -1  'True
         Visible         =   0   'False
         Width           =   1365
      End
      Begin VB.CommandButton cmdKq 
         BackColor       =   &H00C0C0C0&
         Height          =   465
         Index           =   3
         Left            =   5991
         Picture         =   "frmMain.frx":3B6B
         Style           =   1  'Graphical
         TabIndex        =   65
         Top             =   75
         UseMaskColor    =   -1  'True
         Width           =   1245
      End
      Begin VB.CommandButton cmdKq 
         BackColor       =   &H00FFFFFF&
         Caption         =   "采集(&C)"
         Height          =   465
         Index           =   7
         Left            =   420
         TabIndex        =   64
         Top             =   75
         UseMaskColor    =   -1  'True
         Width           =   1245
      End
      Begin VB.CommandButton cmdKq 
         BackColor       =   &H00C0C0C0&
         Height          =   465
         Index           =   0
         Left            =   2277
         Picture         =   "frmMain.frx":590A
         Style           =   1  'Graphical
         TabIndex        =   63
         Top             =   75
         UseMaskColor    =   -1  'True
         Width           =   1245
      End
      Begin VB.CommandButton cmdKq 
         BackColor       =   &H00C0C0C0&
         Height          =   465
         Index           =   1
         Left            =   4134
         Picture         =   "frmMain.frx":76A9
         Style           =   1  'Graphical
         TabIndex        =   62
         Top             =   75
         UseMaskColor    =   -1  'True
         Width           =   1245
      End
      Begin VB.CommandButton cmdKq 
         BackColor       =   &H00FFFFFF&
         Caption         =   "修改(&M)"
         Height          =   465
         Index           =   2
         Left            =   4935
         TabIndex        =   61
         Top             =   120
         UseMaskColor    =   -1  'True
         Visible         =   0   'False
         Width           =   1365
      End
   End
   Begin VB.PictureBox picEdit 
      Height          =   660
      Left            =   210
      ScaleHeight     =   600
      ScaleWidth      =   11430
      TabIndex        =   52
      Top             =   75
      Width           =   11490
      Begin VB.CommandButton cmdEdit 
         Height          =   465
         Index           =   6
         Left            =   7905
         Picture         =   "frmMain.frx":94A9
         Style           =   1  'Graphical
         TabIndex        =   59
         Top             =   75
         Width           =   1245
      End
      Begin VB.CommandButton cmdEdit 
         Height          =   465
         Index           =   5
         Left            =   9780
         Picture         =   "frmMain.frx":B197
         Style           =   1  'Graphical
         TabIndex        =   58
         Top             =   75
         Width           =   1245
      End
      Begin VB.CommandButton cmdEdit 
         Height          =   465
         Index           =   3
         Left            =   6045
         Picture         =   "frmMain.frx":D008
         Style           =   1  'Graphical
         TabIndex        =   56
         Top             =   75
         Width           =   1245
      End
      Begin VB.CommandButton cmdEdit 
         Height          =   465
         Index           =   2
         Left            =   4170
         Picture         =   "frmMain.frx":EDA7
         Style           =   1  'Graphical
         TabIndex        =   55
         Top             =   75
         Width           =   1245
      End
      Begin VB.CommandButton cmdEdit 
         Height          =   465
         Index           =   1
         Left            =   2310
         Picture         =   "frmMain.frx":10B8A
         Style           =   1  'Graphical
         TabIndex        =   54
         Top             =   75
         Width           =   1245
      End
      Begin VB.CommandButton cmdEdit 
         Height          =   465
         Index           =   0
         Left            =   450
         Picture         =   "frmMain.frx":1298A
         Style           =   1  'Graphical
         TabIndex        =   53
         Top             =   75
         Width           =   1245
      End
      Begin VB.CommandButton cmdEdit 
         Caption         =   "查询(&S)"
         Height          =   465
         Index           =   4
         Left            =   6135
         TabIndex        =   57
         Top             =   120
         Visible         =   0   'False
         Width           =   1365
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑(&E)"
      Visible         =   0   'False
      Begin VB.Menu mnuEditModify 
         Caption         =   "修改(&M)"
      End
      Begin VB.Menu mnuEditDelete 
         Caption         =   "删除(&D)"
      End
   End
   Begin VB.Menu mnuList 
      Caption         =   "dd"
      Visible         =   0   'False
      Begin VB.Menu mnuListRegister 
         Caption         =   "登记此卡"
      End
      Begin VB.Menu mnuListAppend 
         Caption         =   "添加到考勤中"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mblnIsModify As Boolean
Dim mblnIsAdd As Boolean
Dim mblnIsNeedSave As Boolean
Dim mblnCollectModify As Boolean
Dim mOldKqDate As String
Dim mOldKqTime As String
Dim mPosName As String
Const mDATEMASK = "####-##-##"
Const mTIMEMASK = "##:##"
Public mMenuIndex As Integer 'frmMdi调用
Dim mStatus As Integer 'differ leave,absent
Dim mFormatString  As String
Dim mRowBeforeSave As Integer '保存前的行数
Dim mOldName As String 'old grid text before edit
Const mMsg1 = "考勤机未打开!"
Const mMsg2 = "线路出现严重故障,请检查!"
Const mMsg3 = "数据传输出错!"
Const mMsg4 = "无数据可采集!"
Const mMsg5 = "数据已采集完毕!"
Const mRetryTimes = 3
Private Const mIntCollectCols = 7
Private Const mIntLeaveCols = 12
Private Const mIntAbsentCols = 11
Private Const mstrSHour = "8"
Private Const mstrEHour = "13"
Private Const mstrMinute = "0"
Private Const mstrAbsent = "缺席"
'*****cols of grid
'Private Const mCollectCols = 7
'Private Const mLeaveCols = 11
'Private Const mAbsentCols = 10
'*******cmdkq'其他同cmdEdit
Private Const mRefresh = 6
Private Const mCollect = 7
'*****strdata
'Private Const mTotal = 1
'Private Const mReceive = 2
'Private Const mDate = 3
'Private Const mTime = 4
'******msfGrid
Private Const mGridWorkNo = 0
Private Const mGridName = 1
Private Const mGridSex = 2
Private Const mGridDept = 3
Private Const mGridTitle = 4
Private Const mGridStartDate = 5
Private Const mGridStartTime = 6
Private Const mGridEndDate = 7
Private Const mGridEndTime = 8
Private Const mGridType = 9
Private Const mGridAllowMan = 10
Private Const mGridReason = 11
'******txtKQ
Private Const mtxtWorkNo = 0
Private Const mtxtName = 1
Private Const mtxtSex = 2
Private Const mtxtAge = 3
Private Const mtxtTitle = 4
Private Const mtxtDept = 5
Private Const mtxtSDate = 6
Private Const mtxtSHour = 7
Private Const mtxtSMinute = 8
Private Const mtxtEDate = 9
Private Const mtxtEHour = 10
Private Const mtxtEMinute = 11
Private Const mtxtReason = 12
Private Const mtxtAllowMan = 13
'*******VScrollHour
Private Const mVSStart = 0
Private Const mVSEnd = 1
Dim mKqRecord() As KQTemp '采集临时数据
Dim mColNotRegister() As KQTemp  '未登记的卡号
Dim mColInValidCard() As KQTemp '流通中的无效卡
Const mHasInValidTop = 3165
Const mHasInValidHeight = 4680
Const mValidTop = 790
Const mValidHeight = 6955
Const mMsg6 = "您确定不保存吗?"
Const mMsg7 = "出现某一未知的错误!!数据保存未成功!"
Const mMsg8 = "您确定要删除该条记录吗?"
Const mMsg9 = "抱歉,删除不成功!"
'***frmdetail.mtitle
Const mstrDui = "对"
Const mstrEmployee = "的员工"
Const mstrDoPlan = "进行排班"
Private Sub cboEdit_GotFocus()
    msfGrid.ScrollBars = flexScrollBarNone
End Sub
'Private Sub cboEdit_LostFocus()
'    cboEdit.Visible = False
'    msfGrid.ScrollBars = flexScrollBarBoth
'    msfGrid.SetFocus
'End Sub
Private Sub cmdEdit_Click(Index As Integer)
    Dim strTmp As String
    Select Case Index
        Case gCMDAPPEND
            Dim blnIsToGo As Boolean
            blnIsToGo = True
            If Not mblnIsAdd Then
                strTmp = gSTRCANCEL
                AddAction
                InitxtEdit
                txtKQ(mtxtWorkNo).SetFocus
            Else
                If mblnIsNeedSave Then
                    If MsgBox(mMsg6, vbQuestion + _
                        vbYesNo + vbDefaultButton2, gTitle) _
                        = vbNo Then
                        blnIsToGo = False
                    End If
                End If
                If blnIsToGo Then
                    strTmp = gSTRAPPEND
                    InitxtEdit
                    ChangeColorFortxtKQ False
                    mblnIsNeedSave = False
                    RefreshButton cmdEdit, gCMDEDITCANCEL
                Else
                    strTmp = gSTRCANCEL
                End If
            End If
            strTmp = strTmp & "(&A)"
            cmdEdit(gCMDAPPEND).Caption = strTmp
            If blnIsToGo Then
                mblnIsAdd = Not mblnIsAdd
            End If
        Case gCMDSAVE
            If SaveDataToDatabase Then
               AfterSave
               strTmp = gSTRMODIFY & "&M"
               cmdEdit(gCMDEDIT).Caption = strTmp
               mnuEditModify.Caption = strTmp
            End If
        Case gCMDEDIT
            If Not mblnIsModify Then
                strTmp = gSTRRESET
                ToModify
            Else
                strTmp = gSTRMODIFY
                AfterSave
            End If
            strTmp = strTmp & "(&M)"
            mnuEditModify.Caption = strTmp
            cmdEdit(gCMDEDIT).Caption = strTmp
        Case gCMDDELETE
            If DeleteForLeave Then
                If Not txtKQ(mtxtWorkNo).Locked Then InitxtEdit
                RefreshButton cmdEdit, gCMDEDITNORMAL
            End If
        Case gCMDQUERY
        Case gCMDRETURN
            If Trim(txtKQ(mtxtWorkNo)) <> Empty Then
                If MsgBox("您还没保存,要保存吗?", vbQuestion + vbYesNo, gTitle) = vbYes Then
                    cmdEdit_Click gCMDSAVE
                    Exit Sub
                End If
            End If
            Unload Me
        Case mRefresh
            RefreshHistory
    End Select
End Sub
Private Function DeleteForLeave() As Boolean
    Dim strWorkNo As String
    Dim strSDate As String
    Dim strSTime As String
    Dim strEDate As String
    Dim strETime As String
    Dim Sql As String
    
    If MsgBox(mMsg8, _
        vbQuestion + vbOKCancel + vbDefaultButton2, _
        gTitle) = vbCancel Then Exit Function
    
    On Error GoTo DeleteErr
    With msfGrid
        strWorkNo = Trim(.TextMatrix(.row, mGridWorkNo))
        strSDate = Trim(.TextMatrix(.row, mGridStartDate))
        strSTime = Trim(.TextMatrix(.row, mGridStartTime))
        strEDate = Trim(.TextMatrix(.row, mGridEndDate))
        strETime = Trim(.TextMatrix(.row, mGridEndTime))
        
        Sql = "Update "
        If mStatus = gMAINLEAVE Then
            Sql = Sql & "Leave"
        ElseIf mStatus = gMAINABSENT Then
            Sql = Sql & "Absent"
        End If
        Sql = Sql & " set F_DelFlag=" & gTRUE _
                & " where WorkNo ='" & strWorkNo _
                & "' and StartDate='" & strSDate _
                & "' and StartTime='" & strSTime _
                & "' and EndDate='" & strEDate _
                & "' and EndTime='" & strETime & "'"
        gDataBase.Execute Sql
        DeleteForLeave = True
        If .Rows = .FixedRows + 1 Then
            .Rows = .FixedRows
        Else
            .RemoveItem .row
        End If
    End With
    
    Exit Function
DeleteErr:
    MsgBox mMsg9 & vbCrLf & vbCrLf & Err.Description, vbExclamation, gTitle
    Err.Clear
    DeleteForLeave = False
End Function
Private Sub ToModify()
    With msfGrid
        Dim i As Integer
        Dim CellStr As String
        mblnIsModify = True
        For i = 0 To .Cols - 1
            CellStr = Trim(.TextMatrix(.row, i))
            Select Case i
                Case 0 To 2
                    txtKQ(i) = CellStr
                Case 3
                    txtKQ(mtxtDept) = CellStr
                Case 4
                    txtKQ(mtxtTitle) = CellStr
                Case mGridStartDate
                    txtKQ(mtxtSDate) = CellStr
                Case mGridStartTime
                    txtKQ(mtxtSHour) = Left(CellStr, 2)
                    txtKQ(mtxtSMinute) = Right(CellStr, 2)
                Case mGridEndDate
                    txtKQ(mtxtEDate) = CellStr
                Case mGridEndTime
                    txtKQ(mtxtEHour) = Left(CellStr, 2)
                    txtKQ(mtxtEMinute) = Right(CellStr, 2)
                Case mGridType
                    LookForCboByStr cboKQ, CellStr
                Case mGridAllowMan
                    txtKQ(mtxtAllowMan) = CellStr
                Case mGridReason
                    txtKQ(mtxtReason) = CellStr
            End Select
        Next
    End With
    ChangeColorFortxtKQ True
    RefreshButton cmdEdit, gCMDEDIT
    cmdEdit(mRefresh).Enabled = False
    txtKQ(mtxtWorkNo).Locked = True
    txtKQ(mtxtSDate).SetFocus
End Sub
Private Sub AfterSave()
    InitxtEdit
    ChangeColorFortxtKQ False
    RefreshButton cmdEdit, gCMDEDITNORMAL
    cmdEdit(mRefresh).Enabled = True
    mblnIsModify = False
    mblnIsAdd = False
    mblnIsNeedSave = False
    cmdEdit(gCMDAPPEND).Caption = gSTRAPPEND & "&A"
End Sub
Private Function SaveDataToDatabase() As Boolean
    Dim strWorkNo As String
    Dim strAllowMan As String
    Dim strSDate As String
    Dim strSTime As String
    Dim strEDate As String
    Dim strETime As String
    Dim intLeaveType As Integer
    Dim strReason As String
    Dim isTrans As Boolean
    
    strWorkNo = Trim(txtKQ(mtxtWorkNo))
    strAllowMan = Trim(txtKQ(mtxtAllowMan))
    strSDate = Trim(txtKQ(mtxtSDate))
    strSTime = Format(Trim(txtKQ(mtxtSHour)), "00") & ":" _
        & Format(Trim(txtKQ(mtxtSMinute)), "00")
    strEDate = Trim(txtKQ(mtxtEDate))
    strETime = Format(Trim(txtKQ(mtxtEHour)), "00") & ":" _
        & Format(Trim(txtKQ(mtxtEMinute)), "00")
    strReason = Trim(txtKQ(mtxtReason))
    getItemData cboKQ, intLeaveType
    
    If Not mblnIsModify Then
        If strWorkNo = Empty Then
            MsgBox "工号不能为空,请输入!!", , gTitle
            SaveDataToDatabase = False
            txtKQ(mtxtWorkNo).SetFocus
            Exit Function
        Else
            If Trim(txtKQ(mtxtName)) = Empty Then
                MsgBox "无效的工号,请核对后重新输入!!", , gTitle
                SaveDataToDatabase = False
                txtKQ(mtxtWorkNo).SetFocus
                Exit Function
            End If
        End If
    End If
    
    If strAllowMan = Empty Then
        If mStatus = gMAINLEAVE Then
            MsgBox "没有批准人怎么能准假呢?,请输入!!", , gTitle
        ElseIf mStatus = gMAINABSENT Then
            MsgBox "批准人不能为空,请输入!!", , gTitle
        End If
        SaveDataToDatabase = False
        txtKQ(mtxtAllowMan).SetFocus
        Exit Function
    End If
    
    If strSDate = Empty Then
        MsgBox "起始日期不能为空,请输入!!", , gTitle
        SaveDataToDatabase = False
        txtKQ(mtxtSDate).SetFocus
        Exit Function
    End If
    If strEDate = Empty Then
        MsgBox "截至日期不能为空,请输入!!", , gTitle
        SaveDataToDatabase = False
        txtKQ(mtxtEDate).SetFocus
        Exit Function
    End If
    
    If (strSDate & strSTime) >= (strEDate & strETime) Then
        MsgBox "起始日期时间不能大于或等于截至日期时间!!", , gTitle
        SaveDataToDatabase = False
        txtKQ(mtxtSDate).SetFocus
        Exit Function
    End If
    
    If Not HasThisTable(gPlanTableName) Then
        If Not CreatePlanTable Then
            MsgBox mMsg7, vbCritical, gTitle
            SaveDataToDatabase = False
            Exit Function
        End If
    End If
    
    Dim strOperateTime As String
    strOperateTime = Format(Now, "yyyy-mm-dd hh:mm")
    
    Dim Rst As Recordset
    If mStatus = gMAINLEAVE Then
        Set Rst = gDataBase.OpenRecordset("Leave")
    ElseIf mStatus = gMAINABSENT Then
        Set Rst = gDataBase.OpenRecordset("Absent")
    End If
    
    On Error GoTo SaveErr
    
    BeginTrans
    isTrans = True
    If Not mblnIsModify Then
        Rst.AddNew
        Rst!WorkNo = strWorkNo
    Else
        Rst.Edit
    End If
    With Rst
        !StartDate = strSDate
        !StartTime = strSTime
        !EndDate = strEDate
        !EndTime = strETime
        !UserID = gUserID
        !AllowMan = strAllowMan
        !OperateTime = strOperateTime
        If mStatus = gMAINLEAVE Then
            !TypeID = intLeaveType
            !Reason = strReason
        ElseIf mStatus = gMAINABSENT Then
            !isEvection = intLeaveType
        End If
        .Update
    End With
    Rst.Close
    
'    UpdateShiftPlan strSDate, strEDate, Trim(cboKQ.Text)
    
    CommitTrans
    isTrans = False
    Set Rst = Nothing
    SaveDataToDatabase = True
    
    If Not mblnIsModify Then
        Dim StrAdd As String
        With msfGrid
            StrAdd = strWorkNo & vbTab & Trim(txtKQ(mtxtName)) _
                & vbTab & Trim(txtKQ(mtxtSex)) & vbTab _
                & Trim(txtKQ(mtxtDept)) & vbTab _
                & Trim(txtKQ(mtxtTitle)) & vbTab _
                & strSDate & vbTab & strSTime & vbTab _
                & strEDate & vbTab & strETime & vbTab _
                & Trim(cboKQ.Text) & vbTab _
                & strAllowMan & vbTab
            If mStatus = gMAINLEAVE Then
                StrAdd = StrAdd & strReason
            End If
            .AddItem StrAdd
            .TopRow = .Rows - 1
        End With
    Else
        With msfGrid
            .TextMatrix(.row, mGridStartDate) = strSDate
            .TextMatrix(.row, mGridStartTime) = strSTime
            .TextMatrix(.row, mGridEndDate) = strEDate
            .TextMatrix(.row, mGridEndTime) = strETime
            .TextMatrix(.row, mGridType) = Trim(cboKQ.Text)
            .TextMatrix(.row, mGridAllowMan) = strAllowMan
            If mStatus = gMAINLEAVE Then
                .TextMatrix(.row, mGridReason) = strReason
            End If
        End With
    End If
    DoPlan strWorkNo, Trim(txtKQ(mtxtName)), Trim(txtKQ(mtxtDept))
    'MsgBox "恭喜!数据保存成功,请修改排班表", vbInformation, gTitle
    Exit Function
SaveErr:
    If isTrans Then
        Rollback
        MsgBox "数据未保存成功!请再试!! " & vbCrLf _
            & vbCrLf & Err.Description, vbExclamation, gTitle
    Else
        MsgBox Err.Description, vbExclamation, gTitle
    End If
    Err.Clear
    SaveDataToDatabase = False
   ' Rst.CancelUpdate
End Function
Private Sub DoPlan(strWorkNo As String, strName As String, strDeptName As String)
    Dim MyfrmDetail As frmDetail
    Set MyfrmDetail = New frmDetail
    Dim strTemp As String
    With MyfrmDetail
            .mDeptID = Empty
            .mWorkNo = strWorkNo
            strTemp = mstrDui
            strTemp = strTemp & "[" & strDeptName & "]" & mstrEmployee _
                     & "[" & strName & "]"
            .mTitle = strTemp & mstrDoPlan
            .mIsToLook = False
        .Show vbModal
        'If .mNeedToRefresh Then tvwPlan_NodeClick mNode
        Unload MyfrmDetail
    End With
End Sub
'Private Sub UpdateShiftPlan(strSDate As String, strEDate As String, strAbsentType As String)
'    Dim intStartDay As Integer
'    Dim intEndDay As Integer
'    intStartDay = CInt(Var(Right(strSDate, 2)))
'    intEndDay = CInt(Var(Right(strEDate, 2)))
'    Dim IntDay As Integer
'    Dim Sql As String
'    For IntDay = intStartDay To intEndDay
'        Sql = "update " & gPlanTableName & _
'            " set F_Shift="
'        If mStatus = gMAINLEAVE Then
'            Sql = Sql & GSHIFTLEAVEID
'        ElseIf mStatus = gMAINABSENT Then
'            If strAbsentType = GSHIFTEVECTIONSTR Then
'                Sql = Sql & GSHIFTEVECTIONID
'            ElseIf strAbsentType = GSHIFTMONEYSTR Then
'                Sql = Sql & GSHIFTMONEYID
'            End If
'        End If
'        Sql = Sql & " Where WorkNo='" & strWorkNo & _
'            "' and F_Day=" & IntDay
'        gDataBase.Execute Sql
'    Next
'End Sub
Private Sub AddAction()
    RefreshButton cmdEdit, gCMDAPPEND
    ChangeColorFortxtKQ True
End Sub
Private Sub ChangeColorFortxtKQ(isEdit As Boolean)
    Dim i As Integer
    For i = 0 To txtKQ.Count - 1
        With txtKQ(i)
            ChangeBackColor txtKQ(i), isEdit
            Select Case i
                'Case mtxtName, mtxtSex, mtxtAge, mtxtTitle, mtxtDept, mtxtSDate, mtxtEDate
                Case mtxtWorkNo, mtxtSHour, mtxtSMinute, mtxtEHour, mtxtEMinute, mtxtAllowMan
                    .Locked = Not isEdit
                Case mtxtReason
                    If mStatus = gMAINLEAVE Then
                        .Locked = Not isEdit
                    End If
            End Select
        End With
    Next
    With cboKQ
        .Enabled = isEdit
        ChangeBackColor cboKQ, isEdit
    End With
    For i = 0 To picHour.Count - 1
        ChangeBackColor picHour(i), isEdit
    Next
    For i = 0 To picMinite.Count - 1
        ChangeBackColor picMinite(i), isEdit
    Next
    
    For i = 0 To VScrollHour.Count - 1
        VScrollHour(i).Enabled = isEdit
    Next
    
    For i = 0 To VScrollMinite.Count - 1
        VScrollMinite(i).Enabled = isEdit
    Next
    
    If isEdit Then
        txtKQ(mtxtWorkNo).SetFocus
    End If
End Sub
Private Function getNowTime() As String
    getNowTime = Format(Now, "yyyy-mm-dd hh:mm:ss")
End Function
Private Sub IntoMain(Index As Integer)
    Select Case Index
        Case gMAINCOLLECT
            showMainPic True
        Case gMAINLEAVE, gMAINABSENT
            msfGrid.Visible = False
            showMainPic False, Index
            With msfGrid
                If Index = gMAINLEAVE Then
                    .Cols = mIntLeaveCols
                    '.FormatString = mLeaveTitle
                ElseIf Index = gMAINABSENT Then
                    .Cols = mIntAbsentCols
                    '.FormatString = mAbsentTitle
                End If
                iniGridRows msfGrid
            End With
            msfGrid.Visible = True
    End Select
End Sub
Private Sub iniGridRows(myGrid As MSFlexGrid)
    With myGrid
        .Rows = .FixedRows 'clear old data
        .Rows = gFIXEDROWS
    End With
    'RefreshHistory
End Sub
Private Sub RefreshHistory()
    'If (mStatus <> gMAINLEAVE) And (mStatus <> gMAINABSENT) Then Exit Sub
    Dim Rst As Recordset
    Dim Sql As String
    Sql = "Select  * from "
    If mStatus = gMAINLEAVE Then
        Sql = Sql & "QryLeave"
    ElseIf mStatus = gMAINABSENT Then
        Sql = Sql & "QryAbsent"
    ElseIf mStatus = gMAINCOLLECT Then
        Sql = Sql & "QryKqHistory"
    End If
    Sql = Sql & " where left(trim(OperateTime),10)='" & _
        Format(Now, "yyyy-mm-dd") & "' order by WorkNo"
    
    Set Rst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
    Dim Str As String
    With Rst
        While Not .EOF
            Str = Str & IIf(IsNull(!WorkNo), "", Trim(!WorkNo)) _
                & vbTab & IIf(IsNull(!Name), "", Trim(!Name)) _
                & vbTab & IIf(IsNull(!Sex), "", Trim(!Sex)) _
                & vbTab & IIf(IsNull(!DeptName), "", Trim(!DeptName)) _
                & vbTab & IIf(IsNull(!TitleName), "", Trim(!TitleName))
            If mStatus = gMAINCOLLECT Then
                Str = Str & vbTab & IIf(IsNull(!KqDate), "", Trim(!KqDate)) _
                    & vbTab & IIf(IsNull(!KqTime), "", Trim(!KqTime))
            Else
                Str = Str & vbTab & IIf(IsNull(!StartDate), "", Trim(!StartDate)) _
                    & vbTab & IIf(IsNull(!StartTime), "", Trim(!StartTime)) _
                    & vbTab & IIf(IsNull(!EndDate), "", Trim(!EndDate)) _
                    & vbTab & IIf(IsNull(!EndTime), "", Trim(!EndTime)) & vbTab
                If mStatus = gMAINLEAVE Then
                    Str = Str & IIf(IsNull(!TypeName), "", Trim(!TypeName)) _
                        & vbTab & IIf(IsNull(!AllowMan), "", Trim(!AllowMan)) _
                        & vbTab & IIf(IsNull(!Reason), "", Trim(!Reason))
                ElseIf mStatus = gMAINABSENT Then
                    Dim tmpMyStr As String
                    If Not IsNull(!isEvection) Then
                        If !isEvection Then
                            tmpMyStr = GSHIFTEVECTIONSTR
                        Else
                            tmpMyStr = GSHIFTMONEYSTR
                        End If
                    Else
                        tmpMyStr = Empty
                    End If
                    Str = Str & tmpMyStr & vbTab _
                        & IIf(IsNull(!AllowMan), "", Trim(!AllowMan))
                End If
            End If
            
            If Not .EOF Then
                Str = Str & vbCr
            End If
            .MoveNext
        Wend
    End With
    
    Dim intCols As Integer
    Dim intRows As Integer
    intRows = Rst.RecordCount + msfGrid.FixedRows
    If mStatus = gMAINLEAVE Then
        intCols = mIntLeaveCols
    ElseIf mStatus = gMAINABSENT Then
        intCols = mIntAbsentCols
    ElseIf mStatus = gMAINCOLLECT Then
        intCols = mIntCollectCols
    End If
    ClipToGrid msfGrid, Str, intRows, intCols
    Rst.Close
    Set Rst = Nothing
End Sub
Private Sub showMainPic(isTrue As Boolean, Optional MainStatus As Integer = gMAINCOLLECT)
    picMain.Visible = isTrue
    picEdit.Visible = Not isTrue
    fraEdit.Visible = Not isTrue
    
    With msfGrid
        If isTrue Then
            If UBound(mColNotRegister) > 0 _
                Or UBound(mColInValidCard) > 0 Then
                fraList.Visible = True
                .Top = mHasInValidTop
                .Height = mHasInValidHeight
            Else
                .Top = mValidTop
                .Height = mValidHeight
            End If
        Else
            If fraList.Visible Then fraList.Visible = False
            If MainStatus = gMAINABSENT Then
                txtKQ(mtxtReason).Visible = False
                fraEdit.Height = 2235 - 495
                .Top = 2670
                .Height = 5175
            Else
                txtKQ(mtxtReason).Visible = True
                fraEdit.Height = 2235
                .Top = mHasInValidTop
                .Height = mHasInValidHeight
            End If
        End If
    End With
    
    Dim tmpStr As String
    tmpStr = "类别"
    If MainStatus = gMAINLEAVE Or MainStatus = gMAINABSENT Then
        If MainStatus = gMAINLEAVE Then
            tmpStr = GSHIFTLEAVESTR & tmpStr
            FillCbo cboKQ, aLeaveType
            If Not txtKQ(mtxtReason).Visible Then
                txtKQ(mtxtReason).Visible = True
                lblReason.Visible = True
            End If
        Else
            cboKQ.Clear
            tmpStr = mstrAbsent & tmpStr
            With cboKQ
                .AddItem GSHIFTEVECTIONSTR
                .ItemData(.NewIndex) = -1
                .AddItem GSHIFTMONEYSTR
                .ItemData(.NewIndex) = 0
                .ListIndex = 0
            End With
            If txtKQ(mtxtReason).Visible Then
                txtKQ(mtxtReason).Visible = False
                lblReason.Visible = False
            End If
        End If
        Label1(9).Caption = tmpStr
        'txtKQ(mtxtworkno).SetFocus
    End If
    
    mStatus = MainStatus
End Sub
Private Sub cmdKq_Click(Index As Integer)
    Select Case Index
        Case mCollect
            Dim Fr As frmSelPos
            Dim isOK As Boolean
            Set Fr = New frmSelPos
            Fr.Show 1
            isOK = Fr.mIsOk
            mPosName = Fr.mPosName
            Unload Fr
            Set Fr = Nothing
            If Not isOK Then Exit Sub
            If CollectDataFromPos Then
                WriteTempToKq
            End If
        Case mRefresh
            RefreshHistory
        Case gCMDAPPEND
            mblnCollectModify = False
            cmdKq(gCMDAPPEND).Enabled = False
            AppendToGrid
            cmdKq(gCMDSAVE).Enabled = True
        Case gCMDSAVE
            SaveCollect
        Case gCMDEDIT
        Case gCMDDELETE
            DeleteCollect
        Case gCMDQUERY
        Case gCMDRETURN
            Unload Me
    End Select
End Sub
Private Sub DeleteCollect()
    Dim strWorkNo As String
    Dim strKqDate As String
    Dim strKqTime As String
    Dim Sql As String
    On Error GoTo DeleteErr
    With msfGrid
        strWorkNo = Trim(.TextMatrix(.row, mGridWorkNo))
        strKqDate = Trim(.TextMatrix(.row, mGridStartDate))
        strKqTime = Trim(.TextMatrix(.row, mGridStartTime))
        Sql = "update KqHistory set " _
            & " F_DelFlag=" & gTRUE _
            & " where WorkNo='" & strWorkNo & "' " _
            & " and KqDate='" & strKqDate & "' " _
            & " and KqTime='" & strKqTime & "'"
        gDataBase.Execute Sql
    End With
    With msfGrid
        If .Rows = .FixedRows + 1 Then
            .Rows = .FixedRows
        Else
            .RemoveItem .row
        End If
    End With
    Exit Sub
DeleteErr:
    MsgBox "抱歉,删除不成功" & vbCrLf & Err.Description, vbInformation, gTitle
    Err.Clear
End Sub
Private Sub AppendToGrid()
    With msfGrid
        .Rows = .Rows + 1
        .row = .Rows - 1
        .col = mGridWorkNo
        SetTxtPosition msfGrid, txtEdit
    End With
End Sub
Private Sub Form_Load()
    SetFormPosition
    ReDim mColNotRegister(0)
    mColNotRegister(0).WorkNo = ""
    ReDim mColInValidCard(0)
    mColInValidCard(0).WorkNo = ""
    
    iniTitle
    SetGridColor msfGrid
    
    If mMenuIndex = gMAINCOLLECT Then
        lstNotRegister.BackColor = gGridBackColor
        lstInValidCard.BackColor = gGridBackColor
        RefreshButton cmdKq, gCMDEDITNORMAL
    Else
        ChangeColorFortxtKQ False
        InitxtEdit 'inidate
        RefreshButton cmdEdit, gCMDEDITNORMAL
    End If
    
    IntoMain mMenuIndex
    msfGrid.FormatString = mFormatString '   'mAbsentTitle 'mLeaveTitle
    
End Sub
Private Sub SetFormPosition()
    Me.Left = (12000 - Me.Width) / 2
    Me.Top = (9000 - Me.Height)
End Sub
Private Function getToday() As String
    getToday = Format(Now, "yyyy-mm-dd")
End Function
'Private Sub setStatusBar(Index As Integer, MsgStr As String)
'    sbrData.Panels(Index).Text = MsgStr
'End Sub
Private Sub lstNotRegister_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With lstNotRegister
        If .ListCount <= 0 Then Exit Sub
        If Button = 2 Then
            'RefreshCard mnuEditCard, Val(.TextMatrix(.row, .Cols - 1))
            'Refresh
            Dim strWorkNo As String
            strWorkNo = Left(Trim(.Text), 4)
            RefreshmnuList strWorkNo
            PopupMenu mnuList
        End If
    End With
End Sub
Private Sub RefreshmnuList(strWorkNo As String)
    Dim Rst As Recordset
    Dim blnIsRegister As Boolean
    Set Rst = gDataBase.OpenRecordset("select * from Employee" _
        & " where WorkNo='" & Trim(strWorkNo) _
        & "' order by WorkNo", dbOpenSnapshot)
    blnIsRegister = Rst.RecordCount <= 0
    Rst.Close
    Set Rst = Nothing
    
    mnuListAppend.Enabled = Not blnIsRegister
    mnuListRegister.Enabled = blnIsRegister
End Sub
Private Sub mnuListAppend_Click()
    If Trim(lstNotRegister.Text) = Empty Then Exit Sub
    If MsgBox("是否要把此条记录添加到考勤数据采集中?", _
        vbQuestion + vbYesNo, gTitle) = vbNo Then Exit Sub
    Dim strWorkNo As String
    Dim strKqDate As String
    Dim strKqTime As String
    Dim intTemp As Integer
    Dim strList As String
    Dim intListIndex As Integer
    intListIndex = lstNotRegister.ListIndex
    strList = Trim(lstNotRegister.Text)
    strWorkNo = Left(strList, 4)
    strList = Trim(Mid(strList, 5))
    intTemp = InStr(1, strList, " ", vbTextCompare)
    strKqDate = Trim(Left(strList, intTemp))
    strKqTime = Trim(Mid(strList, intTemp))
    
    Dim Rst As Recordset
    Dim EmpRst As Recordset
    Dim strIn As String
    
    On Error GoTo ErrHandle
    Set Rst = gDataBase.OpenRecordset("KqHistory")
    Set EmpRst = gDataBase.OpenRecordset("Select * from " _
        & " QryEmployee where WorkNo='" & strWorkNo & "'" & _
        " order by WorkNo", dbOpenSnapshot)
    If EmpRst.RecordCount > 0 Then
        Rst.AddNew
        Rst!WorkNo = strWorkNo
        Rst!KqDate = strKqDate
        Rst!KqTime = strKqTime
        Rst.Update
        
        With EmpRst
            strIn = strWorkNo & vbTab _
                & !Name & vbTab & !Sex & vbTab _
                & !DeptName & vbTab & !TitleName & vbTab _
                & strKqDate & vbTab & strKqTime
        End With
        msfGrid.AddItem strIn
        lstNotRegister.RemoveItem intListIndex
    End If
    Rst.Close
    Set Rst = Nothing
    EmpRst.Close
    Set EmpRst = Nothing
    Exit Sub
    
ErrHandle:
    MsgBox Err.Description, vbInformation, gTitle
    Err.Clear
    Exit Sub
    'End If
End Sub
Private Sub mnuListRegister_Click()
    If lstNotRegister.ListCount <= 0 Then Exit Sub
    If MsgBox("是否要对此卡进行登记?", _
        vbQuestion + vbYesNo, gTitle) = vbNo Then Exit Sub
    With frmEmploy
        .Show 0, Me
        .cmdEdit_Click 0
        .txtEmp(0) = Left(Trim(lstNotRegister.Text), 4)
    End With
End Sub
Private Sub mSetColor_Click()
End Sub
Private Sub mSetOption_Click()
End Sub
Private Sub medDate_GotFocus()
    msfGrid.Enabled = False
    medDate.SelStart = 0
    medDate.SelLength = Len(medDate.Text)
End Sub
Private Sub medDate_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyReturn
            Dim Str As String
            Str = Trim(medDate.Text)
            With msfGrid
                If Str <> Empty Then
                    .TextMatrix(.row, mGridStartDate) = Str
                    medDate.Visible = False
                    If Not mblnCollectModify Then
                        .col = mGridStartTime
                        SetMedPosition msfGrid, medTime, False
                    Else
                        If Str <> mOldKqDate Then
                            If SaveCollectByModify Then
                                mblnCollectModify = False
                            Else
                                .TextMatrix(.row, mGridStartDate) = mOldKqDate
                            End If
                        End If
                        msfGrid.Enabled = True
                    End If
                End If
            End With
        Case vbKeyEscape
            If mblnCollectModify Then
                If medDate.Visible Then medDate.Visible = False
                If Not msfGrid.Enabled Then msfGrid.Enabled = True
                msfGrid.SetFocus
            End If
    End Select
End Sub
Private Function SaveCollectByModify() As Boolean
    Dim strWorkNo As String
    Dim strKqDate As String
    Dim strKqTime As String
    Dim Sql As String
    On Error GoTo SaveErr
    With msfGrid
        strWorkNo = Trim(.TextMatrix(.row, mGridWorkNo))
        strKqDate = Trim(.TextMatrix(.row, mGridStartDate))
        strKqTime = Trim(.TextMatrix(.row, mGridStartTime))
        Sql = "update KqHistory set " _
            & " KqDate='" & strKqDate & "'," _
            & " KqTime='" & strKqTime & "' " _
            & " where WorkNo='" & strWorkNo & "' " _
            & " and KqDate='" & mOldKqDate & "' " _
            & " and KqTime='" & mOldKqTime & "'"
        gDataBase.Execute Sql
    End With
    SaveCollectByModify = True
    Exit Function
SaveErr:
    MsgBox "抱歉,保存不成功" & vbCrLf & Err.Description, vbInformation, gTitle
    Err.Clear
    SaveCollectByModify = False
End Function
Private Sub medDate_LostFocus()
    medDate.Visible = False
End Sub
Private Sub medTime_GotFocus()
    msfGrid.Enabled = False
    medTime.SelStart = 0
    medTime.SelLength = Len(medTime.Text)
End Sub
Private Sub medTime_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyReturn
            Dim Str As String
            Str = Trim(medTime.Text)
            With msfGrid
                If Str <> Empty Then
                    .TextMatrix(.row, mGridStartTime) = Str
                    medTime.Visible = False
                    If Not mblnCollectModify Then
                        cmdKq_Click gCMDSAVE
                    Else
                        If Str <> mOldKqTime Then
                            If SaveCollectByModify Then
                                mblnCollectModify = False
                            Else
                                .TextMatrix(.row, mGridStartTime) = mOldKqTime
                            End If
                        End If
                        msfGrid.Enabled = True
                    End If
                End If
            End With
        Case vbKeyEscape
            If mblnCollectModify Then
                If medTime.Visible Then medTime.Visible = False
                If Not msfGrid.Enabled Then msfGrid.Enabled = True
                msfGrid.SetFocus
            End If
    End Select
End Sub
Private Sub SaveCollect()
    Dim strWorkNo As String
    Dim strKqDate As String
    Dim strKqTime As String
    
    With msfGrid
        strWorkNo = Trim(.TextMatrix(mRowBeforeSave, mGridWorkNo))
        strKqDate = Trim(.TextMatrix(mRowBeforeSave, mGridStartDate))
        strKqTime = Trim(.TextMatrix(mRowBeforeSave, mGridStartTime))
    
        If strKqDate = Empty Then
            MsgBox "考勤日期不能为空,请输入!!", vbInformation, gTitle
            .col = mGridStartDate
            SetMedPosition msfGrid, medDate, True
            Exit Sub
        End If
        
        If strKqTime = Empty Then
            MsgBox "考勤时间不能为空,请输入!!", vbInformation, gTitle
            .col = mGridStartTime
            SetMedPosition msfGrid, medTime, False
            Exit Sub
        End If
        
        On Error GoTo SaveErr
        Dim Sql As String
        Sql = "Insert into KqHistory (WorkNo,KqDate,KqTime,OperateTime) values('" _
            & strWorkNo & "','" & strKqDate & "','" _
            & strKqTime & "','" & Format(Date, "yyyy-mm-dd") & "')"
        gDataBase.Execute Sql
        msfGrid.Enabled = True
        cmdKq(gCMDAPPEND).Enabled = True
        cmdKq(gCMDSAVE).Enabled = False
    End With
    Exit Sub
SaveErr:
    MsgBox "保存未成功" & vbCrLf & Err.Description, vbExclamation, gTitle
    Err.Clear
End Sub
Private Sub medTime_LostFocus()
    medTime.Visible = False
End Sub
Private Sub mnuEditDelete_Click()
    cmdEdit_Click gCMDDELETE
End Sub
Private Sub mnuEditModify_Click()
    cmdEdit_Click gCMDEDIT
End Sub
Private Sub msfGrid_DblClick()
    If mStatus = gMAINCOLLECT Then
        With msfGrid
            Select Case .col
                Case mGridStartDate, mGridStartTime
                    mblnCollectModify = True
                    mOldKqDate = Trim(.TextMatrix(.row, mGridStartDate))
                    mOldKqTime = Trim(.TextMatrix(.row, mGridStartTime))
                    If .col = mGridStartDate Then
                        .col = mGridStartDate
                        SetMedPosition msfGrid, medDate, True
                        With medDate
                            .Mask = ""
                            .Text = mOldKqDate
                            .Mask = mDATEMASK
                        End With
                    Else
                        .col = mGridStartTime
                        SetMedPosition msfGrid, medTime, False
                        With medTime
                            .Mask = ""
                            .Text = mOldKqTime
                            .Mask = mTIMEMASK
                        End With
                    End If
            End Select
        End With
    End If
End Sub
Private Sub msfGrid_GotFocus()
    If msfGrid.Rows <= msfGrid.FixedRows Then Exit Sub
    If mStatus = gMAINCOLLECT Then
        cmdKq(gCMDEDIT).Enabled = True
        cmdKq(gCMDDELETE).Enabled = True
    Else
        If Not (mblnIsModify Or mblnIsAdd) Then
            RefreshBtnLocal True
        End If
    End If
End Sub
Private Sub RefreshBtnLocal(blnIsGotFocus As Boolean)
    cmdEdit(gCMDEDIT).Enabled = blnIsGotFocus
    cmdEdit(gCMDDELETE).Enabled = blnIsGotFocus
End Sub
'Private Sub mnuPosDateSet_Click()
'    frmSetDate.Show 1
'End Sub
'Private Sub mnuQueryFlow_Click()
'    frmFlow.Show 0, Me
'End Sub
Private Sub msfGrid_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        If mStatus = gMAINCOLLECT Then
            msfGrid_DblClick
        End If
    End If
End Sub
'Private Sub Timer1_Timer()
'    sbrData.Panels(4).Text = "时间:" & Format(Now, "hh:mm:ss")
'End Sub
Private Sub iniTitle()
    Dim strTemp As String
    Select Case mMenuIndex
        Case gMAINCOLLECT
            strTemp = "^工  号" & Space(3) & vbTab _
                   & "<姓  名" & Space(5) & vbTab _
                   & "^性  别" & Space(5) & vbTab _
                   & "<部  门" & Space(7) & vbTab _
                   & "<职  务" & Space(7) & vbTab _
                   & "^考 勤 日 期" & Space(11) & vbTab _
                   & "^考 勤 时 间" & Space(11) '7
        Case gMAINLEAVE
            strTemp = "^工 号" & Space(0) & vbTab _
                   & "<姓 名" & Space(2) & vbTab _
                   & "^性 别" & Space(0) & vbTab _
                   & "<部 门" & Space(1) & vbTab _
                   & "<职 务" & Space(1) & vbTab _
                   & "^起始日期" & Space(3) & vbTab _
                   & "^起始时间" & Space(1) & vbTab _
                   & "^截止日期" & Space(3) & vbTab _
                   & "^截止时间" & Space(1) & vbTab _
                   & "<请假类型" & Space(0) & vbTab _
                   & "<批准人" & Space(2) & vbTab _
                   & "<事  由" & Space(5) '12
        Case gMAINABSENT
             strTemp = "^工 号" & Space(1) & vbTab _
                   & "<姓 名" & Space(2) & vbTab _
                   & "^性 别" & Space(1) & vbTab _
                   & "<部 门" & Space(2) & vbTab _
                   & "<职 务" & Space(2) & vbTab _
                   & "^起始日期" & Space(4) & vbTab _
                   & "^起始时间" & Space(3) & vbTab _
                   & "^截止日期" & Space(4) & vbTab _
                   & "^截止时间" & Space(3) & vbTab _
                   & "<缺席类型" & Space(2) & vbTab _
                   & "<批准人" & Space(2) '11
    End Select
    mFormatString = strTemp
End Sub
Private Sub msfGrid_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With msfGrid
        If .MouseRow = 0 Then Exit Sub
        If .Rows <= .FixedRows Then Exit Sub
        If Button = 2 Then
            If Trim(.TextMatrix(.MouseRow, mGridWorkNo)) <> Empty Then
                PopupMenu mnuEdit
            End If
        End If
    End With
End Sub
Private Sub txtEdit_GotFocus()
    msfGrid.Enabled = False
    mRowBeforeSave = msfGrid.row
    GotFocus txtEdit
End Sub
Private Sub txtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case 13
            Dim Str As String
            Dim strName As String
            Dim strSex As String
            Dim strDept As String
            Dim strTitle As String
            Dim Sql As String
            Dim Rst As Recordset
            Str = Trim(txtEdit)
            Sql = " select * from QryEmployee where WorkNo='" & Str & "'" _
                & " order by WorkNo"
            Set Rst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
            If Rst.RecordCount > 0 Then
                strName = IIf(IsNull(Rst!Name), "", Trim(Rst!Name))
                strSex = IIf(IsNull(Rst!Sex), "", Trim(Rst!Sex))
                strDept = IIf(IsNull(Rst!DeptName), "", Trim(Rst!DeptName))
                strTitle = IIf(IsNull(Rst!TitleName), "", Trim(Rst!TitleName))
                txtEdit.Visible = False
                With msfGrid
                    .TextMatrix(.row, mGridWorkNo) = Str
                    .TextMatrix(.row, mGridName) = strName
                    .TextMatrix(.row, mGridSex) = strSex
                    .TextMatrix(.row, mGridDept) = strDept
                    .TextMatrix(.row, mGridTitle) = strTitle
                    
                    .col = mGridStartDate
                End With
                SetMedPosition msfGrid, medDate, True
            End If
        Case 27
            txtEdit_LostFocus
    End Select
End Sub
Private Sub SetMedPosition(tmpGrid As MSFlexGrid, tmpMed As MaskEdBox, Optional isDate As Boolean = True)
    With tmpGrid
        tmpMed.Top = .Top + .CellTop
        tmpMed.Left = .Left + .CellLeft
        tmpMed.Width = .CellWidth
        tmpMed.Height = .CellHeight
        tmpMed.Mask = ""
        'tmpMed.Text = ""
        If isDate Then
            tmpMed.Text = Format(Date, "yyyy-mm-dd")
            tmpMed.Mask = mDATEMASK
        Else
            tmpMed.Text = "08:00"
            tmpMed.Mask = mTIMEMASK
        End If
        tmpMed.Visible = True
        tmpMed.SetFocus
    End With
End Sub
Private Sub txtEdit_LostFocus()
    txtEdit.Visible = False
    ValidAction msfGrid, txtEdit
End Sub
Private Sub ValidAction(tmpGrid As MSFlexGrid, tmpTxt As TextBox)
    With tmpGrid
        If Trim(.TextMatrix(.row, mGridWorkNo)) = Empty Then
             .Rows = .Rows - 1
             cmdKq(gCMDAPPEND).Enabled = True
             cmdKq(gCMDSAVE).Enabled = False
             msfGrid.Enabled = True
        End If
    End With
End Sub
Private Sub UpDownCheck(KeyCode As Integer, msfGrid As MSFlexGrid)
    Dim sRow, SCol As Integer
    
    With msfGrid
        If KeyCode = vbKeyDown Then
            sRow = .row + 1
            If sRow = .Rows Then
                sRow = .FixedRows
            End If
        ElseIf KeyCode = vbKeyUp Then
            sRow = .row - 1
            If sRow = 0 Then
                sRow = .Rows - 1
            End If
        ElseIf KeyCode = 13 Then
            sRow = .row
        End If
        SCol = .ColSel
    
        .row = sRow
        .col = SCol
        .RowSel = sRow
    End With
End Sub
Private Sub FillGridByRst(myGrid As MSFlexGrid, CurRow As Integer, Rst As Recordset)
    With myGrid
        .TextMatrix(CurRow, 1) = IIf(IsNull(Rst!Name), "", Trim(Rst!Name))
        .TextMatrix(CurRow, 2) = IIf(IsNull(Rst!Sex), "", Trim(Rst!Sex))
        '.TextMatrix(CurRow, 3) = IIf(IsNull(Rst!Age), "", Trim(Rst!Age))
        .TextMatrix(CurRow, 3) = IIf(IsNull(Rst!Department), "", Trim(Rst!Deptment))
        .TextMatrix(CurRow, 4) = IIf(IsNull(Rst!Title), "", Trim(Rst!Title))
    End With
End Sub
Private Sub txtKQ_Change(Index As Integer)
    If Index = mtxtWorkNo Then
        If Not txtKQ(Index).Locked Then
            mblnIsNeedSave = Trim(txtKQ(Index)) <> Empty
        End If
    End If
End Sub
Private Sub txtKQ_DblClick(Index As Integer)
'    If Not mdblClickIsValid Then Exit Sub
    Select Case Index
        Case mtxtWorkNo, mtxtSDate, mtxtEDate
            txtKQ_KeyDown Index, 13, vbCtrlMask
    End Select
End Sub
Private Sub txtKQ_GotFocus(Index As Integer)
    GotFocus txtKQ(Index)
End Sub
Private Sub txtKQ_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
       
    If KeyCode = 13 Then
        Select Case Index
            Case mtxtWorkNo, mtxtSDate, mtxtEDate
                Dim CtrlDown As Boolean
                CtrlDown = (vbCtrlMask And Shift) > 0
                If CtrlDown Then
                    Select Case Index
                        Case mtxtWorkNo
                            'frmLookMan.Tag = UCase("frmMain")
                            With frmLookMan
                                .Show vbModal
                                txtKQ(mtxtWorkNo) = .mWorkNo
                                txtKQ(mtxtName) = .mName
                                txtKQ(mtxtSex) = .mSex
                                txtKQ(mtxtAge) = .mAge
                                txtKQ(mtxtDept) = .mDept
                                txtKQ(mtxtTitle) = .mTitle
                            End With
                        Case mtxtSDate, mtxtEDate
                            'mRetDate = Empty
                            'frmRiLi.Tag = UCase("frmMain")
                            frmRiLi.Show vbModal
                            If frmRiLi.mRetDate <> Empty Then
                                txtKQ(Index) = frmRiLi.mRetDate
                            End If
                    End Select
                Else
                    SendKeyTab KeyCode
                End If
'            Case mtxtSHour, mtxtEHour
                
            Case Else
                SendKeyTab KeyCode
        End Select
    End If
End Sub
Private Sub txtKQ_LostFocus(Index As Integer)
    Select Case Index
        Case mtxtWorkNo
            If Trim(txtKQ(mtxtWorkNo)) = Empty Then Exit Sub
            If Trim(txtKQ(mtxtName)) <> Empty Then Exit Sub
            Dim tmpStr As String
            Dim Rst As Recordset
            tmpStr = Trim(txtKQ(Index))
            Set Rst = gDataBase.OpenRecordset("select * from QryEmployee" _
                & " Where WorkNo='" & tmpStr & "'", dbOpenSnapshot)
            If Rst.RecordCount > 0 Then
                With Rst
                txtKQ(mtxtName) = IIf(IsNull(!Name), "", Trim(!Name))
                txtKQ(mtxtSex) = IIf(IsNull(!Sex), "", Trim(!Sex))
                txtKQ(mtxtAge) = IIf(IsNull(!Age), "", Trim(!Age))
                txtKQ(mtxtDept) = IIf(IsNull(!DeptName), "", Trim(!DeptName))
                txtKQ(mtxtTitle) = IIf(IsNull(!TitleName), "", Trim(!TitleName))
                End With
            Else
                If Me.Enabled Then
                    MsgBox "无此工号!请重输!!", , gTitle
                    txtKQ(mtxtWorkNo).SetFocus
                End If
            End If
            Rst.Close
            Set Rst = Nothing
            'End If
    End Select
End Sub
Private Sub InitxtEdit()
    Dim i As Integer
    For i = 0 To txtKQ.Count - 1
        With txtKQ(i)
            Select Case i
                Case mtxtSDate, mtxtEDate
                    .Text = getToday
                Case mtxtSHour
                    .Text = mstrSHour
                Case mtxtEHour
                    .Text = mstrEHour
                Case mtxtSMinute, mtxtEMinute
                    .Text = mstrMinute
                Case Else
                    .Text = Empty
            End Select
        End With
    Next
    If cboKQ.ListCount > 0 Then cboKQ.ListIndex = 0
End Sub
Private Function CollectDataFromPos() As Boolean
    Dim blnIsOpen As Boolean
    Dim blnIsTras As Boolean
    'Dim strIn As String
    Dim nRecCount As Integer
    'Dim Rst As Recordset
    Dim nRet As Integer
    Dim j As Integer
    Dim i As Integer
    Dim blnProgIsShow As Boolean
    'Set Rst = gDataBase.OpenRecordset("KqHistory")
    
    If OpenComm(gCommPort) <> 0 Then
        MsgBox mstrOpenCommErr, vbInformation, gTitle
        GoTo CollectErr
    End If
    blnIsOpen = True
    
    nRecCount = POS_IsReady(gPosNumber)
    If nRecCount < 0 Then
        MsgBox mMsg1, vbInformation + vbOKOnly, gTitle
        GoTo CollectErr
    End If
    
    Dim strFrame As String * 20
    Dim blnIsAdd As Boolean
    Dim strWorkNo As String
    Dim strDate As String
    Dim strTime As String
    'Dim EmpRst As String
    
    On Error GoTo CollectErr
    ReDim mKqRecord(0)
    mKqRecord(0).WorkNo = ""
    
    'Set Rst = gDataBase.OpenRecordset("KqTemp")
    
'    Set EmpRst = gDataBase.OpenRecordset("select * from " _
'        & " QryEmployee order by WorkNo", dbOpenSnapshot)
    If nRecCount = 0 Then
        If blnIsOpen Then CloseComm
        MsgBox mMsg4, vbInformation, gTitle
        CollectDataFromPos = False
        Exit Function
    End If
    
    ReDim Preserve mKqRecord(nRecCount)
    
    Screen.MousePointer = 11
    frmMain.Enabled = False
    With frmProg
        .Label1.Caption = "正在采集[" & mPosName _
            & "]的数据,请稍候..."
        .Show
        .Refresh
    End With
    blnProgIsShow = True
    
    frmProg.ProgressBar1.Min = 0
    If nRecCount > 0 Then
        frmProg.ProgressBar1.Max = nRecCount + 1
    Else
        frmProg.ProgressBar1.Max = 100
    End If
    
    BeginTrans
    blnIsTras = True
    For i = 1 To nRecCount + 1
        blnIsAdd = False
        nRet = POS_GetNextFrame(gPosNumber, strFrame)
        frmProg.ProgressBar1.Value = i
        Select Case nRet
            Case 0
                blnIsAdd = True
            Case 1
                blnIsAdd = False
                Exit For
            Case Else
                For j = 1 To mRetryTimes
                    nRet = POS_GetFrameAgain(1, strFrame)
                    If nRet = 0 Then
                        blnIsAdd = True
                        Exit For
                    End If
                Next
                If Not blnIsAdd Then
                    MsgBox mMsg2, vbExclamation + vbOKOnly, gTitle
                    GoTo CollectErr
                End If
        End Select
        If blnIsAdd Then
            If Trim(strFrame) <> Empty Then
                strWorkNo = Chr(Val(Mid(strFrame, 1, 1)) * 16 _
                    + Val(Mid(strFrame, 2, 1))) & _
                    Chr(Val(Mid(strFrame, 3, 1)) * 16 _
                    + Val(Mid(strFrame, 4, 1))) & _
                    Chr(Val(Mid(strFrame, 5, 1)) * 16 _
                    + Val(Mid(strFrame, 6, 1))) & _
                    Chr(Val(Mid(strFrame, 7, 1)) * 16 _
                    + Val(Mid(strFrame, 8, 1)))
                strDate = "20" & Mid(strFrame, 9, 2) & "-" & _
                    Mid(strFrame, 11, 2) & "-" & _
                    Mid(strFrame, 13, 2)
                strTime = Mid(strFrame, 15, 2) & ":" & _
                        Mid(strFrame, 17, 2) & ":" & _
                        Mid(strFrame, 19, 2)
                'strIn = strIn & strWorkNo
'                Rst.AddNew
'                Rst!WorkNo = Trim(strWorkNo)
'                Rst!KqDate = Trim(strDate)
'                Rst!KqTime = Trim(strTime)
'                Rst.Update
                With mKqRecord(i)
                    .WorkNo = Trim(strWorkNo)
                    .KqDate = Trim(strDate)
                    .KqTime = Trim(strTime)
                End With
            Else
                MsgBox mMsg3, vbExclamation, gTitle
                GoTo CollectErr
            End If
        End If
    Next
    
    CommitTrans
    CloseComm
    
    If Not Me.Enabled Then Me.Enabled = True
    Screen.MousePointer = 99
    Unload frmProg
    MsgBox mMsg5, vbInformation, gTitle
    
    CollectDataFromPos = True
    Exit Function
    
CollectErr:
    If blnProgIsShow Then
        If Not Me.Enabled Then Me.Enabled = True
        Screen.MousePointer = 99
        If Not frmProg Is Nothing Then Unload frmProg
    End If
    
    If blnIsOpen Then
        CloseComm
    End If
    If blnIsTras Then
        Rollback
    End If
    CollectDataFromPos = False
    Exit Function
End Function
Private Sub WriteTempToKq()
    If UBound(mKqRecord) < 1 Then Exit Sub
    Dim i As Integer
    Dim strWorkNo As String
    Dim strKqDate As String
    Dim strKqTime As String
    Dim intCardStatus As Integer
    Dim strIn As String
    Dim Rst As Recordset
    Dim EmpRst As Recordset
    
    'Set mColNotRegister = New Collection
    'Set mColInValidCard = New Collection
    ReDim mColNotRegister(0)
    mColNotRegister(0).WorkNo = ""
    ReDim mColInValidCard(0)
    mColInValidCard(0).WorkNo = ""
    
    Set Rst = gDataBase.OpenRecordset("KqHistory")
    Set EmpRst = gDataBase.OpenRecordset("Select * from " _
        & " QryEmployee order by WorkNo", dbOpenSnapshot)
    
'    On Error GoTo WriteErr
'    Dim blnIsTrans As Boolean
'    BeginTrans
'    blnIsTrans = True
    Dim intRows As Integer
    Dim intCols As Integer
    
    For i = 1 To UBound(mKqRecord)
        With mKqRecord(i)
            strWorkNo = Trim(.WorkNo)
            strKqDate = Trim(.KqDate)
            strKqTime = Trim(.KqTime)
        End With
        EmpRst.FindFirst "WorkNo='" & strWorkNo & "'"
        If EmpRst.NoMatch Then '卡未登记
            ReDim Preserve mColNotRegister(UBound(mColNotRegister) + 1)
            With mColNotRegister(UBound(mColNotRegister))
                .WorkNo = strWorkNo
                .KqDate = strKqDate
                .KqTime = strKqTime
            End With
        Else
            If EmpRst!CardStatus <> gHasCard Then '非法卡在流通
                ReDim Preserve mColInValidCard(UBound(mColInValidCard) + 1)
                With mColInValidCard(UBound(mColInValidCard))
                    .WorkNo = strWorkNo
                    .KqDate = strKqDate
                    .KqTime = strKqTime
                End With
            Else
                Rst.AddNew
                Rst!WorkNo = strWorkNo
                Rst!KqDate = strKqDate
                Rst!KqTime = strKqTime
                Rst!OperateTime = Format(Date, "yyyy-mm-dd")
                Rst.Update
                intRows = intRows + 1
                With EmpRst
                    strIn = strIn & strWorkNo & vbTab _
                        & !Name & vbTab & !Sex & vbTab _
                        & !DeptName & vbTab & !TitleName & vbTab _
                        & strKqDate & vbTab & strKqTime
                    If i <> UBound(mKqRecord) Then strIn = strIn & vbCr
                End With
            End If
        End If
    Next
    EmpRst.Close
    Set EmpRst = Nothing
    Rst.Close
    Set Rst = Nothing
    
    If UBound(mColNotRegister) > 0 Or UBound(mColInValidCard) > 0 Then
        msfGrid.Top = mHasInValidTop
        msfGrid.Height = mHasInValidHeight
        If Not fraList.Visible Then
            fraList.Visible = True
            Dim j As Integer
            lstNotRegister.Clear
            lstInValidCard.Clear
            If UBound(mColNotRegister) > 0 Then
                For j = 1 To UBound(mColNotRegister)
                    With mColNotRegister(j)
                        lstNotRegister.AddItem FixedLen(.WorkNo, 12, 0) & _
                            FixedLen(.KqDate, 20, 0) & FixedLen(.KqTime, 16, 0)
                    End With
                Next
            End If
            If UBound(mColInValidCard) > 0 Then
                For j = 1 To UBound(mColInValidCard)
                    With mColInValidCard(j)
                        lstInValidCard.AddItem FixedLen(.WorkNo, 12, 0) & _
                            FixedLen(.KqDate, 20, 0) & FixedLen(.KqTime, 16, 0)
                    End With
                Next
            End If
            lblNotRegister = UBound(mColNotRegister)
            lblInvalidCard = UBound(mColInValidCard)
        End If
    Else
        If fraList.Visible Then
            fraList.Visible = False
            msfGrid.Top = mValidTop
            msfGrid.Height = mValidHeight
        End If
    End If
    
    intCols = mIntCollectCols
    ClipToGrid msfGrid, strIn, intRows + 1, intCols
    'Exit Sub
'WriteErr:
'    If blnIsTrans Then
'        Rollback
'    End If
End Sub

						