企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{65A39231-6133-11D1-BAA2-444553540000}#1.0#0"; "VSLIGHT6.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Ed_EmpChgFrm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "人事变动处理"
   ClientHeight    =   5010
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8925
   HelpContextID   =   2113003
   Icon            =   "处理_人事变动处理.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form2"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5010
   ScaleWidth      =   8925
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   4200
      Left            =   120
      TabIndex        =   18
      Top             =   720
      Width           =   8715
      Begin VB.CommandButton Ydcommand2 
         CausesValidation=   0   'False
         Height          =   300
         Index           =   4
         Left            =   5025
         Picture         =   "处理_人事变动处理.frx":1042
         Style           =   1  'Graphical
         TabIndex        =   40
         Top             =   690
         Width           =   300
      End
      Begin VB.CommandButton Ydcommand2 
         CausesValidation=   0   'False
         Height          =   300
         Index           =   3
         Left            =   2355
         Picture         =   "处理_人事变动处理.frx":13CC
         Style           =   1  'Graphical
         TabIndex        =   39
         Top             =   690
         Width           =   300
      End
      Begin VB.TextBox LrText 
         Height          =   300
         Index           =   17
         Left            =   5400
         TabIndex        =   17
         Text            =   "17"
         Top             =   3525
         Width           =   2610
      End
      Begin VB.TextBox LrText 
         Enabled         =   0   'False
         Height          =   300
         Index           =   16
         Left            =   1395
         TabIndex        =   16
         Text            =   "16"
         Top             =   3525
         Width           =   2535
      End
      Begin VB.TextBox LrText 
         Height          =   300
         Index           =   15
         Left            =   5400
         TabIndex        =   15
         Text            =   "15"
         Top             =   3075
         Width           =   2610
      End
      Begin VB.TextBox LrText 
         Enabled         =   0   'False
         Height          =   300
         Index           =   14
         Left            =   1395
         TabIndex        =   14
         Text            =   "14"
         Top             =   3075
         Width           =   2535
      End
      Begin VB.TextBox LrText 
         Height          =   300
         Index           =   13
         Left            =   5400
         TabIndex        =   13
         Text            =   "13"
         Top             =   2640
         Width           =   2610
      End
      Begin VB.CommandButton Ydcommand1 
         CausesValidation=   0   'False
         Height          =   300
         Index           =   0
         Left            =   2370
         Picture         =   "处理_人事变动处理.frx":1756
         Style           =   1  'Graphical
         TabIndex        =   19
         TabStop         =   0   'False
         Top             =   240
         Visible         =   0   'False
         Width           =   300
      End
      Begin VB.TextBox LrText 
         Height          =   300
         Index           =   2
         Left            =   6300
         TabIndex        =   2
         Text            =   "2"
         Top             =   240
         Width           =   1950
      End
      Begin VB.TextBox LrText 
         Height          =   300
         Index           =   0
         Left            =   1005
         TabIndex        =   0
         Text            =   "0"
         Top             =   240
         Width           =   1350
      End
      Begin VB.TextBox LrText 
         Height          =   300
         Index           =   4
         Left            =   3675
         TabIndex        =   4
         Text            =   "4"
         Top             =   690
         Width           =   1350
      End
      Begin VB.TextBox LrText 
         Enabled         =   0   'False
         Height          =   300
         Index           =   6
         Left            =   1395
         TabIndex        =   6
         Text            =   "6"
         Top             =   1320
         Width           =   2535
      End
      Begin VB.TextBox LrText 
         Enabled         =   0   'False
         Height          =   300
         Index           =   8
         Left            =   1395
         TabIndex        =   8
         Text            =   "8"
         Top             =   1755
         Width           =   2535
      End
      Begin VB.TextBox LrText 
         Enabled         =   0   'False
         Height          =   300
         Index           =   10
         Left            =   1395
         TabIndex        =   10
         Text            =   "10"
         Top             =   2205
         Width           =   2535
      End
      Begin VB.TextBox LrText 
         Enabled         =   0   'False
         Height          =   300
         Index           =   12
         Left            =   1395
         TabIndex        =   12
         Text            =   "12"
         Top             =   2640
         Width           =   2535
      End
      Begin VB.TextBox LrText 
         Enabled         =   0   'False
         Height          =   300
         Index           =   1
         Left            =   3690
         TabIndex        =   1
         Text            =   "1"
         Top             =   240
         Width           =   1650
      End
      Begin VB.TextBox LrText 
         Height          =   300
         Index           =   3
         Left            =   1005
         TabIndex        =   3
         Text            =   "3"
         Top             =   690
         Width           =   1350
      End
      Begin VB.TextBox LrText 
         Height          =   300
         Index           =   5
         Left            =   6300
         TabIndex        =   5
         Text            =   "5"
         Top             =   690
         Width           =   2250
      End
      Begin VB.TextBox LrText 
         Height          =   300
         Index           =   7
         Left            =   5400
         TabIndex        =   7
         Text            =   "7"
         Top             =   1320
         Width           =   2610
      End
      Begin VB.TextBox LrText 
         Height          =   300
         Index           =   9
         Left            =   5400
         TabIndex        =   9
         Text            =   "9"
         Top             =   1755
         Width           =   2610
      End
      Begin VB.TextBox LrText 
         Height          =   300
         Index           =   11
         Left            =   5400
         TabIndex        =   11
         Text            =   "11"
         Top             =   2205
         Width           =   2610
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "现岗位:"
         Height          =   180
         Index           =   11
         Left            =   4350
         TabIndex        =   38
         Tag             =   "AR_BadDebtPrepAccCode"
         Top             =   2265
         Width           =   705
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "现职务:"
         Height          =   180
         Index           =   9
         Left            =   4350
         TabIndex        =   37
         Tag             =   "AR_BadDebtAccCode"
         Top             =   1815
         Width           =   705
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "现部门:"
         Height          =   180
         Index           =   7
         Left            =   4350
         TabIndex        =   36
         Tag             =   "AR_BankNoteAccCode"
         Top             =   1380
         Width           =   705
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "现工种:"
         Height          =   180
         Index           =   13
         Left            =   4350
         TabIndex        =   35
         Tag             =   "AR_CashDisAccCode"
         Top             =   2700
         Width           =   705
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "现用工性质:"
         Height          =   180
         Index           =   15
         Left            =   4350
         TabIndex        =   34
         Tag             =   "AR_CashDisAccCode"
         Top             =   3135
         Width           =   1065
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "现职工类别:"
         Height          =   180
         Index           =   17
         Left            =   4350
         TabIndex        =   33
         Tag             =   "AR_CashDisAccCode"
         Top             =   3585
         Width           =   1065
      End
      Begin VB.Shape Shape1 
         BorderColor     =   &H00800000&
         Height          =   2850
         Left            =   165
         Top             =   1170
         Width           =   8385
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "原职工类别:"
         Height          =   180
         Index           =   16
         Left            =   375
         TabIndex        =   31
         Tag             =   "AR_CashDisAccCode"
         Top             =   3585
         Width           =   1215
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "原用工性质:"
         Height          =   180
         Index           =   14
         Left            =   375
         TabIndex        =   30
         Tag             =   "AR_CashDisAccCode"
         Top             =   3135
         Width           =   1215
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "变动类型:"
         Height          =   180
         Index           =   2
         Left            =   5415
         TabIndex        =   29
         Tag             =   "AR_ArAccCode"
         Top             =   300
         Width           =   810
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "职工号:"
         Height          =   180
         Index           =   0
         Left            =   135
         TabIndex        =   28
         Tag             =   "AR_RrAccCode"
         Top             =   300
         Width           =   630
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "到职时间:"
         Height          =   180
         Index           =   4
         Left            =   2805
         TabIndex        =   27
         Tag             =   "AR_FareAccCode"
         Top             =   750
         Width           =   810
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "原部门:"
         Height          =   180
         Index           =   6
         Left            =   375
         TabIndex        =   26
         Tag             =   "AR_PrAccCode"
         Top             =   1380
         Width           =   855
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "原职务:"
         Height          =   180
         Index           =   8
         Left            =   375
         TabIndex        =   25
         Tag             =   "AR_SellAccCode"
         Top             =   1815
         Width           =   855
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "原岗位:"
         Height          =   180
         Index           =   10
         Left            =   375
         TabIndex        =   24
         Tag             =   "AR_SellTaxAccCode"
         Top             =   2265
         Width           =   855
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "原工种:"
         Height          =   180
         Index           =   12
         Left            =   375
         TabIndex        =   23
         Tag             =   "AR_CashDisAccCode"
         Top             =   2700
         Width           =   855
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "姓名:"
         Height          =   180
         Index           =   1
         Left            =   2805
         TabIndex        =   22
         Tag             =   "AR_NoteIntAccCode"
         Top             =   300
         Width           =   450
      End
      Begin VB.Label TsLabel 
         Caption         =   "变动时间:"
         Height          =   210
         Index           =   3
         Left            =   135
         TabIndex        =   21
         Tag             =   "AR_NoteFareAccCode"
         Top             =   750
         Width           =   1005
      End
      Begin VB.Label TsLabel 
         AutoSize        =   -1  'True
         Caption         =   "备注:"
         Height          =   180
         Index           =   5
         Left            =   5415
         TabIndex        =   20
         Tag             =   "AR_CommNoteAccCode"
         Top             =   750
         Width           =   450
      End
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   0
      Top             =   660
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   29
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":1AE0
            Key             =   "sz"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":1E7A
            Key             =   "dy"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":2214
            Key             =   "yl"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":25AE
            Key             =   "xg"
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":2948
            Key             =   "zh"
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":2CE2
            Key             =   "sh"
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":307C
            Key             =   "bc"
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":3416
            Key             =   "fq"
         EndProperty
         BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":37B0
            Key             =   "bz"
         EndProperty
         BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":3B4A
            Key             =   "tc"
         EndProperty
         BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":3EE4
            Key             =   "bcgs"
         EndProperty
         BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":427E
            Key             =   "mrlk"
         EndProperty
         BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":4618
            Key             =   "xsxm"
         EndProperty
         BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":49B2
            Key             =   "first"
         EndProperty
         BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":4D4C
            Key             =   "prev"
         EndProperty
         BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":50E6
            Key             =   "next"
         EndProperty
         BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":5480
            Key             =   "last"
         EndProperty
         BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":581A
            Key             =   "xx"
         EndProperty
         BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":5BB4
            Key             =   "define"
         EndProperty
         BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":5F4E
            Key             =   "exec"
         EndProperty
         BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":62E8
            Key             =   "xz"
         EndProperty
         BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":6682
            Key             =   "sc"
         EndProperty
         BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":6A1C
            Key             =   "sx"
         EndProperty
         BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":6DB6
            Key             =   "cx"
         EndProperty
         BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":7150
            Key             =   "zd"
         EndProperty
         BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":74EA
            Key             =   "dz"
         EndProperty
         BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":7884
            Key             =   "ph"
         EndProperty
         BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":7C1E
            Key             =   "fz"
         EndProperty
         BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "处理_人事变动处理.frx":7FB8
            Key             =   "dw"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.Toolbar SzToolbar 
      Align           =   1  'Align Top
      Height          =   570
      Left            =   0
      TabIndex        =   32
      Top             =   0
      Width           =   8925
      _ExtentX        =   15743
      _ExtentY        =   1005
      ButtonWidth     =   820
      ButtonHeight    =   953
      AllowCustomize  =   0   'False
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   12
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "设置"
            Key             =   "ymsz"
            ImageKey        =   "sz"
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "打印"
            Key             =   "dy"
            Object.ToolTipText     =   "点击或按Ctrl+P打印表格"
            ImageKey        =   "dy"
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "预览"
            Key             =   "yl"
            ImageKey        =   "yl"
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "变动"
            Key             =   "bd"
            Object.ToolTipText     =   "点击或按Ctrl+A增加记录"
            ImageKey        =   "xz"
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "保存"
            Key             =   "bc"
            ImageKey        =   "bc"
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "删除"
            Key             =   "sc"
            Object.ToolTipText     =   "点击或按Ctrl+D删除当前记录"
            ImageKey        =   "sc"
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.Visible         =   0   'False
            Caption         =   "刷新"
            Key             =   "sx"
            ImageKey        =   "sx"
         EndProperty
         BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.Visible         =   0   'False
            Style           =   3
         EndProperty
         BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "帮助"
            Key             =   "bz"
            ImageKey        =   "bz"
         EndProperty
         BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出"
            Key             =   "fh"
            ImageKey        =   "tc"
         EndProperty
      EndProperty
      BorderStyle     =   1
   End
End
Attribute VB_Name = "Ed_EmpChgFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**********************************************************
'*    模 块 名 称 :人事变动处理
'*    功 能 描 述 :人事变动处理
'*    程序员姓名  :郑兴
'*    最后修改人  :郑兴
'*    最后修改时间:2002/01/04
'*    备        注:(*所有自定义部分程序均用[>> <<]括起)
'**********************************************************
Dim jdzygs As Integer                    '控件焦点转移个数
Dim Tsxx As String                       '系统提示信息
Dim i As Integer                         '文本框循环记录
Dim Lrzt As Integer                      '录入状态标志(0-非录入状态 1-增加 2-修改)
Dim Lab_BillId  As String                '记录职工号
Dim Bln_BillChange As Boolean                   '标识单据是否发生改动
Dim int_TsLab As Integer
Dim Str_RightEdit As String             '编辑(新增、修改、删除)权限索引
'以下为固定使用变量(网格)
Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
'以下为固定使用变量(文本框)
Dim Textvar() As Variant                 '存储变体型文本框信息
Dim Textboolean() As Boolean             '存储布尔型文本框信息
Dim Textint() As Integer                 '存储整型文本框信息
Dim Textstr() As String                  '存储字符型文本框信息
Dim Max_Text_Index As Integer            '最大录入文本框索引值
Dim TextGroupCode As String              '文本框录入分组编码
Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
Dim CurTextIndex As Integer              '当前文本框索引值
Dim TextChangeLock As Boolean            '文本框内容变换控制锁
Dim Bln_Cancel As Boolean                '取消按钮信息传递
Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
    
    jdzygs = 18
    
    Select Case KeyAscii
    Case vbKeyReturn
        If Kjjdzy(jdzygs) Then
            KeyAscii = 0
        End If
    Case 39           '屏蔽"'"
        KeyAscii = 0
    End Select
    
End Sub
Private Sub Form_Load()
    
    '打印报表标题信息
    ReportTitle = "人事变动处理"
    
    '调入打印页面设置窗体
    XtReportCode = "Rs_EmpChgFrm"
    Load Dyymctbl
    
    '以下为文本框处理程序
    
    TextGroupCode = "Rs_EmpChgFrm"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
    Call Wbkcsh
    
    '初始化各文本框对应字段名（通过文本框对应标签的 Tag 属性记录）和内容
     Me.TsLabel(0).Tag = "EmpNo"
     Me.TsLabel(2).Tag = "ChangeType"
     Me.TsLabel(6).Tag = "OldDeptCode"
     Me.TsLabel(7).Tag = "DeptCode"
     Me.TsLabel(8).Tag = "OldBusiness"
     Me.TsLabel(9).Tag = "Business"
     Me.TsLabel(10).Tag = "OldPosition"
     Me.TsLabel(11).Tag = "Position"
     Me.TsLabel(12).Tag = "OldWorkType"
     Me.TsLabel(13).Tag = "WorkType"
     Me.TsLabel(14).Tag = "OldHireProp"
     Me.TsLabel(15).Tag = "HireProp"
     Me.TsLabel(16).Tag = "OldEmpSort"
     Me.TsLabel(17).Tag = "EmpSort"
     '锁定文本框
      Call lrtext_wbksd
     
    '单据变动置为False(Fixed)
     Bln_BillChange = False
     
     '调入数据初始化模块(Fixed)
      Lrzt = Xtcdcs
      If Lrzt = 2 Then
        Lab_BillId = XT_BillID
        Call Cxnrtcwg
        LrText(0).Enabled = False
        Ydcommand1(0).Enabled = False
      Else
       '初始工具条等
     
        Call Toolbjzt
   
      End If
    
    '编辑(新增、修改、删除)权限索引
    Str_RightEdit = "Rs_Ed_EmpChg_Edit"
    
End Sub
 Private Function lrtext_wbksd()   '原人员信息的文本框锁定
  
  LrText(1).Locked = True
  LrText(6).Locked = True
  LrText(8).Locked = True
  LrText(10).Locked = True
  LrText(12).Locked = True
  LrText(14).Locked = True
  LrText(16).Locked = True
End Function
Private Sub Cxnrtcwg()                               '查询内容填充文本框
    
    '过程默认参数为当前窗体中单据ID:Lab_BillID
    Dim Sqlstr As String                           '临时使用字符串
    Dim RecTemp As New ADODB.Recordset             '临时使用动态集
    Dim jsqte As Long                              '临时计数器
    Dim str_TempSql As String
    Dim rs_Temp As New ADODB.Recordset
    
     
    '本张单据查询字符串
    Sqlstr = "Select Rs_Change.*,Rs_BasicInfo.EmpNo,Rs_BasicInfo.EmpName From Rs_BasicInfo INNER JOIN Rs_Change ON Rs_BasicInfo.EmpID = Rs_Change.EmpID WHERE Rs_BasicInfo.EmpNo='" & Lab_BillId & "' and Rs_BasicInfo.YNStop='0' and Rs_Change.SNo='" & str_mark & "'"
    
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
        If Not .EOF Then
            '[>>显示单据
            TextChangeLock = True     '文本框加锁
            LrText(0).Text = Trim(.Fields("EmpNo"))                                                        '职工号
            LrText(1).Text = Trim(.Fields("EmpName"))                                                      '职工姓名
            '变动类型
            str_TempSql = "select * from Rs_CorSub where SortId='1'and  ListId ='" & Trim(.Fields("ChangeType")) & "'"
            Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(str_TempSql)
            With rs_Temp
              If Not .EOF() Then
                Me.LrText(2).Text = Trim(.Fields("ListName")) & ""
                Me.LrText(2).Tag = Trim(.Fields("ListId")) & ""
              End If
            End With
            
            If IsDate(.Fields("ChangeTime")) Then
                LrText(3).Text = Format(.Fields("ChangeTime"), "yyyy-mm-dd")                                '日期
            End If
            If IsDate(.Fields("InductionTime")) Then
                LrText(4).Text = Format(.Fields("InductionTime"), "yyyy-mm-dd")                             '日期
            End If
            LrText(5).Text = Trim(.Fields("Remark") & "")                                                   '备注
            '部门
            str_TempSql = "SELECT Gy_Department_1.DeptName, Gy_Department.DeptName AS DeptNameNew,Rs_Change.* " & _
                          "FROM Gy_Department INNER JOIN Rs_Change ON " & _
                          "Gy_Department.DeptCode = Rs_Change.DeptCode INNER JOIN Gy_Department Gy_Department_1 ON " & _
                          "Rs_Change.OldDeptCode = Gy_Department_1.DeptCode " & _
                          "WHERE Rs_Change.OldDeptCode = '" & Trim(.Fields("OldDeptCode")) & "' AND Rs_Change.DeptCode = '" & Trim(.Fields("DeptCode")) & "'"
            Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(str_TempSql)
            With rs_Temp
              If Not .EOF() Then
                Me.LrText(6).Text = Trim(.Fields("DeptName")) & ""
                Me.LrText(6).Tag = Trim(.Fields("OldDeptCode")) & ""
                Me.LrText(7).Text = Trim(.Fields("DeptNameNew")) & ""
                Me.LrText(7).Tag = Trim(.Fields("DeptCode")) & ""
              End If
            End With
            
            For int_TsLab = 8 To TsLabel.count - 1
                If int_TsLab Mod 2 = 0 Then
                   str_TempSql = "select Rs_CorSub.* from Rs_Items INNER JOIN Rs_CorSub ON Rs_Items.Correlation = Rs_CorSub.SortId where Rs_Items.FieldName='" & TsLabel(int_TsLab + 1).Tag & "' and Rs_CorSub.ListId='" & Trim(.Fields(TsLabel(int_TsLab).Tag)) & "'"
                Else
                   str_TempSql = "select Rs_CorSub.* from Rs_Items INNER JOIN Rs_CorSub ON Rs_Items.Correlation = Rs_CorSub.SortId where Rs_Items.FieldName='" & TsLabel(int_TsLab).Tag & "' and Rs_CorSub.ListId='" & Trim(.Fields(TsLabel(int_TsLab).Tag)) & "'"
                End If
                Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(str_TempSql)
                With rs_Temp
                  If Not .EOF() Then
                    Me.LrText(int_TsLab).Text = Trim(.Fields("ListName")) & ""
                    Me.LrText(int_TsLab).Tag = Trim(.Fields("ListId")) & ""
                  End If
                End With
            Next
            
            TextChangeLock = False    '文本框解锁
            '<<]
        End If
    End With
    
End Sub
Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
    
    Set Cxnrrec = Nothing
    Set Rec_CodeSet = Nothing
    Unload Dyymctbl
    
    '判断单据是否发生变化,并返回相应标识
    If Bln_BillChange Then
        Xtfhcs = "1"
    Else
        Xtfhcs = "0"
    End If
    
End Sub
Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
    
    Dim RecTemp As New ADODB.Recordset                    '临时使用动态集
    Dim Rec_Bill As New ADODB.Recordset                   '单据表动态集
    Dim jsqte As Integer                                  '临时计数器
    Dim int_SNo As Integer
    Dim str_Change As String
    
    
    Bclrsj = False
    
    '一.============先对单据内容进行有效性判断==============='
    
    '先进行字段不能为空或不能为零有效性判断(Fixed)
    For jsqte = 0 To Max_Text_Index
        If Textint(jsqte, 8) = 1 Then     '字段不能为空
            If Len(Trim(LrText(jsqte).Text)) = 0 Then
                Tsxx = Textstr(jsqte, 7) & "不能为空!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(jsqte).SetFocus
                Exit Function
            End If
        Else
            If Textint(jsqte, 8) = 2 Then   '字段不能为零
                If Val(Trim(LrText(jsqte).Text)) = 0 Then
                    Tsxx = Textstr(jsqte, 7) & "不能为零!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(jsqte).SetFocus
                    Exit Function
                End If
            End If
        End If
    Next jsqte
    
    '对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
    For jsqte = 0 To Max_Text_Index
        If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
            If Not TextYxxpd(jsqte) Then
                Exit Function
            End If
        End If
    Next jsqte
    
    '[>>
    
    '可在此区域写入其他对单据表头内容的有效性判断,具体格式参照如下
    
    
    
    
    
    '<<]
    
    '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
    
    '对存盘进行事务处理(Fixed)
    On Error GoTo Swcwcl
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '判断单据状态以进行不同处理
    
    '1变动是调入和内部变动的
    If LrText(2).Tag <> "1002" Then
        If Trim(LrText(7).Text) = "" Then Call Xtxxts("部门不能为空!", 0, 1): Cw_DataEnvi.DataConnect.RollbackTrans: Exit Function
        
    If Lrzt = 1 Then
        '新增单据
        
        '2.开始存盘
        
        '打开单据表动态集
        
        '保存人事变动表
        If Rec_Bill.State = 1 Then Rec_Bill.Close
        Rec_Bill.Open "Select Rs_Change.* From Rs_BasicInfo INNER JOIN Rs_Change ON Rs_BasicInfo.EmpID = Rs_Change.EmpID WHERE Rs_BasicInfo.EmpNo='" & Trim(LrText(0).Text) & "' and Rs_BasicInfo.YNStop='0'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        
        If Rec_Bill.RecordCount = 0 Then
           int_SNo = 1
        Else
           Rec_Bill.MoveLast
           int_SNo = Rec_Bill.RecordCount + 1
        End If
        
        With Rec_Bill
            .AddNew
            .Fields("EmpID") = Trim(LrText(0).Tag)                                                       '序号
            .Fields("SNo") = int_SNo                                                                     '变动顺序号
            .Fields("ChangeType") = Trim(LrText(2).Tag)                                                  '日期
            .Fields("ChangeTime") = Format(Trim(LrText(3).Text), "YYYY-MM-DD")
            If Trim((LrText(4).Text)) <> "" Then
              .Fields("InductionTime") = Format(Trim((LrText(4).Text)), "YYYY-MM-DD")
            End If
            If Trim((LrText(5).Text)) <> "" Then
              .Fields("Remark") = Trim(LrText(5).Text)                                                    '备注
            End If
            .Fields("OldDeptCode") = Trim(LrText(6).Tag)                                                  '原部门
            .Fields("DeptCode") = Trim(LrText(7).Tag)                                                     '现部门
            
            For int_TsLab = 8 To TsLabel.count - 1
              If Trim((LrText(int_TsLab).Text)) <> "" Then
                .Fields(TsLabel(int_TsLab).Tag) = Trim(LrText(int_TsLab).Tag)
              End If
            Next
            .Update
            
            '系统读出单据ID写入Lab_BillID
            Lab_BillId = Trim(LrText(0).Text)
            str_mark = int_SNo
        End With
    
    Else
        '修改单据
        
        '打开单据表动态集
        If Rec_Bill.State = 1 Then Rec_Bill.Close
        Rec_Bill.Open "Select Rs_Change.* From Rs_BasicInfo INNER JOIN Rs_Change ON Rs_BasicInfo.EmpID = Rs_Change.EmpID WHERE Rs_BasicInfo.EmpNo='" & Trim(LrText(0).Text) & "' and Rs_BasicInfo.YNStop='0'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        
        If Rec_Bill.EOF() Then
            Tsxx = "记录不存在，无法修改!"
            Call Xtxxts(Tsxx, 0, 3)
            Exit Function
        Else
            Rec_Bill.MoveLast
        End If
        
        With Rec_Bill
            .Fields("ChangeType") = Trim(LrText(2).Tag)                                                '日期
            .Fields("ChangeTime") = Format(Trim(LrText(3).Text), "YYYY-MM-DD")
            If Trim((LrText(4).Text)) <> "" Then
              .Fields("InductionTime") = Format(Trim((LrText(4).Text)), "YYYY-MM-DD")
            Else
              .Fields("InductionTime") = Null
            End If
            If Trim((LrText(5).Text)) <> "" Then
              .Fields("Remark") = Trim(LrText(5).Text)                                                 '备注
            Else
              .Fields("Remark") = ""
            End If
            
            .Fields("OldDeptCode") = Trim(LrText(6).Tag)                                               '原部门
            .Fields("DeptCode") = Trim(LrText(7).Tag)                                                  '现部门
            For int_TsLab = 8 To TsLabel.count - 1
              If Trim((LrText(int_TsLab).Text)) <> "" Then
                .Fields(TsLabel(int_TsLab).Tag) = Trim(LrText(int_TsLab).Tag)
              Else
                .Fields(TsLabel(int_TsLab).Tag) = ""
              End If
            Next
            .Update
        End With
    
    End If
    
    
        If RecTemp.State = 1 Then RecTemp.Close
        RecTemp.Open "Select Rs_BasicInfo.* From Rs_BasicInfo WHERE Rs_BasicInfo.EmpNo='" & Trim(LrText(0).Text) & "' and Rs_BasicInfo.YNStop='0'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With RecTemp
            
            If Trim((LrText(4).Text)) <> "" Then
              .Fields("InductionTime") = Format(Trim((LrText(4).Text)), "YYYY-MM-DD")                    '日期
            Else
              .Fields("InductionTime") = Null
            End If
            
            For int_TsLab = 7 To TsLabel.count - 1
               If int_TsLab Mod 2 <> 0 Then
                  If Trim((LrText(int_TsLab).Text)) <> "" Then
                    .Fields(TsLabel(int_TsLab).Tag) = Trim(LrText(int_TsLab).Tag)
                  Else
                    .Fields(TsLabel(int_TsLab).Tag) = ""
                  End If
               End If
            Next
            .Update
        End With
    
    Else
        '保存调出的记录
        If Rec_Bill.State = 1 Then Rec_Bill.Close
        Rec_Bill.Open "Select Rs_Change.* From Rs_BasicInfo INNER JOIN Rs_Change ON Rs_BasicInfo.EmpID = Rs_Change.EmpID WHERE Rs_BasicInfo.EmpNo='" & Trim(LrText(0).Text) & "' and Rs_BasicInfo.YNStop='0'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        
        If Rec_Bill.RecordCount = 0 Then
           int_SNo = 1
        Else
           Rec_Bill.MoveLast
           int_SNo = Rec_Bill.Fields("SNo") + 1
        End If
        
        With Rec_Bill
            .AddNew
            .Fields("EmpID") = Trim(LrText(0).Tag)                                                          '职工号
            .Fields("SNo") = int_SNo                                                                        '顺序号
            .Fields("ChangeType") = Trim(LrText(2).Tag)                                                     '日期
            .Fields("ChangeTime") = Format(Trim(LrText(3).Text), "YYYY-MM-DD")
            If Trim((LrText(4).Text)) <> "" Then
              .Fields("InductionTime") = Format(Trim((LrText(4).Text)), "YYYY-MM-DD")
            End If
            If Trim((LrText(5).Text)) <> "" Then
              .Fields("Remark") = Trim(LrText(5).Text)                                                       '备注
            End If
            .Fields("OldDeptCode") = Trim(LrText(6).Tag)
            .Fields("DeptCode") = Trim(LrText(7).Tag)
            .Update
        End With
        
        '1变动是调出的
        If RecTemp.State = 1 Then RecTemp.Close
        RecTemp.Open "Select Rs_BasicInfo.YNStop From Rs_BasicInfo WHERE Rs_BasicInfo.EmpNo='" & Trim(LrText(0).Text) & "' and Rs_BasicInfo.YNStop='0'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If RecTemp.EOF() Then
            Tsxx = "记录不存在，无法修改!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Function
        Else
              RecTemp.Fields("YNStop") = 1
              RecTemp.Update
        End If
    
    End If
    
    Cw_DataEnvi.DataConnect.CommitTrans
    
    
    '标识单据发生改动
    
    '设置单据改变后的状态
    Bclrsj = True
    
    If Lrzt = 1 Then
        Call Xtxxts("保存成功!", 0, 4)
    Else
        Call Xtxxts("修改成功!", 0, 4)
    End If
   
    '标识单据发生改动
    Bln_BillChange = True
    
    Exit Function
Swcwcl:       '数据存盘时出现错误
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function
    
End Function
Private Sub Scdqjl()                 '删 除 当 前 记 录
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
       Exit Sub
    End If
    
    Dim YAnswer As Integer               '确认是否删除当前单据
    Dim jsqte As Long                    '临时使用计数器
    Dim RecTemp As New ADODB.Recordset                    '临时使用动态集
    
    
    '非有效单据不予进行删除动作
    If Trim(Lab_BillId) = "" Then
        Exit Sub
    End If
    
    Tsxx = "请确认是否删除当前变动记录?"
    YAnswer = Xtxxts(Tsxx, 2, 2)
    
    If YAnswer = 1 Then
        
        
        '进行事务处理
        On Error GoTo Swcwcl
        Cw_DataEnvi.DataConnect.BeginTrans
        
        '还原Rs_BasicInfo(人事基本信息的内容)
        
        If RecTemp.State = 1 Then RecTemp.Close
        RecTemp.Open "Select Rs_BasicInfo.* From Rs_BasicInfo WHERE Rs_BasicInfo.EmpNo='" & Trim(LrText(0).Text) & "' and Rs_BasicInfo.YNStop='0'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If RecTemp.RecordCount = 0 Then Exit Sub
        With RecTemp
            If Trim((LrText(4).Text)) <> "" Then
              .Fields("InductionTime") = Format(Trim((LrText(4).Text)), "YYYY-MM-DD")                        '日期
            Else
              .Fields("InductionTime") = Null
            End If
            
            For int_TsLab = 6 To TsLabel.count - 1
                If int_TsLab Mod 2 = 0 Then
                    If Trim((LrText(int_TsLab).Text)) <> "" Then
                       .Fields(TsLabel(int_TsLab + 1).Tag) = Trim((LrText(int_TsLab).Tag))
                    Else
                       .Fields(TsLabel(int_TsLab + 1).Tag) = ""
                    End If
                 End If
             Next
            .Update
        End With
        
        '1.删除单据所有内容
        Cw_DataEnvi.DataConnect.Execute ("Delete Rs_Change FROM Rs_Change INNER JOIN Rs_BasicInfo ON Rs_Change.EmpID = Rs_BasicInfo.EmpID Where Rs_Change.SNo ='" & str_mark & "' and Rs_BasicInfo.EmpNo='" & Lab_BillId & "'")
        
        Cw_DataEnvi.DataConnect.CommitTrans
        
        '标识单据发生改动
        Bln_BillChange = True
        
        '单据ID置0
        Lab_BillId = ""
    Else
        Exit Sub
    End If
    
    '删除单据后重置状态
    '设置操作状态为变动
        
     Lrzt = 1
    
    '1.显示下一张单据
    
    '2.如果无下一张单据则搜索上一张单据
    
    '3.如无单据则置单据为空状态
    If Trim(Lab_BillId) = "" Then
        '清除录入文本框
        For jsqte = Max_Text_Index To 0 Step -1
            LrText(jsqte).Tag = ""
            LrText(jsqte).Text = ""
        Next jsqte
        
        '设置操作状态为浏览
    End If
    
    Exit Sub
Swcwcl:          '单据删除时出现错误
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "单据删除过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
End Sub
'*******************以下区域为编写自定义过程区域**********************
'*******************以上区域为编写自定义过程区域**********************
'*******************************以下为基本处理程序(固定不变)*******************************************'
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
    
    If Shift = 2 Then
        Select Case UCase(Chr(KeyCode))
        Case "P"                                                                          'Ctrl+P 打印
            If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
               Call bbyl(False)
            End If
        Case "A"                                                                          'Ctrl+A 增加
            If SzToolbar.Buttons("bd").Visible And SzToolbar.Buttons("bd").Enabled Then
                Call Toolbjzt
                LrText(0).SetFocus
                Lrzt = 1
            End If
        Case "D"                                                                          'Ctrl+D 删除
            If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
                Call Scdqjl
                If Lrzt = 1 Then
                  Call Toolbjzt
                  LrText(0).SetFocus
                End If
            End If
        End Select
    End If
    
End Sub
Private Sub LrText_Validate(Index As Integer, Cancel As Boolean)
  Call lrtext_wbkbmzh(Index)
End Sub
Private Sub lrtext_wbkbmzh(Index)    '文本框编码和内容转换
  Dim str_Cmp As String
  Dim str_Sortid As Integer
  Dim jsqte As Integer
  Dim str_TempSql As String
  Dim rs_Temp As New ADODB.Recordset
  
  str_Cmp = Replace(Trim(Me.LrText(Index).Text), "'", "|")
  
  If Trim(str_Cmp) = "" Then
    Me.LrText(Index).Tag = ""
    Exit Sub
  End If
  
  Select Case Index
    Case 2  '现变动类型
      If Not IsNumeric(str_Cmp) Then
        str_TempSql = "select * from Rs_CorSub where SortId='1'and  ListName ='" & Trim(str_Cmp) & "'"
      Else
        str_TempSql = "select * from Rs_CorSub where SortId='1'and (ListId= '" & Trim(str_Cmp) & "' or ListName ='" & Trim(str_Cmp) & "')"
      End If
      Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(str_TempSql)
      With rs_Temp
        If Not .EOF() Then
          Me.LrText(Index).Text = Trim(.Fields("ListName"))
          Me.LrText(Index).Tag = Trim(.Fields("ListId"))
        Else
          SendKeys "{home}+{end}"
        End If
      End With
    Case 7  '现部门
      str_TempSql = "select * from Gy_Department where RsPMFlag=1 and (DeptCode= '" & Trim(str_Cmp) & "' or DeptName ='" & Trim(str_Cmp) & "')"
      Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(str_TempSql)
      With rs_Temp
        If Not .EOF() Then
          Me.LrText(Index).Text = Trim(.Fields("DeptName"))
          Me.LrText(Index).Tag = Trim(.Fields("DeptCode"))
        Else
          SendKeys "{home}+{end}"
        End If
      End With
    Case 9, 11, 13, 15, 17 '职务、岗位、工种、用工性质、职工类别
      
      If Not IsNumeric(str_Cmp) Then
        str_TempSql = "select Rs_CorSub.* from Rs_Items INNER JOIN Rs_CorSub ON Rs_Items.Correlation = Rs_CorSub.SortId where Rs_Items.FieldName='" & TsLabel(Index).Tag & "' and Rs_CorSub.ListName='" & Trim(str_Cmp) & "'"
      Else
        str_TempSql = "select Rs_CorSub.* from Rs_Items INNER JOIN Rs_CorSub ON Rs_Items.Correlation = Rs_CorSub.SortId where Rs_Items.FieldName='" & TsLabel(Index).Tag & "' and (Rs_CorSub.Listid='" & Trim(str_Cmp) & "' or Rs_CorSub.ListName='" & Trim(str_Cmp) & "')"
      End If
      
      Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(str_TempSql)
      With rs_Temp
        If Not .EOF() Then
          Me.LrText(Index).Text = Trim(.Fields("ListName"))
          Me.LrText(Index).Tag = Trim(.Fields("ListId"))
        Else
          SendKeys "{home}+{end}"
        End If
      End With
  End Select
  
  Set rs_Temp = Nothing
End Sub
Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    Select Case Button.Key
    Case "ymsz"                                          '页面设置
        Dyymctbl.Show 1
    Case "yl"                                            '预 览
         Print_Empchange
    Case "dy"                                            '打 印
        DY_DytsFrm.Show 1
    Case "bd"                                            '变 动
        '判断用户是否有此功能执行权限,如有则写上机日志(进入)
        If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
            Exit Sub
        End If
        Call Toolbjzt
        LrText(0).SetFocus
        Lrzt = 1
    Case "bc"                                            '保 存
        '判断用户是否有此功能执行权限,如有则写上机日志(进入)
        If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
            Exit Sub
        End If
        If Not Bclrsj Then
            Exit Sub
        End If
        Call Toolfbjzt
        Lrzt = 2
    Case "sc"                                            '删 除
        '判断用户是否有此功能执行权限,如有则写上机日志(进入)
        If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
            Exit Sub
        End If
        Call Scdqjl
        If Lrzt = 1 Then
          Call Toolbjzt
          LrText(0).SetFocus
        End If
    Case "sx"                                            '刷 新
        Call Cxnrtcwg
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
    End Select
    
End Sub
Private Sub Toolbjzt()                                                  'Toolbar状态(编辑状态)
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
        Exit Sub
    End If
    
    '增加新记录时将文本框清空
    For jsqte = 0 To Max_Text_Index
        If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
            LrText(jsqte).Text = ""
            LrText(jsqte).Tag = ""
        End If
        TextValiJudgeLock(jsqte) = True
    Next jsqte
    
     '锁定文本框
      Call lrtext_wbksd
    
    
    With SzToolbar
        .Buttons("ymsz").Enabled = False
        .Buttons("dy").Enabled = False
        .Buttons("yl").Enabled = False
        .Buttons("sc").Enabled = False
    End With
    LrText(0).Enabled = True
    Ydcommand1(0).Enabled = True
    
    LrText(3).Text = Format(Now(), "YYYY-MM-DD")
    LrText(4).Text = Format(Now(), "YYYY-MM-DD")
End Sub
Private Sub Toolfbjzt()                                                 'Toolbar状态(非编辑状态)
    
    With SzToolbar
        .Buttons("ymsz").Enabled = True
        .Buttons("dy").Enabled = True
        .Buttons("yl").Enabled = True
        .Buttons("sc").Enabled = True
    End With
    LrText(0).Enabled = False
    Ydcommand1(0).Enabled = False
End Sub
Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 9                                   '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    
    Bbzbt = ReportTitle
    
    Bbxbt(2) = Space(1) + Fun_FormatOutPut("职工号: " + Trim(LrText(0).Text), 30)
    Bbxbt(2) = Bbxbt(2) + Fun_FormatOutPut("姓名: " + Trim(LrText(1).Text), 25) + Fun_FormatOutPut("变动类型:  " + Trim(LrText(2).Text), 30)
    Bbxbt(3) = Space(1) + Fun_FormatOutPut("变动时间: " + Trim(LrText(3).Text), 30)
    Bbxbt(3) = Bbxbt(3) + Fun_FormatOutPut("到职时间: " + Trim(LrText(4).Text), 25) + Fun_FormatOutPut("备注:  " + Trim(LrText(5).Text), 30)
    Bbxbt(4) = Space(1) + Fun_FormatOutPut("原部门: " + Trim(LrText(6).Text), 30) + Fun_FormatOutPut("现部门: " + Trim(LrText(7).Text), 25)
    Bbxbt(5) = Space(1) + Fun_FormatOutPut("原职务: " + Trim(LrText(8).Text), 30) + Fun_FormatOutPut("现职务: " + Trim(LrText(9).Text), 25)
    Bbxbt(6) = Space(1) + Fun_FormatOutPut("原岗位: " + Trim(LrText(10).Text), 30) + Fun_FormatOutPut("现岗位: " + Trim(LrText(11).Text), 25)
    Bbxbt(7) = Space(1) + Fun_FormatOutPut("原工种: " + Trim(LrText(12).Text), 30) + Fun_FormatOutPut("现工种: " + Trim(LrText(13).Text), 25)
    Bbxbt(8) = Space(1) + Fun_FormatOutPut("原用工性质: " + Trim(LrText(14).Text), 30) + Fun_FormatOutPut("现用工性质: " + Trim(LrText(15).Text), 25)
    Bbxbt(9) = Space(1) + Fun_FormatOutPut("原职工类别: " + Trim(LrText(16).Text), 30) + Fun_FormatOutPut("现职工类别: " + Trim(LrText(17).Text), 25)
    
'    Bbxbt(1) = " "
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
    
'    Call Scyxsjb(CzxsGrid)                               '生成报表数据
'    Dyymctbl.BbmcLabel = "人事变动处理"
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If
    
End Sub
'************以下为文本框录入处理程序(固定不变部分)*************'
Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
    
    '以下为依据实际情况自定义部分[
    
    '在此填写文本框录入事后处理程序
    Call InfoShow(Index)
    
    ']以上为依据实际情况自定义部分
    
End Sub
Private Sub LrText_Change(Index As Integer)
    
    '屏蔽程序改变控制
    If TextChangeLock Then
        Exit Sub
    End If
    
    TextValiJudgeLock(Index) = False    '打开有效性判断锁
    
    '限制字段录入长度
    
    TextChangeLock = True  '加锁(防止执行Lrtext_Change)
    
    Call TextChangeLimit(LrText(Index), Textint(Index, 1))  '去掉无效字符
    
    Select Case Textint(Index, 1)
    Case 8, 11       '金额型
        Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
    Case 9, 12       '数量型
        Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
    Case 10          '单价型
        Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
    Case Else        '其他小数类型控制
        If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
            Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
        End If
    End Select
    
    TextChangeLock = False '解锁
    
End Sub
Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
    
    Call TextShow(Index)
    CurTextIndex = Index
    LrText(Index).SelStart = Len(LrText(Index))
    
End Sub
Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
    
    Select Case KeyCode
    Case vbKeyF2
        Call Text_Help(Index)
    End Select
    
End Sub
Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
    
    Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
    
End Sub
Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点
    
    '显示相应信息但不能进行有效性判断
  Call lrtext_wbkbmzh(Index)
  
  If Textint(Index, 9) = 0 Or Textint(Index, 9) = 2 Then  '事中判断
     Call TextYxxpd(Index)
  End If
End Sub
Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
    Dim str_Getdep As String
    Dim str_depName As String
    
    If Index <> 7 Then
      Call Text_Help(Index)
    Else
       
       TextValiLock = True
       
       str_Getdep = ""
       str_depName = ""
       str_Getdep = GetDeptHp(True, str_depName)
       LrText(Index).Text = str_depName
       LrText(Index).Tag = str_Getdep
       
       TextValiLock = False
    End If
    
End Sub
Private Sub InfoShow(Index As Integer)        '根据所选的职工号在文本框中显示人事基础信息
Dim str_Info As String                           '临时使用字符串
Dim Rec_Info As New ADODB.Recordset             '临时使用动态集
Dim Sqlstr As String                           '临时使用字符串
Dim RecTemp As New ADODB.Recordset             '临时使用动态集
If Index <> 0 Then Exit Sub
If LrText(Index) = "" Then Exit Sub
str_Info = "SELECT Rs_BasicInfo.*,Gy_Department.*" & _
" FROM Gy_Department INNER JOIN Rs_BasicInfo ON Gy_Department.DeptCode = Rs_BasicInfo.DeptCode " & _
" Where Rs_BasicInfo.EmpNo='" & LrText(Index).Text & "' and YNStop='0'"
Set Rec_Info = Cw_DataEnvi.DataConnect.Execute(str_Info)
If Rec_Info.EOF() Then Exit Sub
With Rec_Info
    LrText(0).Text = Trim(.Fields("EmpNo"))
    LrText(0).Tag = Trim(.Fields("EmpID"))
    LrText(1).Text = Trim(.Fields("EmpName"))
    LrText(6).Text = Trim(.Fields("DeptName"))
    LrText(6).Tag = Trim(.Fields("DeptCode"))
    For int_TsLab = 8 To TsLabel.count - 1
        If int_TsLab Mod 2 = 0 Then
            Sqlstr = "select Rs_CorSub.* from Rs_Items INNER JOIN Rs_CorSub ON Rs_Items.Correlation = Rs_CorSub.SortId where Rs_Items.FieldName='" & TsLabel(int_TsLab + 1).Tag & "' and Rs_CorSub.ListId='" & Trim(.Fields(TsLabel(int_TsLab + 1).Tag)) & "'"
            Set RecTemp = Nothing
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            With RecTemp
                If Not RecTemp.EOF() Then
                  Me.LrText(int_TsLab).Text = Trim(RecTemp.Fields("ListName")) & ""
                  Me.LrText(int_TsLab).Tag = Trim(RecTemp.Fields("ListId")) & ""
                End If
            End With
         End If
    Next
End With
Set Rec_Info = Nothing
End Sub
Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
    
    If Not Textboolean(Index, 1) Then
        Exit Sub
    End If
    
    TextValiLock = True
    
    '调用帮助
    Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
    
    '根据设置选择显示编码和名称,并进行存储
    If Len(Xtfhcs) <> 0 Then
        If Textint(Index, 3) = 1 Then
            LrText(Index).Text = Xtfhcsfz
            LrText(Index).Tag = Xtfhcs
        Else
            LrText(Index).Text = Xtfhcs
            LrText(Index).Tag = Xtfhcsfz
        End If
    End If
    TextValiLock = False
    
    LrText(Index).SetFocus
    
End Sub
Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
    
    '填写文本框得到焦点,进行相应信息处理程序
    
End Sub
Private Sub Wbkcsh()                          '录入文本框初始化
    
    Dim jsqte As Integer
    
    '最大录入文本框索引值
    Max_Text_Index = Textvar(1)
    
    ReDim TextValiJudgeLock(Max_Text_Index)
    
    For jsqte = 0 To Max_Text_Index
        If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
            If Textboolean(jsqte, 1) Then
                If jsqte <> 0 And Not Textboolean(jsqte, 3) Then
                    Load Ydcommand1(jsqte)
                End If
                Ydcommand1(jsqte).Visible = True
                Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
            End If
            
            TextChangeLock = True
            LrText(jsqte).Text = ""
            LrText(jsqte).Tag = ""
            
            If Textint(jsqte, 5) <> 0 Then
                LrText(jsqte).MaxLength = Textint(jsqte, 5)
            End If
            
            TextChangeLock = False
        End If
        
        TextValiJudgeLock(jsqte) = True
    Next jsqte
    
End Sub
Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
    
    Dim Sqlstr As String
    Dim Findrec As ADODB.Recordset
    
    
    '按帮助不进行有效性判断
    If TextValiLock Then
       TextValiLock = False
       TextYxxpd = True
       Exit Function
    End If
    
    '文本框内容未曾改变不进行有效性判断
    If TextValiJudgeLock(Index) Then
        TextYxxpd = True
        Exit Function
    End If
    
    '文本框内容为空认为有效,并清空其Tag值
    If Trim(LrText(Index)) = "" Then
        LrText(Index).Tag = ""
        Call Wbklrwbcl(Index)
        TextValiJudgeLock(Index) = True
        TextYxxpd = True
        Exit Function
    End If
    
    '可在此加入不做有效性判断的理由
    Select Case Textint(Index, 4)
    Case 1      '编码型
        Sqlstr = Trim(Textstr(Index, 5))
        Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
        Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        
        If Findrec.EOF Then
            Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
            LrText(Index).SetFocus
            Exit Function
        Else
            Select Case Textint(Index, 3)
            Case 0
                
                If Len(Trim(Textstr(Index, 2))) <> 0 Then
                    LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
                End If
                
                If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
                    LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
                End If
                
            Case 1
                
                If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
                    LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
                End If
                
                If Len(Trim(Textstr(Index, 2))) <> 0 Then
                    LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
                End If
            End Select
        End If
        
    Case 2      '日期型
        If IsDate(LrText(Index).Text) Then
            LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
            If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
                LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
            End If
        Else
            Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(Index).SetFocus
            Exit Function
        End If
        
    Case 3      '其他类型
        
    End Select
    
    '如果有效则加锁,用户不改变内容则不再进行有效性判断
    TextValiJudgeLock(Index) = True
    
    '调用文本框事后处理程序
    Call Wbklrwbcl(Index)
    
    '有效性判断通过则返回True
    TextYxxpd = True
    
End Function
Private Sub Ydcommand2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim str_Getdep As String
    Dim str_depName As String
    
    If Index <> 7 Then
      Call Text_Help(Index)
    Else
       
       TextValiLock = True
       
       str_Getdep = ""
       str_depName = ""
       str_Getdep = GetDeptHp(True, str_depName)
       LrText(Index).Text = str_depName
       LrText(Index).Tag = str_Getdep
       
       TextValiLock = False
    End If
End Sub

						