开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 行业应用 > 企业管理 > 查看源码
资源名称：ERPSYS.zip　[点击查看]
上传用户：zhpu1995
上传日期：2013-09-06
资源大小：61151k
文件大小：70k
源码类别：

企业管理

开发平台：

Visual Basic

：源码内容
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
  3. Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
  4. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
  5. Begin VB.Form Ed_EmpArInfoFrm 
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "人事信息维护"
  8.    ClientHeight    =   8475
  9.    ClientLeft      =   1035
  10.    ClientTop       =   1155
  11.    ClientWidth     =   11910
  12.    HelpContextID   =   2213001
  13.    Icon            =   "处理_个人档案维护.frx":0000
  14.    KeyPreview      =   -1  'True
  15.    LinkTopic       =   "Form1"
  16.    MaxButton       =   0   'False
  17.    MinButton       =   0   'False
  18.    ScaleHeight     =   8475
  19.    ScaleMode       =   0  'User
  20.    ScaleWidth      =   11910
  21.    StartUpPosition =   2  '屏幕中心
  22.    Begin MSComctlLib.Toolbar SzToolbar 
  23.       Align           =   1  'Align Top
  24.       Height          =   555
  25.       Left            =   0
  26.       TabIndex        =   5
  27.       Top             =   0
  28.       Width           =   11910
  29.       _ExtentX        =   21008
  30.       _ExtentY        =   979
  31.       ButtonWidth     =   820
  32.       ButtonHeight    =   926
  33.       Appearance      =   1
  34.       Style           =   1
  35.       ImageList       =   "ImageList1"
  36.       _Version        =   393216
  37.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  38.          NumButtons      =   23
  39.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  40.             Caption         =   "设置"
  41.             Key             =   "PrinterSet"
  42.             ImageIndex      =   2
  43.          EndProperty
  44.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  45.             Caption         =   "打印"
  46.             Key             =   "Printer"
  47.             ImageIndex      =   6
  48.          EndProperty
  49.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  50.             Caption         =   "预览"
  51.             Key             =   "Preview"
  52.             ImageIndex      =   7
  53.          EndProperty
  54.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  55.             Style           =   3
  56.          EndProperty
  57.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  58.             Caption         =   "新增"
  59.             Key             =   "New"
  60.             Object.ToolTipText     =   "快捷键 Ctrl-A"
  61.             ImageIndex      =   8
  62.          EndProperty
  63.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  64.             Caption         =   "修改"
  65.             Key             =   "Modi"
  66.             Object.ToolTipText     =   "快捷键 Ctrl-E"
  67.             ImageIndex      =   9
  68.          EndProperty
  69.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  70.             Caption         =   "删除"
  71.             Key             =   "Del"
  72.             Object.ToolTipText     =   "快捷键 Del"
  73.             ImageIndex      =   10
  74.          EndProperty
  75.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  76.             Style           =   3
  77.          EndProperty
  78.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  79.             Caption         =   "保存"
  80.             Key             =   "Save"
  81.             Object.ToolTipText     =   "快捷键 Ctrl-S"
  82.             ImageIndex      =   13
  83.          EndProperty
  84.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  85.             Caption         =   "取消"
  86.             Key             =   "Cancel"
  87.             Object.ToolTipText     =   "快捷键 Esc"
  88.             ImageIndex      =   19
  89.          EndProperty
  90.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  91.             Object.Visible         =   0   'False
  92.             ImageIndex      =   11
  93.             Style           =   3
  94.          EndProperty
  95.          BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  96.             Object.Visible         =   0   'False
  97.             Caption         =   "刷新"
  98.             Key             =   "Refresh"
  99.             ImageIndex      =   11
  100.          EndProperty
  101.          BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  102.             Key             =   "sp"
  103.             Style           =   3
  104.          EndProperty
  105.          BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  106.             Caption         =   "首个"
  107.             Key             =   "First"
  108.             Object.ToolTipText     =   "快捷键 Ctrl-Home"
  109.             ImageIndex      =   14
  110.          EndProperty
  111.          BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  112.             Caption         =   "向前"
  113.             Key             =   "Previous"
  114.             Object.ToolTipText     =   "快捷键 Ctrl-PageUp"
  115.             ImageIndex      =   15
  116.          EndProperty
  117.          BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  118.             Caption         =   "向后"
  119.             Key             =   "Next"
  120.             Object.ToolTipText     =   "快捷键 Ctrl-PageDown"
  121.             ImageIndex      =   16
  122.          EndProperty
  123.          BeginProperty Button17 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  124.             Caption         =   "末尾"
  125.             Key             =   "Last"
  126.             Object.ToolTipText     =   "快捷键 Ctrl-End"
  127.             ImageIndex      =   17
  128.          EndProperty
  129.          BeginProperty Button18 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  130.             Style           =   3
  131.          EndProperty
  132.          BeginProperty Button19 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  133.             Object.Visible         =   0   'False
  134.             Caption         =   "过滤"
  135.             Key             =   "Filt"
  136.             ImageIndex      =   5
  137.          EndProperty
  138.          BeginProperty Button20 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  139.             Caption         =   "设定"
  140.             Key             =   "Set"
  141.             ImageIndex      =   4
  142.          EndProperty
  143.          BeginProperty Button21 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  144.             Style           =   3
  145.          EndProperty
  146.          BeginProperty Button22 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  147.             Caption         =   "帮助"
  148.             Key             =   "Help"
  149.             ImageIndex      =   18
  150.          EndProperty
  151.          BeginProperty Button23 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  152.             Caption         =   "退出"
  153.             Key             =   "Exit"
  154.             ImageIndex      =   12
  155.          EndProperty
  156.       EndProperty
  157.       BorderStyle     =   1
  158.       Begin MSComctlLib.ImageList ImageList1 
  159.          Left            =   8910
  160.          Top             =   135
  161.          _ExtentX        =   1005
  162.          _ExtentY        =   1005
  163.          BackColor       =   -2147483643
  164.          ImageWidth      =   16
  165.          ImageHeight     =   16
  166.          MaskColor       =   12632256
  167.          _Version        =   393216
  168.          BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  169.             NumListImages   =   19
  170.             BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  171.                Picture         =   "处理_个人档案维护.frx":1042
  172.                Key             =   "RelationAr"
  173.             EndProperty
  174.             BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  175.                Picture         =   "处理_个人档案维护.frx":13DC
  176.                Key             =   "PrinterSet"
  177.             EndProperty
  178.             BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  179.                Picture         =   "处理_个人档案维护.frx":1776
  180.                Key             =   ""
  181.             EndProperty
  182.             BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  183.                Picture         =   "处理_个人档案维护.frx":1B10
  184.                Key             =   "Set"
  185.             EndProperty
  186.             BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  187.                Picture         =   "处理_个人档案维护.frx":1EAA
  188.                Key             =   "Filt"
  189.             EndProperty
  190.             BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  191.                Picture         =   "处理_个人档案维护.frx":2244
  192.                Key             =   "Printer"
  193.             EndProperty
  194.             BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  195.                Picture         =   "处理_个人档案维护.frx":25DE
  196.                Key             =   "Preview"
  197.             EndProperty
  198.             BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  199.                Picture         =   "处理_个人档案维护.frx":2978
  200.                Key             =   "New"
  201.             EndProperty
  202.             BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  203.                Picture         =   "处理_个人档案维护.frx":2D12
  204.                Key             =   "Modi"
  205.             EndProperty
  206.             BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  207.                Picture         =   "处理_个人档案维护.frx":30AC
  208.                Key             =   "Del"
  209.             EndProperty
  210.             BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  211.                Picture         =   "处理_个人档案维护.frx":3446
  212.                Key             =   "Refresh"
  213.             EndProperty
  214.             BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  215.                Picture         =   "处理_个人档案维护.frx":37E0
  216.                Key             =   "Exit"
  217.             EndProperty
  218.             BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  219.                Picture         =   "处理_个人档案维护.frx":3B7A
  220.                Key             =   "Save"
  221.             EndProperty
  222.             BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  223.                Picture         =   "处理_个人档案维护.frx":3F14
  224.                Key             =   "First"
  225.             EndProperty
  226.             BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  227.                Picture         =   "处理_个人档案维护.frx":42AE
  228.                Key             =   "Previous"
  229.             EndProperty
  230.             BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  231.                Picture         =   "处理_个人档案维护.frx":4648
  232.                Key             =   "Next"
  233.             EndProperty
  234.             BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  235.                Picture         =   "处理_个人档案维护.frx":49E2
  236.                Key             =   "Last"
  237.             EndProperty
  238.             BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  239.                Picture         =   "处理_个人档案维护.frx":4D7C
  240.                Key             =   "Help"
  241.             EndProperty
  242.             BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  243.                Picture         =   "处理_个人档案维护.frx":5116
  244.                Key             =   ""
  245.             EndProperty
  246.          EndProperty
  247.       End
  248.    End
  249.    Begin TabDlg.SSTab SSTab1 
  250.       Height          =   7860
  251.       Left            =   0
  252.       TabIndex        =   1
  253.       TabStop         =   0   'False
  254.       Top             =   630
  255.       Width           =   11850
  256.       _ExtentX        =   20902
  257.       _ExtentY        =   13864
  258.       _Version        =   393216
  259.       Style           =   1
  260.       Tabs            =   1
  261.       TabsPerRow      =   4
  262.       TabHeight       =   520
  263.       MouseIcon       =   "处理_个人档案维护.frx":54B0
  264.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  265.          Name            =   "宋体"
  266.          Size            =   9
  267.          Charset         =   134
  268.          Weight          =   400
  269.          Underline       =   0   'False
  270.          Italic          =   0   'False
  271.          Strikethrough   =   0   'False
  272.       EndProperty
  273.       TabCaption(0)   =   "基本信息"
  274.       TabPicture(0)   =   "处理_个人档案维护.frx":54CC
  275.       Tab(0).ControlEnabled=   -1  'True
  276.       Tab(0).Control(0)=   "lID"
  277.       Tab(0).Control(0).Enabled=   0   'False
  278.       Tab(0).Control(1)=   "lpId"
  279.       Tab(0).Control(1).Enabled=   0   'False
  280.       Tab(0).Control(2)=   "Picture1"
  281.       Tab(0).Control(2).Enabled=   0   'False
  282.       Tab(0).ControlCount=   3
  283.       Begin VB.PictureBox Picture1 
  284.          Height          =   7365
  285.          Left            =   90
  286.          ScaleHeight     =   7305
  287.          ScaleWidth      =   11595
  288.          TabIndex        =   2
  289.          TabStop         =   0   'False
  290.          Top             =   390
  291.          Width           =   11655
  292.          Begin VB.VScrollBar VScBar 
  293.             Height          =   7305
  294.             Left            =   11250
  295.             Max             =   3
  296.             TabIndex        =   6
  297.             TabStop         =   0   'False
  298.             Top             =   0
  299.             Width           =   286
  300.          End
  301.          Begin VB.PictureBox Pict 
  302.             BackColor       =   &H00E9F2F3&
  303.             BorderStyle     =   0  'None
  304.             Height          =   50000
  305.             Left            =   0
  306.             ScaleHeight     =   49995
  307.             ScaleMode       =   0  'User
  308.             ScaleWidth      =   11475
  309.             TabIndex        =   3
  310.             TabStop         =   0   'False
  311.             Top             =   -30
  312.             Width           =   11475
  313.             Begin VB.CheckBox Chk_YNStop 
  314.                BackColor       =   &H00E9F2F3&
  315.                Height          =   285
  316.                Left            =   3330
  317.                TabIndex        =   9
  318.                Top             =   750
  319.                Visible         =   0   'False
  320.                Width           =   2610
  321.             End
  322.             Begin MSComDlg.CommonDialog CommDlg_pic 
  323.                Left            =   6525
  324.                Top             =   2655
  325.                _ExtentX        =   847
  326.                _ExtentY        =   847
  327.                _Version        =   393216
  328.                Filter          =   "Pictures (*.bmp)|*.bmp"
  329.             End
  330.             Begin VB.PictureBox Pic_Emp 
  331.                BackColor       =   &H80000018&
  332.                Height          =   1395
  333.                Left            =   9840
  334.                ScaleHeight     =   1335
  335.                ScaleWidth      =   1110
  336.                TabIndex        =   8
  337.                TabStop         =   0   'False
  338.                ToolTipText     =   "双击鼠标左键更改照片信息"
  339.                Top             =   270
  340.                Width           =   1170
  341.             End
  342.             Begin VB.CommandButton Cmd_CommHlp 
  343.                Height          =   300
  344.                Index           =   0
  345.                Left            =   2310
  346.                Picture         =   "处理_个人档案维护.frx":54E8
  347.                Style           =   1  'Graphical
  348.                TabIndex        =   7
  349.                TabStop         =   0   'False
  350.                Top             =   780
  351.                Visible         =   0   'False
  352.                Width           =   300
  353.             End
  354.             Begin VB.TextBox Txt_RsItm 
  355.                BackColor       =   &H00FFFFFF&
  356.                BeginProperty DataFormat 
  357.                   Type            =   0
  358.                   Format          =   "tt hh:mm:ss"
  359.                   HaveTrueFalseNull=   0
  360.                   FirstDayOfWeek  =   0
  361.                   FirstWeekOfYear =   0
  362.                   LCID            =   2052
  363.                   SubFormatType   =   0
  364.                EndProperty
  365.                ForeColor       =   &H00000000&
  366.                Height          =   300
  367.                Index           =   0
  368.                Left            =   858
  369.                TabIndex        =   0
  370.                Top             =   769
  371.                Visible         =   0   'False
  372.                Width           =   1474
  373.             End
  374.             Begin VB.Label Lbl_ItmName 
  375.                AutoSize        =   -1  'True
  376.                BackColor       =   &H00E9F2F3&
  377.                BackStyle       =   0  'Transparent
  378.                Caption         =   "编号"
  379.                Height          =   180
  380.                Index           =   0
  381.                Left            =   405
  382.                TabIndex        =   4
  383.                Top             =   810
  384.                Visible         =   0   'False
  385.                Width           =   360
  386.             End
  387.          End
  388.       End
  389.       Begin VB.Label lpId 
  390.          BackColor       =   &H000000FF&
  391.          Caption         =   "PrevEmpId"
  392.          BeginProperty Font 
  393.             Name            =   "宋体"
  394.             Size            =   9
  395.             Charset         =   134
  396.             Weight          =   700
  397.             Underline       =   0   'False
  398.             Italic          =   0   'False
  399.             Strikethrough   =   0   'False
  400.          EndProperty
  401.          ForeColor       =   &H8000000E&
  402.          Height          =   225
  403.          Left            =   2520
  404.          TabIndex        =   11
  405.          Top             =   30
  406.          Visible         =   0   'False
  407.          Width           =   1425
  408.       End
  409.       Begin VB.Label lID 
  410.          BackColor       =   &H00FF80FF&
  411.          Caption         =   "CurrentEmpID"
  412.          BeginProperty Font 
  413.             Name            =   "宋体"
  414.             Size            =   9
  415.             Charset         =   134
  416.             Weight          =   700
  417.             Underline       =   0   'False
  418.             Italic          =   0   'False
  419.             Strikethrough   =   0   'False
  420.          EndProperty
  421.          ForeColor       =   &H00FFFFFF&
  422.          Height          =   225
  423.          Left            =   4470
  424.          TabIndex        =   10
  425.          Top             =   30
  426.          Visible         =   0   'False
  427.          Width           =   1425
  428.       End
  429.    End
  430. End
  431. Attribute VB_Name = "Ed_EmpArInfoFrm"
  432. Attribute VB_GlobalNameSpace = False
  433. Attribute VB_Creatable = False
  434. Attribute VB_PredeclaredId = True
  435. Attribute VB_Exposed = False
  436. Option Explicit
  437. Dim H_MoveInt As Integer                '当前鼠标所处的位置
  438. Dim Com_ListIndexTF As Boolean
  439. Dim ReportTitle As String               '报表主标题(Fixed)
  440. Dim Saved As Boolean                    '已经保存
  441. Dim PrintSetFrm As New DY_Dyymsz
  442. Dim ScollBarIsEffect As Boolean         '滚动条是否有效
  443. Dim VScLastP As Integer                 '上一次滚动的值
  444. Dim Str_RightEdit As String             '编辑(新增、修改、删除)权限索引
  445. Dim Str_RightCase As String             '档案权限索引
  448. Dim tIsCode()                           '二维数组，一维存储是否编码（1是0否），2维存储编码
  449. Dim tSysROnly() As Boolean              '工资只读
  450. Dim tReserved() As Boolean              '是否是保留项,对应项目表里的YNRserve字段
  451. Dim tFixed() As Boolean                 '固定字段，这里用来区分不同表
  452. Dim tItmId() As Integer                 '人事项目表里的项目代号     对应原来的帮助按钮.tag
  453. Dim tDataType() As Integer              '数据类型                   对应原来的文本框.tag
  454. Dim tFieldName() As String              '字段名称                   对应原来的标签.tag
  457. Dim FileName As String                  '存储图片文件的文件名
  458. Dim Lrzt As Integer                     '录入状态标志(0-非录入状态 1-增加 2-修改)
  459. Public EmpID As Integer
  460. Dim QuerySet As New ADODB.Recordset     '保存查询结果的记录集
  462. Public ReserveId As Integer
  463. Public QuerySql As String
  464. Public FormOwner As String              '标示本窗体的调用者       Self   //   Query
  465. Public SysOwner As Integer              '标示本窗体是人事系统还是工资系统   0--rs,1--pm
  466. Public ReserveIsOn As Boolean           '表示保留项目功能状态
  468. Private Sub Chk_YNStop_GotFocus()
  469.     
  470. Dim i As Integer
  471.     If Lrzt = 0 Then
  472.         Exit Sub
  473.     End If
  474.     
  475. '隐藏失去焦点的帮助按钮
  476.     For i = 1 To Cmd_CommHlp.UBound
  477.         Cmd_CommHlp(i).Visible = False
  478.     Next i
  479. End Sub
  482. Private Sub Chk_YNStop_KeyPress(KeyAscii As Integer)
  483.     If KeyAscii = 13 Then
  484.         SendKeys "{Tab}"
  485.     End If
  486. End Sub
  489. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  490.     If Shift = 2 Then
  491.         With Me.SzToolbar
  492.             Select Case KeyCode
  493.                 Case vbKeyA                                                                 '新增   Ctrl-A
  494.                     If .Buttons("New").Visible And .Buttons("New").Enabled Then
  495.                         Call SzToolbar_ButtonClick(.Buttons("New"))
  496.                     End If
  497.                 Case vbKeyE                                                                 '修改   Ctrl-E
  498.                     If .Buttons("Modi").Visible And .Buttons("Modi").Enabled Then
  499.                         Call SzToolbar_ButtonClick(.Buttons("Modi"))
  500.                     End If
  501.                 Case vbKeyS                                                                 '保存   Ctrl-S
  502.                     If .Buttons("Save").Visible And .Buttons("Save").Enabled Then
  503.                         Call SzToolbar_ButtonClick(.Buttons("Save"))
  504.                     End If
  505.                 Case vbKeyHome                                                              '首个   Ctrl-Home
  506.                     If .Buttons("First").Visible And .Buttons("First").Enabled Then
  507.                         Call SzToolbar_ButtonClick(.Buttons("First"))
  508.                     End If
  509.                 Case vbKeyPageUp                                                            '上个   Ctrl-PageUp
  510.                     If .Buttons("Previous").Visible And .Buttons("Previous").Enabled Then
  511.                         Call SzToolbar_ButtonClick(.Buttons("Previous"))
  512.                     End If
  513.                 Case vbKeyPageDown                                                          '下个   Ctrl-PageDown
  514.                     If .Buttons("Next").Visible And .Buttons("Next").Enabled Then
  515.                         Call SzToolbar_ButtonClick(.Buttons("Next"))
  516.                     End If
  517.                 Case vbKeyEnd                                                               '末尾   Ctrl-End
  518.                     If .Buttons("Last").Visible And .Buttons("Last").Enabled Then
  519.                         Call SzToolbar_ButtonClick(.Buttons("Last"))
  520.                     End If
  521.             End Select
  522.         End With
  523.     End If
  524.     If KeyCode = vbKeyEscape Then                                                       '取消   Escape
  525.         If SzToolbar.Buttons("Cancel").Visible And SzToolbar.Buttons("Cancel").Enabled Then
  526.             Call SzToolbar_ButtonClick(SzToolbar.Buttons("Cancel"))
  527.         End If
  528.     End If
  529.     If KeyCode = vbKeyDelete Then                                                       '删除   Delete
  530.         If SzToolbar.Buttons("Del").Visible And SzToolbar.Buttons("Del").Enabled Then
  531.             Call SzToolbar_ButtonClick(SzToolbar.Buttons("Del"))
  532.         End If
  533.     End If
  534. End Sub
  536. '=========================通用部分==================================
  537. Public Sub Form_Load()
  538. Dim i As Integer
  539. Dim tmpRs As New ADODB.Recordset
  540. '--------------------------两种调用共有----------------------------
  541.     ReportTitle = "人事基本信息"
  542.     XtReportCode = "Rs_EdArInfo"
  543.     ReserveIsOn = False
  544.     Call CreateCtrls(SysOwner)
  545.     ReserveIsOn = False
  546.     
  547. '--------------------------直接调用处理----------------------------
  548.     If FormOwner = "Self" Then
  549.         Me.Tag = "Init"
  550.         EmpID = 0
  551.         lID.Caption = EmpID
  552.         SwitchToolBar ("0")
  553.         SzToolbar.Buttons("First").Visible = False                  '首张
  554.         SzToolbar.Buttons("Previous").Visible = False               '上张
  555.         SzToolbar.Buttons("Next").Visible = False                   '下张
  556.         SzToolbar.Buttons("Last").Visible = False                   '末张
  557.         SzToolbar.Buttons("sp").Visible = False                     '分隔
  559.         Call SetTxtStatus(False, True, False, Lrzt)
  560.     End If
  561. '------------------------查询调用处理--------------------------------
  563.     If FormOwner = "Query" Then
  564.         lID.Caption = EmpID
  565.         lpId.Caption = lID.Caption
  566.         Xtfhcs = ""
  567.         Set QuerySet = Cw_DataEnvi.DataConnect.Execute(QuerySql)
  568.         QuerySet.Find "Rs_BasicInfo#EmpID  = " & EmpID
  569.       
  570.         Call SetTxtStatus(True, True, False, Lrzt)
  571.         LoadData (EmpID)
  572.         SwitchToolBar ("0")
  573.     End If
  574.     
  575. '-----------------------------其他-----------------------------------
  576.     If SysOwner = 1 Then
  577.         SzToolbar.Buttons("New").Visible = False
  578.         SzToolbar.Buttons("Del").Visible = False
  579.     End If
  580.     
  581.     Set tmpRs = Cw_DataEnvi.DataConnect.Execute("SELECT ItemParameter FROM Rs_OtherSet WHERE ItemName = 'ReserveID' ")
  582.     If Not tmpRs.EOF Then ReserveId = tmpRs.Fields("ItemParameter")
  584.     '编辑(新增、修改、删除)权限索引
  585.     Str_RightEdit = "Rs_Ed_EmpArInfo_Edit"
  586.     '档案权限
  587.     Str_RightCase = "Rs_Ed_EmpArInfo_archives"
  588. End Sub
  592. Private Sub Txt_RsItm_GotFocus(Index As Integer)
  593.     
  594. Dim i As Integer
  595.     If Lrzt = 0 Then
  596.         Exit Sub
  597.     End If
  598. '使文本框可见
  599.     Pi_move Txt_RsItm(Index)
  600. '首先隐藏失去焦点的帮助按钮
  601.     For i = 1 To Cmd_CommHlp.UBound
  602.         If Cmd_CommHlp(i).Visible = True Then
  603.             Cmd_CommHlp(i).Visible = False
  604.         End If
  605.     Next i
  606. '然后根据帮助按钮的有效与否，在得到焦点的文本框旁边显示帮助按钮
  607.     If (Cmd_CommHlp(Index).Tag = 1) Or (Cmd_CommHlp(Index).Tag = 2 And Lrzt = 2) Then Cmd_CommHlp(Index).Visible = True
  608. End Sub
  611. Private Sub Pic_Emp_DblClick()
  612. '调用通用打开文件对话框，选定文件
  613.     CommDlg_pic.ShowOpen
  614.     On Error GoTo errD
  615.     If Trim(CommDlg_pic.FileName) <> "" Then
  616.         Pic_Emp.Picture = LoadPicture(CommDlg_pic.FileName)
  617.         Pic_Emp.Tag = Trim(CommDlg_pic.FileName)
  618.     End If
  619. errD:
  620. End Sub
  622. Public Sub Txt_RsItm_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
  623.  '焦点移动处理          KeyCode=113 是 F2
  624.  Dim tmpRs As New ADODB.Recordset
  625.  Dim EmpNo As String
  626.     If KeyCode = 113 And Cmd_CommHlp(Index).Tag <> 0 Then
  627.         Cmd_CommHlp_Click (Index)
  628.     End If
  629.     
  630.     If KeyCode = 13 Then
  631.         If UCase(tFieldName(Index)) = "EMPNO" And Cmd_CommHlp(Index).Visible = True Then
  632.             EmpNo = Trim(Txt_RsItm(Index).Text)
  633.             EmpID = GetIdByNo(EmpNo)
  634.             If EmpID = 0 Then Call Xtxxts("该职工号无效!", 0, 1): Exit Sub
  635.             Call LoadData(EmpID)
  636.             Call SetTxtStatus(False, False, False, Lrzt)
  637.             Exit Sub
  638.         End If
  639.         SendKeys "{Tab}", True
  640.     End If
  641. End Sub
  645. Private Sub Txt_RsItm_KeyPress(Index As Integer, KeyAscii As Integer)
  646.     '判断输入的有效性
  647.     If KeyAscii = 39 Then KeyAscii = 0
  648.     Select Case tDataType(Index)
  649.            Case 2
  650.                Call InputFieldLimit(Txt_RsItm(Index), 7, KeyAscii)
  651.            Case 1
  652.                Call InputFieldLimit(Txt_RsItm(Index), 6, KeyAscii)
  653.            Case 5                                                   '控制数字型录入
  654.                Call InputFieldLimit(Txt_RsItm(Index), 5, KeyAscii)
  655.     End Select
  656. End Sub
  659. Private Sub Txt_RsItm_LostFocus(Index As Integer)
  660. '失去焦点时作有效判断
  661.     Call DataIsEffect(Index)
  662. End Sub
  665. Private Sub Pi_move(ob As Object)   '屏幕滚动
  666.     Dim i As Integer
  667.     Dim lPos As Long
  668.     For i = Me.VScBar.Min To Me.VScBar.Max
  669.         If ob.Top >= i * (Me.Height - 2000) And ob.Top <= (i + 1) * (Me.Height - 2000) Then
  670.             Exit For
  671.         End If
  672.     Next i
  673.     If i <= Me.VScBar.Max And i <> Me.VScBar Then
  674.         Me.VScBar.Value = i
  675.     End If
  676.     
  677. End Sub
  679. Private Sub Cmd_CommHlp_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  680.     H_MoveInt = Index
  681. End Sub
  684. Private Function SavePic2DB(ByVal rs As ADODB.Recordset, ByVal emp_id As String) As Boolean
  685. '把图片文件以字节形式存储进数据库
  686.   ' note: this requires the record to already exist - it will insert the
  687.   ' picture at the current position in the recordset
  688.   ' Returns true if success - false otherwise
  689.   Const BlockSize = 15000
  690.   
  691.   Dim ByteData() As Byte                                      '存储图片文件的字节数组
  692.   Dim SourceFile As Integer
  693.   Dim FileLength As Long
  694.   Dim Numblocks As Integer
  695.   Dim LeftOver As Long: Dim s As Integer
  696.  On Error GoTo Line1
  697.   
  698. With Pic_Emp
  699.   SourceFile = FreeFile
  700.   
  701.   '以二进制形式打开文件
  702.   Open .Tag For Binary Access Read As SourceFile
  703.   
  704.   '获得文件长度
  705.   FileLength = LOF(SourceFile)
  707.   If FileLength = 0 Then                                       '字节数为0，退出
  708.     Close SourceFile
  709.     SavePic2DB = False
  710.     Exit Function
  711.   Else
  712.     '首先分解图片为几块
  713.     Numblocks = FileLength  BlockSize
  714.     LeftOver = FileLength Mod BlockSize
  715.     ReDim ByteData(LeftOver)
  716.     
  717.     '读取文件到数组
  718.     Get SourceFile, , ByteData()
  719.     rs.Fields("Pic").AppendChunk ByteData()
  720.     ReDim ByteData(BlockSize)
  721.     For s = 1 To Numblocks
  722.       Get SourceFile, , ByteData()
  723.       rs.Fields("Pic").AppendChunk ByteData()
  724.     Next s
  725.     rs.Update
  726.     '存储成功，返回true
  727.     Close SourceFile
  728.     SavePic2DB = True
  729.   End If
  730.   
  731. End With
  732. Line1:
  733. End Function
  735. Public Function getPicture(strPicField As String, ByVal rs As ADODB.Recordset) As Boolean
  736. '从数据库读取图片，生成磁盘文件
  737.   Const BlockSize = 15000
  738.   Dim ByteData() As Byte                                            '以二进制形式存储图片的字节数组
  739.   Dim DestFileNum As Integer
  740.   Dim DiskFile As String
  741.   Dim FileLength As Long                                            '图片文件的长度
  742.   Dim Numblocks As Integer                                          '图片的块数
  743.   Dim LeftOver As Long                                              '剩余部分
  744.   Dim i As Integer
  745.  On Error GoTo Line1
  746.   
  747.   '删除已存在的图形文件
  748.   DiskFile = App.Path & "temp.bmp"
  749.   If Len(Dir$(DiskFile)) > 0 Then
  750.      Kill DiskFile
  751.   End If
  752.     
  753.   '把图片文件分解成几部分
  754.   DestFileNum = FreeFile
  755.   FileLength = rs.Fields(strPicField).ActualSize
  756.   Numblocks = FileLength  BlockSize
  757.   LeftOver = FileLength Mod BlockSize
  758.     
  759.   '打开文件，开始按块存入数据库
  760.   Open DiskFile For Binary As DestFileNum
  761.   rs.Move 0, adBookmarkCurrent
  762.   ByteData() = rs.Fields(strPicField).GetChunk(LeftOver)
  763.   Put DestFileNum, , ByteData()
  765.   For i = 1 To Numblocks
  766.       ByteData() = rs.Fields(strPicField).GetChunk(BlockSize)
  767.       Put DestFileNum, , ByteData()
  768.   Next i
  770.   Close DestFileNum
  772.   getPicture = True
  773. Line1:
  774. End Function
  778. Private Sub Cmd_CommHlp_Click(Index As Integer)
  779. '基本信息输入调用帮助，通用根据情况调用不同类型的帮助
  780.     Dim s As String
  781.     Dim i As Integer
  782. '    ------------------------工号选人----------------------------------------
  783.     If UCase(tFieldName(Index)) = "EMPNO" Then
  784.         SsqlHelp = "Emp"
  785.         Ed_EmpArInfoCorHlp.Show 1
  786.         If Trim(P_Code) <> "" Then
  787.             Txt_RsItm(Index).Text = P_Code
  788.             EmpID = Xtfhcs
  789.             Xtfhcs = ""
  790.             LoadData (EmpID)
  791.         Else
  792.             Exit Sub
  793.         End If
  794.         Call SetTxtStatus(False, False, False, Lrzt)
  795.         For i = 1 To Lbl_ItmName.UBound
  796.             If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus: Exit For
  797.         Next i
  798.         Exit Sub
  799.     End If
  800. '    ------------------------日期性帮助--------------------------------------
  801.     If tDataType(Index) = 7 Then
  802.        Xtfhcs = ""
  803.        XT_calendar.Show 1
  804.        If Xtfhcs <> "" Then
  805.         Txt_RsItm(Index).Text = Xtfhcs
  806.         Xtfhcs = ""
  807.        End If
  808.        Txt_RsItm(Index).SetFocus
  809.        Exit Sub
  810.     End If
  811. '   ---------------------------其他帮助------------------------------------
  812.     SsqlHelp = Str(tItmId(Index))
  813.     Ed_EmpArInfoCorHlp.Show 1
  814.     
  815.     If P_Name <> "" Then
  816.        Txt_RsItm(Index).Text = P_Name
  817.        tIsCode(2, Index) = P_Code
  818.        P_Name = ""
  819.        P_Code = ""
  820.     End If
  822.     If Txt_RsItm(Index).Enabled = True Then Txt_RsItm(Index).SetFocus
  823. End Sub
  825. Private Sub VScBar_Change()     '滚动条
  826.     If ScollBarIsEffect = True Then
  827.         Me.Pict.Top = -(Me.VScBar.Value * (Me.Height - 2000))
  828.     End If
  829.     
  830. End Sub
  833. '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  834. Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  835. '对工具条按钮的不同处理
  836. Dim i As Integer
  837. Select Case Button.Key
  838.         Case "PrinterSet"                                                               '打印设置
  839.             PrintSetFrm.Show 1
  840.         Case "Printer"                                                                  '打印
  841.             DY_DytsFrm.Show 1
  842.         Case "Preview"                                                                  '预览
  843.             Print_EmpInfo
  844.         Case "New"                                                                      '新增
  845.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  846.             If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  847.                 Exit Sub
  848.             End If
  849.             Call MF_New
  850.         Case "Modi"                                                                     '修改
  851.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  852.             If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  853.                 Exit Sub
  854.             End If
  855.             
  856.             Call MF_Modi
  857.         Case "Del"                                                                      '删除
  858.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  859.             If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  860.                 Exit Sub
  861.             End If
  862.             Call MF_Del
  863.         Case "Save"                                                                     '保存
  864.             Call MF_Save
  865.         Case "Cancel"                                                                   '取消
  866.             Call MF_Cancel
  867.         Case "Refresh"
  868.             
  869.         Case "First"                                                                    '首个
  870.             Move_Cursor (Button.Key)
  871.         Case "Previous"                                                                 '上一个
  872.             Move_Cursor (Button.Key)
  873.         Case "Next"                                                                     '下一个
  874.             Move_Cursor (Button.Key)
  875.         Case "Last"                                                                     '末尾
  876.             Move_Cursor (Button.Key)
  877.         Case "Set"                                                                      '设定
  878.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  879.             If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  880.                 Exit Sub
  881.             End If
  882.             Ed_EmpArInfoSetFrm.Show 1
  883.             Call SetReserve
  884.         Case "Help"                                                                     '帮助
  885.             Call F1bz
  886.         Case "Exit"                                                                     '退出
  887.             Unload Me
  888. End Select
  890. Exit Sub
  891. Err_Del:
  892. End Sub
  895. '========================自定义过程=================================
  897. Private Function MF_New() As Boolean
  898. '供工具条按钮调用的函数（新增记录），成功返回真，否则假
  899. MF_New = False
  900. On Error GoTo errD
  901.     Lrzt = 1
  902.     EmpID = 0
  903.     SwitchToolBar ("1")
  904.     Call SetTxtStatus(True, False, False, Lrzt)
  905.     ReserveItmRefurbish
  906.     With Me.Txt_RsItm(1)
  907.         If .Enabled And .Visible Then
  908.             .SetFocus
  909.         End If
  910.     End With
  911. MF_New = True
  912. errD:
  913. End Function
  915. Private Function MF_Del() As Boolean
  916. '供工具条按钮调用的函数（删除记录），成功返回真，否则假
  917. MF_Del = False
  918. On Error GoTo errD
  919.     If Not DelArRec(EmpID) Then Exit Function
  920.     Lrzt = 0
  921.     If UCase(FormOwner) = "SELF" Then
  922.         Call SetTxtStatus(True, True, False, Lrzt)
  923.     Else
  924.         lID.Caption = lpId.Caption
  925.         EmpID = lID.Caption
  926.         LoadData (EmpID)
  927.         Call SetTxtStatus(False, True, False, Lrzt)
  928.         If QuerySet.State = 1 Then QuerySet.Close
  929.         Set QuerySet = Cw_DataEnvi.DataConnect.Execute(QuerySql)
  930.         QuerySet.Find "Rs_BasicInfo#EmpID  = " & EmpID
  931.         Qr_RsBasicFrm.BeenModify = True
  932.     End If
  933. MF_Del = True
  934. errD:
  935. End Function
  937. Private Function MF_Modi() As Boolean
  938. '供工具条按钮调用的函数（删除记录），成功返回真，否则假
  939. Dim i As Integer
  940. MF_Modi = False
  942. On Error GoTo errD
  943.     Lrzt = 2
  944.     SwitchToolBar (Lrzt)
  945.     If UCase(FormOwner) = "SELF" Then                                            '窗体是自己打开的
  946.         Call SetTxtStatus(False, True, True, Lrzt)
  947.     Else                                                                         '窗体是经过查询结果调用生成的
  948.         Call SetTxtStatus(False, False, False, Lrzt)
  949.     End If
  951.     For i = 1 To Lbl_ItmName.UBound
  952.         If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus: Exit For
  953.     Next i
  955. MF_Modi = True
  956. Exit Function
  958. errD:
  959. End Function
  962. Private Function MF_Cancel() As Boolean
  963. '供工具条按钮调用的函数（取消动作处理），成功返回真，否则假
  964. MF_Cancel = False
  965. On Error GoTo errD
  966.     If UCase(FormOwner) = "SELF" Then                                           '窗体是自己打开的
  967.         EmpID = 0
  968.         SwitchToolBar (0)
  969.         Call SetTxtStatus(True, True, False, Lrzt)
  970.     Else                                                                        '窗体是经过查询结果调用生成的
  971.         If Lrzt = 1 Then                                                        '从增加状态返回
  972.             SwitchToolBar (0)
  973.             EmpID = lID.Caption
  974.             LoadData (EmpID)
  975.             Call SetTxtStatus(False, True, False, Lrzt)
  976.         End If
  977.         If Lrzt = 2 Then                                                        '从修改状态返回
  978.             SwitchToolBar (0)
  979.             Call SetTxtStatus(False, True, False, Lrzt)
  980.         End If
  981.     End If
  982.     Lrzt = 0
  983. MF_Cancel = True
  984. errD:
  985. End Function
  987. Private Function MF_Save() As Boolean
  988. '供工具条按钮调用的函数（保存记录），成功返回真，否则假
  989. MF_Save = False
  990. On Error GoTo errD
  991.     If Lrzt = 2 And EmpID = 0 Then Exit Function                                     '修改并且还没有选人的时候
  992.     If DataIsEffect(0) Then Call Save
  993.     If Saved Then
  994.         Call Xtxxts("保存成功!", 0, 4)
  995.         SwitchToolBar (0)
  996.         lpId.Caption = lID.Caption
  997.         lID.Caption = EmpID
  998.         Call SetTxtStatus(False, True, False, Lrzt)
  999.         Lrzt = 0
  1000. '         如果是查询模式，要刷新记录集a
  1001.         If FormOwner = "Query" Then
  1002.             If QuerySet.State = 1 Then QuerySet.Close
  1003.             Set QuerySet = Cw_DataEnvi.DataConnect.Execute(QuerySql)
  1004.             QuerySet.Find "Rs_BasicInfo#EmpID  = " & EmpID
  1005.             Qr_RsBasicFrm.BeenModify = True
  1006.         End If
  1007.         Saved = False
  1008.         MF_Save = True
  1009.     Else
  1010.         Call Xtxxts("保存失败!", 0, 1)
  1011.     End If
  1012. errD:
  1013. End Function
  1017. Private Function CorHlpIsEffect(sItmID As String, StrText As String) As Boolean
  1018. '校验相关项填写的正确性
  1019. '参数说明:sItmID是项目编号，StrText是要校验的内容，可以是编码或是对应条目
  1021. Dim RsRec As New Recordset
  1022. Dim sSql As String
  1023. Dim RsItm As New Recordset
  1024.     
  1025.     CorHlpIsEffect = False
  1026.     '选取文本框对应的人事项目，得到相关项的信息
  1027.     Set RsItm = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM Rs_Items WHERE itemId=" & sItmID)
  1028.     If Not IsNumeric(Trim(StrText)) Then                                                 '对数字型的相关明细代号                                               '相关项当对应文本框输入编码的情况
  1029.         If Trim(RsItm!CorTable) = "Rs_CorSub" Then                                       '首先根据项目名进行查询
  1030.             sSql = "SELECT * FROM Rs_CorMain m,Rs_CorSub s WHERE " _
  1031.                    & "m.SortId=s.SortId AND m.SortId='" & Trim(RsItm!Correlation) & "' AND listname='" & Trim(StrText) & "'"
  1032.         Else
  1033.             If UCase(Trim(RsItm!CorTable)) <> "GY_DEPARTMENT" Then
  1034.                 sSql = "SELECT * FROM " & RsItm!CorTable & " WHERE " & RsItm!IndexName & "='" & Trim(StrText) & "'"
  1035.             Else
  1036.                 sSql = "SELECT * FROM " & RsItm!CorTable & " WHERE " & RsItm!IndexName & " like '" & Trim(StrText) & "'"
  1037.             End If
  1038.         End If
  1039.     Else                                                                                 '相关项当文本框输入编码对应文本的情况
  1040.         If Trim(RsItm!CorTable) = "Rs_CorSub" Then
  1041.             sSql = "SELECT * FROM Rs_CorMain m,Rs_CorSub s WHERE " _
  1042.                & "m.SortId=s.SortId AND m.SortId='" & Trim(RsItm!Correlation) & "' AND convert(int,(right(convert(varchar(12),listid),3)))='" & Trim(StrText) & "'"
  1043.         Else
  1044.             If UCase(Trim(RsItm!CorTable)) <> "GY_DEPARTMENT" Then
  1045.                 sSql = "SELECT * FROM " & Trim(RsItm!CorTable) & " WHERE " & RsItm!IndexCode & "='" & Trim(StrText) & "'"
  1046.             Else
  1047.                 sSql = "SELECT * FROM " & Trim(RsItm!CorTable) & " WHERE " & RsItm!IndexCode & " like '" & Trim(StrText) & "%'"
  1048.             End If
  1049.         End If
  1050.     End If
  1051.         
  1052.     Set RsRec = Cw_DataEnvi.DataConnect.Execute(sSql)
  1053.     If UCase(Trim(RsItm!CorTable)) = "GY_DEPARTMENT" Then                                     '部门组织的相关帮助必须录入末级节点，所以 >1是不可以的
  1054.         If RsRec.RecordCount = 1 Then CorHlpIsEffect = True
  1055.     Else
  1056.         If RsRec.RecordCount > 0 Then CorHlpIsEffect = True
  1057.     End If
  1058.     If CorHlpIsEffect Then                                                               '找到相关项时
  1059.         If Trim(RsItm!CorTable) = "Rs_CorSub" Then                                       '标准情况：相关项存在Rs_CorSub里
  1060.             P_Name = RsRec!ListName
  1061.             P_Code = RsRec!ListID
  1062.         Else                                                                             '相关项存在其他表里
  1063.             P_Name = Trim(RsRec(Trim(RsItm!IndexName)))
  1064.             P_Code = RsRec(Trim(RsItm!IndexCode))
  1065.         End If
  1066.     End If
  1067.     
  1068.     If RsItm.State = 1 Then
  1069.         RsItm.Close
  1070.         Set RsItm = Nothing
  1071.     End If
  1072.     '关闭记录集，退出
  1073.     RsRec.Close
  1074. Exit Function
  1076. End Function
  1078. Private Function DataIsEffect(Index As Integer) As Boolean
  1079. '有效性判定,控制较松，除工号，姓名，部门以外其他都可以不录
  1080. 'index 表示需要做有效性校验的对象序号，如果index=0 则表示对所有的文本框做有效性校验
  1081.     Dim i As Integer
  1082.     Dim Tsxx As String
  1083.     DataIsEffect = False
  1084.     
  1085. '文本框有效性判定
  1086. If Index = 0 Then                                                              '对所有文本框进行校验
  1087.     For i = 1 To Lbl_ItmName.UBound
  1088.         If UCase(tFieldName(i)) = "EMPNO" And (Trim(Txt_RsItm(i).Text) = "") Then
  1089.             Call Xtxxts("职工号不能为空!", 0, 1)
  1090.             If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus
  1091.             Exit Function
  1092.         End If
  1093.                 
  1094.         If Lrzt = 1 Then
  1095.             If UCase(tFieldName(i)) = "EMPNO" And GetIdByNo(Trim(Txt_RsItm(i).Text)) <> 0 Then
  1096.                 Call Xtxxts("职工号重复!", 0, 1): Exit Function
  1097.             End If
  1098.         End If
  1099.         
  1100.         If UCase(tFieldName(i)) = "EMPNAME" And (Trim(Txt_RsItm(i).Text) = "") Then
  1101.             Call Xtxxts("职工姓名不能为空!", 0, 1)
  1102.             If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus
  1103.             Exit Function
  1104.         End If
  1105.                 
  1106.         If UCase(tFieldName(i)) = "DEPTCODE" And Trim(Txt_RsItm(i).Text) = "" Then
  1107.             Call Xtxxts("部门不能为空!", 0, 1)
  1108.             If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus
  1109.             Exit Function
  1110.         End If
  1111.         
  1112.         If tDataType(i) = 7 And Trim(Txt_RsItm(i).Text) <> "" Then
  1113.             If IsDate(Txt_RsItm(i)) = False Then
  1114.                 Call Xtxxts("非法日期格式! ——" & Format(Date, "yyyy-mm-dd"), 0, 1)
  1115.                 If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus
  1116.                 Exit Function
  1117.             End If
  1118.         End If
  1119.         
  1120.         If tDataType(i) = 5 And Trim(Txt_RsItm(i).Text) <> "" Then
  1121.             If IsNumeric(Txt_RsItm(i)) = False Then
  1122.                 Call Xtxxts("录入数据不是数字!", 0, 1)
  1123.                 If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus
  1124.                 Exit Function
  1125.             End If
  1126.         End If
  1127.         
  1128.         If tIsCode(1, i) = 1 Then                                                '对编码型的数据只要不为空，就要检测有效性
  1129.             If tDataType(i) <> 7 Then
  1130.                 If Trim(Txt_RsItm(i).Text) <> "" Then
  1131.                     If CorHlpIsEffect(Str(tItmId(i)), Trim(Txt_RsItm(i).Text)) = True Then
  1132.                         Txt_RsItm(i).Text = Trim(P_Name)
  1133.                         tIsCode(2, i) = Trim(P_Code)
  1134.                     Else
  1135.                         Call Xtxxts("非法录入,没有此" & Lbl_ItmName(Index).Caption, 0, 1)
  1136.                         If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus
  1137.                         Exit Function
  1138.                     End If
  1139.                 Else
  1140.                     tIsCode(2, i) = ""
  1141.                 End If
  1142.             End If
  1143.         End If
  1144.      Next i
  1145.      
  1146. Else                                                                                '只对txt_RsItm(index)校验
  1147.     If Cmd_CommHlp(Index).Tag = 1 Then                                              ' 备注： 除此以外 还要针对职工号检查
  1148.         If tDataType(Index) = 7 And Trim(Txt_RsItm(Index).Text) <> "" Then
  1149.             If IsDate(Txt_RsItm(Index)) = False Then
  1150.                 Call Xtxxts("非法日期格式! ——" & Format(Date, "yyyy-mm-dd"), 0, 1)
  1151.                 If Txt_RsItm(Index).Enabled Then Txt_RsItm(Index).SetFocus
  1152.                 Exit Function
  1153.             End If
  1154.         End If
  1155.         If tIsCode(1, Index) = 1 Then                                                '对编码型的数据只要不为空，就要检测有效性
  1156.             If tDataType(Index) <> 7 Then
  1157.                 If Trim(Txt_RsItm(Index).Text) <> "" Then
  1158.                     If CorHlpIsEffect(Str(tItmId(Index)), Trim(Txt_RsItm(Index).Text)) = True Then
  1159.                         Txt_RsItm(Index).Text = Trim(P_Name)
  1160.                         tIsCode(2, Index) = Trim(P_Code)
  1161.                     Else
  1162.                         Tsxx = "非法录入,没有此" & Lbl_ItmName(Index).Caption
  1163.                         If UCase(Trim(tFieldName(Index))) = "DEPTCODE" Then Tsxx = Tsxx + "或者录入的不是末级节点!"
  1164.                         Call Xtxxts(Tsxx, 0, 1)
  1165.                         If Txt_RsItm(Index).Enabled Then Txt_RsItm(Index).Text = "": Txt_RsItm(Index).SetFocus
  1166.                         Exit Function
  1167.                     End If
  1168.                 Else
  1169.                     tIsCode(2, i) = ""
  1170.                 End If
  1171.             End If
  1172.         End If
  1173.     End If
  1175.     End If
  1176.     DataIsEffect = True
  1177.     
  1178. End Function
  1180. Private Function SetReserve() As Boolean
  1181. Dim tmpRs As New ADODB.Recordset
  1182. Dim i As Integer
  1183.     Set tmpRs = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM Rs_Items WHERE (SID='1' AND YNShow='1') ORDER BY Tab")
  1184.     ReDim Preserve tReserved(tmpRs.RecordCount)
  1185.     i = 1
  1186.     While Not tmpRs.EOF
  1187.         If IsNull(tmpRs.Fields("YNReserve")) Or tmpRs.Fields("YNReserve") = False Then tReserved(i) = False
  1188.         If tmpRs.Fields("YNReserve") = True Then tReserved(i) = True
  1189.         tmpRs.MoveNext
  1190.         i = i + 1
  1191.     Wend
  1192. End Function
  1195. Private Function DelArRec(emp_id As Integer) As Boolean
  1196. '删除人事档案基本信息，如果删除成功返回真，否则返回假
  1198. Dim yn As String
  1199.     DelArRec = False
  1200.     If EmpID = 0 Then Exit Function
  1201.     yn = Xtxxts("真的要删除此档案？ ", 2, 2)
  1202.     If yn = vbCancel Then Exit Function
  1204.     On Error GoTo Err_Del
  1205.         Cw_DataEnvi.DataConnect.BeginTrans
  1206.         '自定义
  1207.             Cw_DataEnvi.DataConnect.Execute "DELETE Rs_ExtendInfo WHERE EmpID=" & EmpID
  1208.             Cw_DataEnvi.DataConnect.Execute "DELETE Rs_BasicInfo WHERE EmpID=" & EmpID
  1209.         
  1210.         Cw_DataEnvi.DataConnect.CommitTrans
  1211.     EmpID = 0
  1212.     DelArRec = True
  1213.     Exit Function
  1215. Err_Del:
  1216.     Cw_DataEnvi.DataConnect.CommitTrans
  1217.     If Err.Number = -2147217873 Then                '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
  1218.         Call Xtxxts("该人员档案已经被使用,不能删除!", 0, 1)
  1219.         Exit Function
  1220.     Else
  1221.         Call Xtxxts("出现未知情况,该人员档案不能被删除!", 0, 1)
  1222.         Exit Function
  1223.     End If
  1224. End Function
  1227. Private Sub Save()              '保存数据
  1228. Dim i As Integer
  1229. Dim EmpNo As String             '职工号
  1230. Dim Ssql1 As String             '对应非固定项（Rs_ExtendInfo中的字段）的名称（FieldName）
  1231. Dim Ssql2 As String             '对应非固定项（Rs_ExtendInfo中的字段）的值
  1232. Dim Ssql3 As String             '对应固定项（Rs_BasicInfo中的字段）的名称（FieldName）
  1233. Dim Ssql4 As String             '对应固定项（Rs_BasicInfo中的字段）的值
  1234. Dim SsqlR As String             '专门针对保留项目的查询语句
  1235. Dim tmpRs As New Recordset: Dim MAXID_Z As Integer
  1237. Saved = False
  1239. If Lbl_ItmName.Count < 2 Then Call Xtxxts("没有项目!", 0, 1): Exit Sub
  1241. EmpNo = Trim(Txt_RsItm(1).Text)                                                       '工号
  1242. For i = 1 To Lbl_ItmName.UBound
  1243.     If tFixed(i) = True Then                                                             '首先整理固定字段 Rs_BasicInfo,将字段名和值的sql语句拼好
  1244.         If Lrzt = 1 Then                                                              '增加
  1245.             Ssql3 = Ssql3 & tFieldName(i) & ","
  1246.             If tIsCode(1, i) = 1 Then                                                 '是编码型的就存编码，否则存名称，这里的数组的初值是根据有无相关项决定的
  1247.                 Ssql4 = Ssql4 & "'" & tIsCode(2, i) & "',"
  1248.             Else
  1249.                 Select Case tDataType(i)
  1250.                     Case 7
  1251.                         If Trim(Txt_RsItm(i).Text) = "" Then
  1252.                            '没填的日期型字段存NULL
  1253.                             Ssql4 = Ssql4 & "null,"
  1254.                         Else
  1255.                             Ssql4 = Ssql4 & "'" & Format(Trim(Txt_RsItm(i).Text), "yyyy-mm-dd") & "',"
  1256.                         End If
  1257.                     Case 5
  1258.                         If Trim(Txt_RsItm(i).Text) = "" Then
  1259.                             '没填的数字型字段存0
  1260.                             Ssql4 = Ssql4 & "0,"
  1261.                         Else
  1262.                             Ssql4 = Ssql4 & Trim(Txt_RsItm(i).Text) & ","
  1263.                         End If
  1264.                     Case Else
  1265.                         If UCase(tFieldName(i)) = "YNSTOP" Then
  1266.                             Ssql4 = Ssql4 & "'" & Chk_YNStop.Value & "',"
  1267.                         Else
  1268.                             Ssql4 = Ssql4 & "'" & Trim(Txt_RsItm(i).Text) & "',"
  1269.                         End If
  1270.                     End Select
  1271.             End If
  1272.         Else                                                    '修改
  1273.             If tIsCode(1, i) = 1 Then
  1274.                 Ssql3 = Ssql3 & tFieldName(i) & "='" & tIsCode(2, i) & "',"
  1275.             Else
  1276.                 Select Case tDataType(i)
  1277.                     Case 7
  1278.                         If Trim(Txt_RsItm(i).Text) = "" Then
  1279.                             '没填的日期型字段存NULL
  1280.                             Ssql3 = Ssql3 & tFieldName(i) & "= null,"
  1281.                         Else
  1282.                             Ssql3 = Ssql3 & tFieldName(i) & "='" & Format(Trim(Txt_RsItm(i).Text), "yyyy-mm-dd") & "',"
  1283.                         End If
  1284.                     Case 5
  1285.                         If Trim(Txt_RsItm(i).Text) = "" Then
  1286.                             '没填的数字型字段存0
  1287.                             Ssql3 = Ssql3 & tFieldName(i) & "= 0,"
  1288.                         Else
  1289.                             Ssql3 = Ssql3 & tFieldName(i) & "=" & Trim(Txt_RsItm(i).Text) & ","
  1290.                         End If
  1291.                     Case Else
  1292.                         If UCase(tFieldName(i)) = "YNSTOP" Then
  1293.                             Ssql3 = Ssql3 & tFieldName(i) & "='" & Chk_YNStop.Value & "',"
  1294.                         Else
  1295.                             Ssql3 = Ssql3 & tFieldName(i) & "='" & Trim(Txt_RsItm(i).Text) & "',"
  1296.                         End If
  1297.                 End Select
  1298.                 
  1299.             End If
  1300.         End If
  1301.     Else
  1302.     '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  1303. '然后整理非固定字段 Rs_ExtendInfo,将字段名和值的sql语句拼好
  1304.         If Lrzt = 1 Then                                                               '新增状态的sql
  1305.             Ssql1 = Ssql1 & tFieldName(i) & ","
  1306.             If tIsCode(1, i) = 1 Then                                                  '编码
  1307.                 Ssql2 = Ssql2 & "'" & tIsCode(2, i) & "',"
  1308.             Else                                                                       '非编码
  1309.                 Select Case tDataType(i)
  1310.                     Case 7
  1311.                         If Trim(Txt_RsItm(i).Text) = "" Then
  1312.                             '没填的日期型字段存NULL
  1313.                             Ssql2 = Ssql2 & " null,"
  1314.                         Else
  1315.                             Ssql2 = Ssql2 & "'" & Format(Trim(Txt_RsItm(i).Text), "yyyy-mm-dd") & "',"
  1316.                         End If
  1317.                     Case 5
  1318.                         If Trim(Txt_RsItm(i).Text) = "" Then
  1319.                             '没填的数字型字段存0
  1320.                             Ssql2 = Ssql2 & " 0,"
  1321.                         Else
  1322.                             Ssql2 = Ssql2 & Trim(Txt_RsItm(i).Text) & ","
  1323.                         End If
  1324.                     Case Else
  1325.                         Ssql2 = Ssql2 & "'" & Trim(Txt_RsItm(i).Text) & "',"
  1326.                 End Select
  1327.                     
  1328.             End If
  1329.         Else                                                                           '修改状态的sql
  1330.             If tIsCode(1, i) = 1 Then                                                  '编码
  1331.                 Ssql1 = Ssql1 & tFieldName(i) & "='" & tIsCode(2, i) & "',"
  1332.             Else                                                                       '非编码
  1333.                 Select Case tDataType(i)
  1334.                     Case 7
  1335.                         If Trim(Txt_RsItm(i).Text) = "" Then
  1336.                             '没填的日期型字段存NULL
  1337.                             Ssql1 = Ssql1 & tFieldName(i) & "= null, "
  1338.                         Else
  1339.                             Ssql1 = Ssql1 & tFieldName(i) & "='" & Format(Trim(Txt_RsItm(i).Text), "yyyy-mm-dd") & "',"
  1340.                         End If
  1341.                     Case 5
  1342.                         If Trim(Txt_RsItm(i).Text) = "" Then
  1343.                             '没填的数字型字段存0
  1344.                             Ssql1 = Ssql1 & tFieldName(i) & "= 0, "
  1345.                         Else
  1346.                             Ssql1 = Ssql1 & tFieldName(i) & "=" & Trim(Txt_RsItm(i).Text) & ","
  1347.                         End If
  1348.                     Case Else
  1349.                         Ssql1 = Ssql1 & tFieldName(i) & "='" & Trim(Txt_RsItm(i).Text) & "',"
  1350.                 End Select
  1351.             End If
  1352.         End If
  1353.     End If
  1354. Next i
  1355.     
  1357. On Error GoTo Quit_Err
  1359.     '去掉最后的逗号
  1360.     If Trim(Ssql1) <> "" Then Ssql1 = Mid(Trim(Ssql1), 1, Len(Trim(Ssql1)) - 1)
  1361.     If Trim(Ssql3) <> "" Then Ssql3 = Mid(Trim(Ssql3), 1, Len(Trim(Ssql3)) - 1)
  1362.     
  1363.     Cw_DataEnvi.DataConnect.BeginTrans
  1365.     If Lrzt = 1 Then
  1366.         '新增记录
  1367.         Set tmpRs = Cw_DataEnvi.DataConnect.Execute("SELECT MAXID=MAX(EmpID) from Rs_BasicInfo")
  1368.         MAXID_Z = Val("" & tmpRs!maxid) + 1
  1369.         EmpID = MAXID_Z
  1370.         If Trim(Ssql1) <> "" Then
  1371.             Ssql1 = "INSERT INTO  Rs_ExtendInfo( EmpID," & Ssql1 & ") VALUES ( " & MAXID_Z & "," & Mid(Ssql2, 1, Len(Ssql2) - 1) & ")"
  1372.         Else
  1373.             Ssql1 = "INSERT INTO Rs_ExtendInfo( EmpID) VALUES ( " & MAXID_Z & ")"
  1374.         End If
  1375.         
  1376.         Ssql3 = "INSERT INTO Rs_BasicInfo( EmpID," & Ssql3 & ") VALUES( " & MAXID_Z & "," & Mid(Ssql4, 1, Len(Ssql4) - 1) & ") "
  1377.         tmpRs.Close
  1378.     Else
  1379.         '修改记录
  1380.         Ssql3 = "UPDATE Rs_BasicInfo SET " & Ssql3 & " WHERE EmpID=" & EmpID
  1381.         
  1382.         If Trim(Ssql1) <> "" Then
  1383.             Ssql1 = "UPDATE Rs_ExtendInfo SET " & Ssql1 & " WHERE EmpID=" & EmpID
  1384.             
  1385.         End If
  1386.     End If
  1388.     Cw_DataEnvi.DataConnect.Execute Ssql3
  1389.     
  1390.     If Trim(Ssql1) <> "" Then Cw_DataEnvi.DataConnect.Execute Ssql1
  1391.     
  1392. '   设置辅助保留项目
  1393.     SsqlR = "UPDATE Rs_OtherSet SET ItemParameter = '" & EmpID & "' WHERE ItemName= 'ReserveID'"
  1394.     Cw_DataEnvi.DataConnect.Execute SsqlR
  1395.     
  1396. '存储图片
  1398.     If Trim(Pic_Emp.Tag) <> "" Then
  1399.             Cw_DataEnvi.DataConnect.Execute ("UPDATE Rs_BasicInfo SET pic = Null WHERE EmpId = '" & EmpID & "'")
  1400.             Dim map As New ADODB.Recordset
  1401.             map.Open "SELECT * FROM Rs_BasicInfo WHERE EmpId='" & EmpID & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic
  1402.             SavePic2DB map, EmpID
  1403.             map.Close
  1404.     End If
  1405.       
  1406.     Cw_DataEnvi.DataConnect.CommitTrans
  1407.     
  1408.     Saved = True
  1409. Exit Sub
  1411. Quit_Err:
  1412.     Saved = False
  1413. End Sub
  1417. Private Function GetIdByNo(emp_No As String) As Integer
  1418. '根据职工号获取id的函数,未停用的
  1419. Dim tmpDataRs As New ADODB.Recordset
  1420. Dim tmpStr As String
  1422. GetIdByNo = 0
  1423. tmpStr = "SELECT EmpId FROM Rs_BasicInfo WHERE empNo = '" & Trim(emp_No) & "' AND YNStop = 0"
  1424. Set tmpDataRs = Cw_DataEnvi.DataConnect.Execute(tmpStr)
  1425. If Not tmpDataRs.EOF Then
  1426.     GetIdByNo = tmpDataRs.Fields("EmpId")
  1427. End If
  1428. Set tmpDataRs = Nothing
  1429. End Function
  1431. Private Function LoadData(emp_id As Integer) As Boolean
  1432. '取出数据填充文本框
  1433. Dim tmpDataRs As New ADODB.Recordset
  1434. Dim tmpStr As String
  1435. Dim i As Integer
  1437. LoadData = True
  1438. On Error GoTo ErrDeal
  1439. '打开记录集，获得数据
  1440. tmpStr = Item_Info(SysOwner) & " where b.EmpId=" & emp_id & " and b.EmpId=e.EmpId"
  1441. Set tmpDataRs = Cw_DataEnvi.DataConnect.Execute(tmpStr)
  1443. If tmpDataRs.EOF Then LoadData = False: Exit Function
  1445. '--清空文本框和图片栏
  1446.     For i = 1 To Lbl_ItmName.UBound
  1447.         Txt_RsItm(i).Text = ""
  1448.     Next i
  1449.     Chk_YNStop.Value = 0
  1451.     Pic_Emp.Picture = LoadPicture("")
  1452.     Pic_Emp.Tag = ""
  1454. '--填充文本框
  1455. For i = 1 To Lbl_ItmName.Count - 1
  1456.     
  1457.     If tIsCode(1, i) = 1 Then                                                                       '编码型的显示编码对应的值
  1458.         Txt_RsItm(i).Text = Trim("" & tmpDataRs.Fields("N_" + tFieldName(i)))
  1459.         tIsCode(2, i) = "" & tmpDataRs.Fields(tFieldName(i))
  1460.     Else                                                                                            '非编码的直接显示
  1461.         Txt_RsItm(i).Text = Trim("" & tmpDataRs.Fields(tFieldName(i)))
  1462.         If tDataType(i) = 7 And Not IsNull(tmpDataRs.Fields(tFieldName(i))) Then Txt_RsItm(i).Text = Format(tmpDataRs.Fields(tFieldName(i)), "yyyy-mm-dd")
  1463.         If UCase(tFieldName(i)) = "YNSTOP" Then                                                     '对停用复选框单独处理
  1464.             If tmpDataRs.Fields(tFieldName(i)) Then
  1465.                 Chk_YNStop.Value = 1
  1466.             Else
  1467.                 Chk_YNStop.Value = 0
  1468.             End If
  1469.         End If
  1470.     End If
  1471. Next
  1473. '--填充图片内容
  1474. Set tmpDataRs = Cw_DataEnvi.DataConnect.Execute("SELECT Pic FROM Rs_BasicInfo WHERE EmpId = '" & EmpID & "'")
  1475. If Not tmpDataRs.EOF Then
  1476.     If tmpDataRs.Fields("Pic").ActualSize = 0 Then Exit Function
  1477.     Call getPicture("Pic", tmpDataRs)
  1478.     Pic_Emp.Picture = LoadPicture(App.Path & "temp.bmp")
  1479. End If
  1480. Set tmpDataRs = Nothing
  1482. Exit Function
  1483. ErrDeal:
  1484. LoadData = False
  1486. End Function
  1489. Private Function SetTxtStatus(aClear As Boolean, aLock As Boolean, modi As Boolean, aLrzt As Integer) As Boolean
  1490. '根据需要设置文本框的状态，aClear 清空文本框，aLock 锁定文本框, modi 针对修改时工号帮助的锁定
  1491. Dim i As Integer
  1493. SetTxtStatus = True
  1494. On Error GoTo ErrDeal
  1495. If aClear Then                                                      '对文本框清空的处理
  1496.     For i = 1 To Lbl_ItmName.UBound
  1497.         Txt_RsItm(i).Text = ""
  1498.         tIsCode(2, i) = ""                                          '对应的编码也清掉
  1499.     Next i
  1500.     Chk_YNStop.Value = 0
  1501.     Pic_Emp.Picture = LoadPicture("")
  1502.     Pic_Emp.Tag = ""
  1503. End If
  1505. If aLock Then                                                       '对文本框锁定的处理
  1506.     For i = 1 To Lbl_ItmName.UBound
  1507.         Txt_RsItm(i).Enabled = False
  1508.         Cmd_CommHlp(i).Visible = False
  1509.     Next i
  1510.     Chk_YNStop.Enabled = False
  1511.     Pic_Emp.Enabled = False
  1512. Else                                                                '解锁
  1513.     For i = 1 To Lbl_ItmName.UBound
  1514.         Txt_RsItm(i).Enabled = True
  1515.     Next i
  1516.     Chk_YNStop.Enabled = True
  1517.     Pic_Emp.Enabled = True
  1518. End If
  1520. If aLrzt = 1 Then Exit Function                                     '对新增状态不需要对工号文本框单独关照
  1522. If modi Then
  1523.     For i = 1 To Lbl_ItmName.UBound
  1524.         Txt_RsItm(i).Enabled = False
  1525.         If UCase(tFieldName(i)) = "EMPNO" Then
  1526.             Txt_RsItm(i).Enabled = True
  1527.             Cmd_CommHlp(i).Visible = True
  1528.             Cmd_CommHlp(i).Enabled = True
  1529.             Exit For
  1530.         End If
  1531.     Next i
  1532. Else
  1533.     For i = 1 To Lbl_ItmName.UBound
  1534.         If UCase(tFieldName(i)) = "EMPNO" Then
  1535.             Txt_RsItm(i).Enabled = False
  1536.             Cmd_CommHlp(i).Visible = False
  1537.             Cmd_CommHlp(i).Enabled = False
  1538.             
  1539.             Exit For
  1540.         End If
  1541.     Next i
  1542. End If
  1543. '如果是工资系统，则有部分文本框被锁定
  1545. For i = 1 To Lbl_ItmName.UBound
  1546.     If SysOwner = 1 And tSysROnly(i) = True And UCase(tFieldName(i)) <> "EMPNO" Then
  1547.         Txt_RsItm(i).Enabled = False
  1548.     End If
  1549. Next i
  1551. If SysOwner = 1 Then Pic_Emp.Enabled = False
  1553. Exit Function
  1556. ErrDeal:
  1557. SetTxtStatus = False
  1558. End Function
  1561. Private Sub Move_Cursor(Direct As String)
  1562. '参数：设置游标的移动方向，用4个单词来识别
  1563. Dim i As Integer
  1564.     
  1565.     With QuerySet
  1566.     If .RecordCount = 0 Then Exit Sub
  1567.     Select Case UCase(Trim(Direct))
  1568.         Case "FIRST"
  1569.             .MoveFirst
  1570.         Case "PREVIOUS"
  1571.             .MovePrevious
  1572.             If .BOF Then
  1573.                 .MoveFirst
  1574.                 Exit Sub
  1575.             End If
  1577.         Case "NEXT"
  1578.             .MoveNext
  1579.             If .EOF Then
  1580.                 .MoveLast
  1581.                 Exit Sub
  1582.             End If
  1583.         Case "LAST"
  1584.             .MoveLast
  1585.     End Select
  1586.     EmpID = .Fields("Rs_BasicInfo#EmpID")
  1587.     lpId.Caption = lID.Caption
  1588.     lID.Caption = EmpID
  1589.     Call LoadData(EmpID)
  1590.     Call SetTxtStatus(False, True, False, Lrzt)
  1591.     
  1592. End With
  1593. End Sub
  1596. Private Sub SwitchToolBar(Status As Integer)
  1597. '设置工具栏状态  0.非编辑状态  1.编辑状态(新增) 2.编辑状态(修改)
  1598. With SzToolbar
  1599. Select Case Status
  1600.     Case 0:             '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
  1601.         '工具条
  1602.         Me.Caption = "人事信息维护"
  1603.         .Buttons("PrinterSet").Enabled = True          '打印设置
  1604.         .Buttons("Printer").Enabled = True             '打印
  1605.         .Buttons("Preview").Enabled = True             '预览
  1606.         .Buttons("New").Enabled = True                 '新增
  1607.         .Buttons("Modi").Enabled = True                '修改
  1608.         .Buttons("Del").Enabled = True                 '删除
  1609.         .Buttons("Save").Enabled = False               '保存
  1610.         .Buttons("Cancel").Enabled = False             '放弃
  1611.         .Buttons("First").Enabled = True               '首张
  1612.         .Buttons("Previous").Enabled = True            '上张
  1613.         .Buttons("Next").Enabled = True                '下张
  1614.         .Buttons("Last").Enabled = True                '末张
  1615.         .Buttons("Set").Enabled = True                 '设定
  1616.         .Buttons("Help").Enabled = True                '帮助
  1617.         .Buttons("Exit").Enabled = True                '退出
  1618.         
  1619.     Case 1, 2:             '1.新增单据(（录入）新增一张单据 、（列表）新增一张单据)
  1620.                            '2.修改(（录入）调入修改功能、（列表）调入修改功能)
  1621.         '工具条
  1622.         If Status = 1 Then Me.Caption = "人事信息维护——新增"
  1623.         If Status = 2 Then Me.Caption = "人事信息维护——修改"
  1624.         .Buttons("PrinterSet").Enabled = False          '打印设置
  1625.         .Buttons("Printer").Enabled = False             '打印
  1626.         .Buttons("Preview").Enabled = False             '预览
  1627.         .Buttons("New").Enabled = False                 '新增
  1628.         .Buttons("Modi").Enabled = False                '修改
  1629.         .Buttons("Del").Enabled = False                 '删除
  1630.         .Buttons("Save").Enabled = True                 '保存
  1631.         .Buttons("Cancel").Enabled = True               '放弃
  1632.         .Buttons("First").Enabled = False               '首张
  1633.         .Buttons("Previous").Enabled = False            '上张
  1634.         .Buttons("Next").Enabled = False                '下张
  1635.         .Buttons("Last").Enabled = False                '末张
  1636.         .Buttons("Set").Enabled = True                  '设定
  1637.         .Buttons("Help").Enabled = True                 '帮助
  1638.         .Buttons("Exit").Enabled = True                 '退出
  1639.         
  1640. End Select
  1641. End With
  1642. End Sub
  1644. Private Function SetPicBox(sys As Integer) As Boolean
  1645. '设置图片框的位置
  1646. Dim aStr As String
  1647. Dim PicSet As New ADODB.Recordset
  1649.     If sys = 0 Then
  1650.         aStr = "SELECT pTop as tmpTop,pLeft as tmpLeft FROM Rs_Items WHERE FieldName='Pic'"
  1651.     Else
  1652.         aStr = "SELECT sTop as tmpTop,sLeft as tmpLeft FROM Rs_Items WHERE FieldName='Pic'"
  1653.     End If
  1655.     Set PicSet = Cw_DataEnvi.DataConnect.Execute(aStr)
  1656.     With PicSet
  1657.         If Not .EOF Then
  1658.             If Val(Trim("" & .Fields("tmpTop"))) <> 0 And Val(Trim("" & .Fields("tmpLeft"))) <> 0 Then
  1659.                 Pic_Emp.Top = Val(Trim("" & .Fields("tmpTop")))
  1660.                 Pic_Emp.Left = Val(Trim("" & .Fields("tmpLeft")))
  1661.             End If
  1662.         End If
  1663.         .Close
  1664.     End With
  1665.     Set PicSet = Nothing
  1667. End Function
  1669. Private Function CreateCtrls(sys As Integer) As Boolean
  1670. '生成界面上的各种控件，主要针对动态的文本框录入
  1671. Dim i As Integer:  Dim j As Integer
  1672. Dim aStr As String
  1673. Dim ItmInfo As New ADODB.Recordset
  1674.     '--设置面板位置和滚动条位置
  1675.     ScollBarIsEffect = False
  1676.     Pict.Top = 0: Pict.Left = 0: VScBar.Value = 0
  1677.     ScollBarIsEffect = True
  1678.     '--------------------------
  1679.     
  1680.     '卸载界面控件
  1681.     For i = 1 To Txt_RsItm.Count - 1
  1682.        Unload Txt_RsItm(i): Unload Lbl_ItmName(i): Unload Cmd_CommHlp(i): Unload Chk_YNStop
  1683.     Next i
  1684.     
  1685.     '赋初值
  1686.     i = 1: j = 1
  1687.     
  1688.     If sys = 0 Then
  1689.         aStr = "SELECT * FROM Rs_Items WHERE (SID='1' AND YNShow='1') ORDER BY Tab"
  1690.     Else
  1691.         aStr = "SELECT * FROM Rs_Items WHERE (SID='2' OR Pm='1') AND sYNShow='1' ORDER BY sTab"
  1692.     End If
  1693.     
  1694.     Call SetPicBox(sys)
  1695.     
  1696.     Set ItmInfo = Cw_DataEnvi.DataConnect.Execute(aStr)
  1697.         
  1698.     Do While Not ItmInfo.EOF
  1700. '       =======创建标签
  1701.         Load Lbl_ItmName(i)
  1702.         ReDim Preserve tFieldName(i + 1)
  1703.         If sys = 0 Then
  1704.             Lbl_ItmName(i).Left = Val(ItmInfo!pLeft & "")
  1705.             Lbl_ItmName(i).Top = Val(ItmInfo!pTop & "")
  1706.         Else
  1707.             Lbl_ItmName(i).Left = Val(ItmInfo!sLeft & "")
  1708.             Lbl_ItmName(i).Top = Val(ItmInfo!Stop & "")
  1709.         End If
  1710.         Lbl_ItmName(i).Caption = ItmInfo!ChName
  1711.         tFieldName(i) = Trim(ItmInfo!FieldName & "")
  1712.         
  1713.             
  1714. '       =======创建文本框并设置相关属性
  1715.         Load Txt_RsItm(i)
  1716.         ReDim Preserve tIsCode(2, i + 1)
  1717.         ReDim Preserve tReserved(i + 1)
  1718.         ReDim Preserve tFixed(i + 1)
  1719.         ReDim Preserve tDataType(i + 1)
  1720.         ReDim Preserve tItmId(i + 1)
  1721.         ReDim Preserve tSysROnly(i + 1)
  1722.         
  1723. '       是否保留，在辅助保留中使用
  1724.         If IsNull(ItmInfo!YnReserve) Then
  1725.             tReserved(i) = False
  1726.         Else
  1727.             tReserved(i) = ItmInfo!YnReserve
  1728.         End If
  1729.         
  1730. '       文本框对应字段的数据类型
  1731.         tDataType(i) = ItmInfo!FieldType
  1733. '       是否编码
  1734.         If Trim(ItmInfo!CorTable) <> "" Then
  1735.             tIsCode(1, i) = 1
  1736.         Else
  1737.             tIsCode(1, i) = 0
  1738.         End If
  1739.             
  1740. '       项目编号
  1741.         tItmId(i) = ItmInfo!ItemId
  1742.         
  1743. '       是否固定，存储在人事信息基本表里的是固定的
  1744.         If Trim(ItmInfo!TableName) = "Rs_BasicInfo" Then
  1745.             tFixed(i) = 1
  1746.         Else
  1747.             tFixed(i) = 0
  1748.         End If
  1749.                       
  1750.         Txt_RsItm(i).Left = Lbl_ItmName(i).Left + Lbl_ItmName(i).Width + 100
  1751.         Txt_RsItm(i).Top = Lbl_ItmName(i).Top - 50
  1752.         
  1753.         Txt_RsItm(i).Width = ItmInfo!FieldLength * 105
  1754.         Txt_RsItm(i).MaxLength = ItmInfo!FieldLength
  1755.         If sys = 0 Then
  1756.             Txt_RsItm(i).TabIndex = Val("" & ItmInfo!Tab) - 1
  1757.         Else
  1758.             Txt_RsItm(i).TabIndex = Val("" & ItmInfo!sTab) - 1
  1759.         End If
  1760.         
  1761. '       是否只读 （只针对工资）
  1762.         If ItmInfo.Fields("SID") = 1 And ItmInfo.Fields("Pm") = True Then
  1763.             tSysROnly(i) = True
  1764.         End If
  1765.         
  1766. '       =======创建帮助按钮          帮助按钮的tag值存储该按钮是否可用  （为保持文本框、标签、帮助按钮和各数组下标一致）
  1767.         Load Cmd_CommHlp(i)
  1768.         Cmd_CommHlp(i).Top = Txt_RsItm(i).Top
  1769.         Cmd_CommHlp(i).Left = Txt_RsItm(i).Width + Txt_RsItm(i).Left
  1770.         
  1771.         If ItmInfo!FieldName = "EmpNo" Then                            '单独设定工号的帮助
  1772.             Cmd_CommHlp(i).Tag = 2                                       '2是工号的特殊标志，其他帮助按钮有效的为1，否则为0
  1773.         Else
  1774.             If ((Trim(ItmInfo!Correlation) = 0 And Trim(ItmInfo!CorTable) <> "") _
  1775.                  Or (Trim(ItmInfo!Correlation) <> 0) Or (ItmInfo!FieldType = 7)) Then
  1776.                 Cmd_CommHlp(i).Tag = 1
  1777.             Else
  1778.                 Cmd_CommHlp(i).Tag = 0
  1779.             End If
  1780.         End If
  1781.         Txt_RsItm(i).Visible = True
  1782.         Lbl_ItmName(i).Visible = True
  1783. 'a1 begin end
  1784.         i = i + 1
  1785.         ItmInfo.MoveNext
  1786.     Loop
  1787.     
  1788.     For i = 1 To Txt_RsItm.UBound
  1789.         If UCase(tFieldName(i)) = "YNSTOP" Then
  1790.             Chk_YNStop.Top = Txt_RsItm(i).Top
  1791.             Chk_YNStop.Left = Txt_RsItm(i).Left
  1792.             Chk_YNStop.TabIndex = Txt_RsItm(i).TabIndex
  1793.             Chk_YNStop.Caption = Me.Lbl_ItmName(i).Caption
  1794.             Me.Lbl_ItmName(i).Caption = ""
  1795.             Txt_RsItm(i).Visible = False
  1796.             Txt_RsItm(i).Enabled = False
  1797.             Chk_YNStop.Visible = True
  1798.             Exit For
  1799.         End If
  1800.     Next
  1801.     ItmInfo.Close
  1803. End Function
  1806. Private Sub ReserveItmRefurbish()
  1807. '针对保留项目填充文本框
  1808. Dim tmpRs As New ADODB.Recordset
  1809. Dim i As Integer: Dim sSql As String
  1811. On Error GoTo ErrDeal
  1813. '保留功能没有启用，退出
  1814. If Not Me.ReserveIsOn Then Exit Sub
  1815. ''对修改状态的刷新，不提供支持
  1816. 'If Me.Tag = "Modi" Then Exit Sub
  1818. sSql = "SELECT ItemParameter FROM Rs_OtherSet WHERE ItemName = 'ReserveID'"
  1819. Set tmpRs = Cw_DataEnvi.DataConnect.Execute(sSql)
  1820. If tmpRs.EOF Then Exit Sub
  1821. ReserveId = tmpRs.Fields("ItemParameter")
  1823. sSql = Item_Info(SysOwner) & " WHERE B.EmpId= " & ReserveId & " AND B.EmpId=E.EmpId"
  1824. If tmpRs.State = 1 Then tmpRs.Close
  1825. tmpRs.Open sSql, Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic
  1827. If Not tmpRs.EOF Then
  1828.     For i = 1 To Lbl_ItmName.UBound
  1829.         If tReserved(i) = True Then
  1830.             
  1831.                 If tIsCode(1, i) = 1 Then
  1832.                     Txt_RsItm(i).Text = "" & tmpRs.Fields("N_" & tFieldName(i))
  1833.                     
  1834.                     tIsCode(2, i) = Trim("" & tmpRs.Fields(tFieldName(i)))
  1835.                 Else
  1836.                     Txt_RsItm(i).Text = "" & tmpRs.Fields(tFieldName(i))
  1837.                 End If
  1838.                 If Trim(tFieldName(i)) = "EmpNo" Or Trim(tFieldName(i)) = "EmpName" Then Txt_RsItm(i).Text = ""
  1839.             
  1840.         End If
  1841.     Next
  1843. End If
  1844. tmpRs.Close
  1846. Exit Sub
  1847. ErrDeal:
  1848.     Call Xtxxts("辅助保留项目功能暂不可用!", 0, 3)
  1849. End Sub