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

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

企业管理

开发平台：

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