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

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

企业管理

开发平台：

Visual Basic

：源码内容
  1. VERSION 5.00
  2. Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.OCX"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
  4. Begin VB.Form Ed_EmpCorArFrm 
  5.    BackColor       =   &H00C0C0C0&
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "相关档案维护"
  8.    ClientHeight    =   6990
  9.    ClientLeft      =   675
  10.    ClientTop       =   720
  11.    ClientWidth     =   11400
  12.    HelpContextID   =   2113002
  13.    Icon            =   "处理_相关档案维护.frx":0000
  14.    KeyPreview      =   -1  'True
  15.    LinkTopic       =   "Form4"
  16.    MaxButton       =   0   'False
  17.    MinButton       =   0   'False
  18.    ScaleHeight     =   6990
  19.    ScaleWidth      =   11400
  20.    StartUpPosition =   1  '所有者中心
  21.    Begin VB.CommandButton Ydcommand 
  22.       Height          =   300
  23.       Left            =   10980
  24.       Picture         =   "处理_相关档案维护.frx":1042
  25.       Style           =   1  'Graphical
  26.       TabIndex        =   1
  27.       Top             =   2730
  28.       Visible         =   0   'False
  29.       Width           =   300
  30.    End
  31.    Begin VB.PictureBox Pic_Title 
  32.       BackColor       =   &H00FFFFFF&
  33.       Height          =   765
  34.       Left            =   0
  35.       Picture         =   "处理_相关档案维护.frx":13CC
  36.       ScaleHeight     =   705
  37.       ScaleWidth      =   11745
  38.       TabIndex        =   7
  39.       Top             =   600
  40.       Width           =   11805
  41.       Begin MSComctlLib.ImageList ImageList1 
  42.          Left            =   10320
  43.          Top             =   420
  44.          _ExtentX        =   1005
  45.          _ExtentY        =   1005
  46.          BackColor       =   -2147483643
  47.          ImageWidth      =   16
  48.          ImageHeight     =   16
  49.          MaskColor       =   12632256
  50.          _Version        =   393216
  51.          BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  52.             NumListImages   =   26
  53.             BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  54.                Picture         =   "处理_相关档案维护.frx":1E30C
  55.                Key             =   "sz"
  56.             EndProperty
  57.             BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  58.                Picture         =   "处理_相关档案维护.frx":1E6A6
  59.                Key             =   "dy"
  60.             EndProperty
  61.             BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  62.                Picture         =   "处理_相关档案维护.frx":1EA40
  63.                Key             =   "yl"
  64.             EndProperty
  65.             BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  66.                Picture         =   "处理_相关档案维护.frx":1EDDA
  67.                Key             =   "xg"
  68.             EndProperty
  69.             BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  70.                Picture         =   "处理_相关档案维护.frx":1F174
  71.                Key             =   "zh"
  72.             EndProperty
  73.             BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  74.                Picture         =   "处理_相关档案维护.frx":1F50E
  75.                Key             =   "sh"
  76.             EndProperty
  77.             BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  78.                Picture         =   "处理_相关档案维护.frx":1F8A8
  79.                Key             =   "bc"
  80.             EndProperty
  81.             BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  82.                Picture         =   "处理_相关档案维护.frx":1FC42
  83.                Key             =   "fq"
  84.             EndProperty
  85.             BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  86.                Picture         =   "处理_相关档案维护.frx":1FFDC
  87.                Key             =   "bz"
  88.             EndProperty
  89.             BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  90.                Picture         =   "处理_相关档案维护.frx":20376
  91.                Key             =   "tc"
  92.             EndProperty
  93.             BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  94.                Picture         =   "处理_相关档案维护.frx":20710
  95.                Key             =   "bcgs"
  96.             EndProperty
  97.             BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  98.                Picture         =   "处理_相关档案维护.frx":20AAA
  99.                Key             =   "mrlk"
  100.             EndProperty
  101.             BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  102.                Picture         =   "处理_相关档案维护.frx":20E44
  103.                Key             =   "xsxm"
  104.             EndProperty
  105.             BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  106.                Picture         =   "处理_相关档案维护.frx":211DE
  107.                Key             =   "first"
  108.             EndProperty
  109.             BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  110.                Picture         =   "处理_相关档案维护.frx":21578
  111.                Key             =   "prev"
  112.             EndProperty
  113.             BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  114.                Picture         =   "处理_相关档案维护.frx":21912
  115.                Key             =   "next"
  116.             EndProperty
  117.             BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  118.                Picture         =   "处理_相关档案维护.frx":21CAC
  119.                Key             =   "last"
  120.             EndProperty
  121.             BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  122.                Picture         =   "处理_相关档案维护.frx":22046
  123.                Key             =   "xx"
  124.             EndProperty
  125.             BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  126.                Picture         =   "处理_相关档案维护.frx":223E0
  127.                Key             =   "define"
  128.             EndProperty
  129.             BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  130.                Picture         =   "处理_相关档案维护.frx":2277A
  131.                Key             =   "exec"
  132.             EndProperty
  133.             BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  134.                Picture         =   "处理_相关档案维护.frx":22B14
  135.                Key             =   "xz"
  136.             EndProperty
  137.             BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  138.                Picture         =   "处理_相关档案维护.frx":22EAE
  139.                Key             =   "sc"
  140.             EndProperty
  141.             BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  142.                Picture         =   "处理_相关档案维护.frx":23248
  143.                Key             =   "sx"
  144.             EndProperty
  145.             BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  146.                Picture         =   "处理_相关档案维护.frx":235E2
  147.                Key             =   "cx"
  148.             EndProperty
  149.             BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  150.                Picture         =   "处理_相关档案维护.frx":2397C
  151.                Key             =   "zd"
  152.             EndProperty
  153.             BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  154.                Picture         =   "处理_相关档案维护.frx":23D16
  155.                Key             =   "arsort"
  156.             EndProperty
  157.          EndProperty
  158.       End
  159.       Begin VB.Label Label2 
  160.          AutoSize        =   -1  'True
  161.          BackStyle       =   0  'Transparent
  162.          Caption         =   "相关档案维护"
  163.          BeginProperty Font 
  164.             Name            =   "宋体"
  165.             Size            =   12
  166.             Charset         =   134
  167.             Weight          =   700
  168.             Underline       =   0   'False
  169.             Italic          =   0   'False
  170.             Strikethrough   =   0   'False
  171.          EndProperty
  172.          Height          =   240
  173.          Left            =   660
  174.          TabIndex        =   11
  175.          Top             =   240
  176.          Width           =   1530
  177.       End
  178.       Begin VB.Label Lbl_ArName 
  179.          AutoSize        =   -1  'True
  180.          BackStyle       =   0  'Transparent
  181.          Caption         =   "档案类别:"
  182.          Height          =   180
  183.          Left            =   2430
  184.          TabIndex        =   10
  185.          Top             =   255
  186.          Width           =   810
  187.       End
  188.       Begin VB.Label Lbl_EmpNo 
  189.          AutoSize        =   -1  'True
  190.          BackStyle       =   0  'Transparent
  191.          Caption         =   "职工号:"
  192.          Height          =   180
  193.          Left            =   5700
  194.          TabIndex        =   9
  195.          Top             =   270
  196.          Visible         =   0   'False
  197.          Width           =   1920
  198.       End
  199.       Begin VB.Label Lbl_EmpName 
  200.          AutoSize        =   -1  'True
  201.          BackStyle       =   0  'Transparent
  202.          Caption         =   "姓名:"
  203.          Height          =   180
  204.          Left            =   7710
  205.          TabIndex        =   8
  206.          Top             =   270
  207.          Visible         =   0   'False
  208.          Width           =   450
  209.       End
  210.    End
  211.    Begin VB.TextBox Ydtext 
  212.       BackColor       =   &H00C0FFFF&
  213.       BorderStyle     =   0  'None
  214.       Height          =   330
  215.       Left            =   9300
  216.       MultiLine       =   -1  'True
  217.       TabIndex        =   0
  218.       Top             =   2340
  219.       Visible         =   0   'False
  220.       Width           =   1185
  221.    End
  222.    Begin VB.ComboBox YdCombo 
  223.       Height          =   300
  224.       Left            =   9300
  225.       Style           =   2  'Dropdown List
  226.       TabIndex        =   3
  227.       Top             =   2730
  228.       Visible         =   0   'False
  229.       Width           =   1665
  230.    End
  231.    Begin VB.Timer Timer1 
  232.       Interval        =   1
  233.       Left            =   10530
  234.       Top             =   2280
  235.    End
  236.    Begin VSFlex8Ctl.VSFlexGrid WglrGrid 
  237.       Height          =   5490
  238.       Left            =   45
  239.       TabIndex        =   4
  240.       Top             =   1500
  241.       Width           =   8205
  242.       _ExtentX        =   14473
  243.       _ExtentY        =   9684
  244.       Appearance      =   1
  245.       BorderStyle     =   1
  246.       Enabled         =   -1  'True
  247.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  248.          Name            =   "宋体"
  249.          Size            =   9
  250.          Charset         =   134
  251.          Weight          =   400
  252.          Underline       =   0   'False
  253.          Italic          =   0   'False
  254.          Strikethrough   =   0   'False
  255.       EndProperty
  256.       MousePointer    =   0
  257.       BackColor       =   16777215
  258.       ForeColor       =   -2147483640
  259.       BackColorFixed  =   12632256
  260.       ForeColorFixed  =   -2147483630
  261.       BackColorSel    =   -2147483635
  262.       ForeColorSel    =   -2147483634
  263.       BackColorBkg    =   -2147483636
  264.       BackColorAlternate=   16777215
  265.       GridColor       =   -2147483633
  266.       GridColorFixed  =   -2147483632
  267.       TreeColor       =   -2147483632
  268.       FloodColor      =   192
  269.       SheetBorder     =   -2147483642
  270.       FocusRect       =   1
  271.       HighLight       =   1
  272.       AllowSelection  =   -1  'True
  273.       AllowBigSelection=   -1  'True
  274.       AllowUserResizing=   0
  275.       SelectionMode   =   0
  276.       GridLines       =   1
  277.       GridLinesFixed  =   2
  278.       GridLineWidth   =   1
  279.       Rows            =   50
  280.       Cols            =   10
  281.       FixedRows       =   1
  282.       FixedCols       =   1
  283.       RowHeightMin    =   0
  284.       RowHeightMax    =   0
  285.       ColWidthMin     =   0
  286.       ColWidthMax     =   0
  287.       ExtendLastCol   =   0   'False
  288.       FormatString    =   ""
  289.       ScrollTrack     =   0   'False
  290.       ScrollBars      =   3
  291.       ScrollTips      =   0   'False
  292.       MergeCells      =   0
  293.       MergeCompare    =   0
  294.       AutoResize      =   -1  'True
  295.       AutoSizeMode    =   0
  296.       AutoSearch      =   0
  297.       MultiTotals     =   -1  'True
  298.       SubtotalPosition=   1
  299.       OutlineBar      =   0
  300.       OutlineCol      =   0
  301.       Ellipsis        =   0
  302.       ExplorerBar     =   0
  303.       PicturesOver    =   0   'False
  304.       FillStyle       =   0
  305.       RightToLeft     =   0   'False
  306.       PictureType     =   0
  307.       TabBehavior     =   0
  308.       OwnerDraw       =   0
  309.       Editable        =   0   'False
  310.       ShowComboButton =   -1  'True
  311.       WordWrap        =   0   'False
  312.       TextStyle       =   0
  313.       TextStyleFixed  =   0
  314.       OleDragMode     =   0
  315.       OleDropMode     =   0
  316.       DataMode        =   0
  317.       VirtualData     =   -1  'True
  318.    End
  319.    Begin MSComctlLib.Toolbar Tlb_Action 
  320.       Align           =   1  'Align Top
  321.       Height          =   570
  322.       Left            =   0
  323.       TabIndex        =   2
  324.       Top             =   0
  325.       Width           =   11400
  326.       _ExtentX        =   20108
  327.       _ExtentY        =   1005
  328.       ButtonWidth     =   820
  329.       ButtonHeight    =   953
  330.       AllowCustomize  =   0   'False
  331.       Wrappable       =   0   'False
  332.       Appearance      =   1
  333.       Style           =   1
  334.       ImageList       =   "ImageList1"
  335.       _Version        =   393216
  336.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  337.          NumButtons      =   11
  338.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  339.             Caption         =   "设置"
  340.             Key             =   "ymsz"
  341.             Object.ToolTipText     =   "打印页面设置"
  342.             ImageKey        =   "sz"
  343.          EndProperty
  344.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  345.             Caption         =   "打印"
  346.             Key             =   "dy"
  347.             Object.ToolTipText     =   "打印当前单据或Ctrl+P"
  348.             ImageKey        =   "dy"
  349.          EndProperty
  350.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  351.             Caption         =   "预览"
  352.             Key             =   "yl"
  353.             ImageKey        =   "yl"
  354.          EndProperty
  355.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  356.             Style           =   3
  357.          EndProperty
  358.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  359.             Caption         =   "增行"
  360.             Key             =   "zh"
  361.             ImageKey        =   "zh"
  362.          EndProperty
  363.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  364.             Caption         =   "删行"
  365.             Key             =   "sh"
  366.             Object.ToolTipText     =   "删除当前记录行或Delete"
  367.             ImageKey        =   "sh"
  368.          EndProperty
  369.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  370.             Style           =   3
  371.          EndProperty
  372.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  373.             Caption         =   "类别"
  374.             Key             =   "arsort"
  375.             ImageKey        =   "arsort"
  376.          EndProperty
  377.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  378.             Style           =   3
  379.          EndProperty
  380.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  381.             Caption         =   "帮助"
  382.             Key             =   "bz"
  383.             ImageKey        =   "bz"
  384.          EndProperty
  385.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  386.             Caption         =   "退出"
  387.             Key             =   "fh"
  388.             ImageKey        =   "tc"
  389.          EndProperty
  390.       EndProperty
  391.       BorderStyle     =   1
  392.       Begin MSComctlLib.Toolbar GsToolbar 
  393.          Height          =   540
  394.          Left            =   9720
  395.          TabIndex        =   6
  396.          Top             =   0
  397.          Width           =   1695
  398.          _ExtentX        =   2990
  399.          _ExtentY        =   953
  400.          ButtonWidth     =   1455
  401.          ButtonHeight    =   953
  402.          AllowCustomize  =   0   'False
  403.          Appearance      =   1
  404.          Style           =   1
  405.          ImageList       =   "ImageList1"
  406.          _Version        =   393216
  407.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  408.             NumButtons      =   2
  409.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  410.                Caption         =   "保存格式"
  411.                Key             =   "bcgs"
  412.                ImageKey        =   "bcgs"
  413.             EndProperty
  414.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  415.                Caption         =   "默认列宽"
  416.                Key             =   "hfmrgs"
  417.                ImageKey        =   "mrlk"
  418.             EndProperty
  419.          EndProperty
  420.       End
  421.    End
  422.    Begin VB.Label Lab_OperStatus 
  423.       BackColor       =   &H000080FF&
  424.       Caption         =   "1"
  425.       Height          =   345
  426.       Left            =   10980
  427.       TabIndex        =   5
  428.       Top             =   2310
  429.       Visible         =   0   'False
  430.       Width           =   345
  431.    End
  432. End
  433. Attribute VB_Name = "Ed_EmpCorArFrm"
  434. Attribute VB_GlobalNameSpace = False
  435. Attribute VB_Creatable = False
  436. Attribute VB_PredeclaredId = True
  437. Attribute VB_Exposed = False
  438. '**************************************************************************************************
  439. '*    模 块 名 称 :相关档案维护(增行式)
  440. '*    功 能 描 述 :直接录入人员的相关档案
  441. '*    程序员姓名  :刘  刚
  442. '*    最后修改人  :刘  刚
  443. '*    最后修改时间:2002/01/03
  444. '*    备        注:程序中所有依实际情况自定义部分均用[>> <<]括起,注意此种录入需要修改"Sub Scdqfl"
  445. '*
  446. '*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
  447. '*
  448. '*    3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) 1-浏览 2-修改
  449. '**************************************************************************************************
  450.  
  451.  '以下为自定义变量
  452.  
  453. Public int_if As Integer                        '1直接录入，0查询列表调用
  454. Public EmpId As String                          '职工ID
  455. '其它固定使用变量
  456. Dim Tsxx As String                              '系统信息提示(Fixed)
  457. Dim ReportTitle As String                       '报表主标题(Fixed)
  458. Dim Str_RightEdit As String             '编辑(新增、修改、删除)权限索引
  460.     
  461. '以下为固定使用变量(网格)
  462. Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
  463. Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
  464. Dim GridCode As String                          '显示网格网格代码
  465. Dim GridInf() As Variant                        '整个网格设置信息
  466. Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
  467. Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
  468. Dim Sfxshjwg As Boolean                         '是否显示合计网格
  469. Dim Qslz As Long                                '网格隐藏(非操作显示)列数
  470. Dim Sjhgd As Double                             '网格数据行高度
  471. Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
  472. Dim GridStr()  As String                        '网格列信息(字符型)
  473. Dim GridInt() As Integer                        '网格列信息(整型)
  474. Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
  475. Dim Dqlrwgh As Long                             '当前录入数据网格行
  476. Dim Dqlrwgl As Long                             '当前录入数据网格列
  477. Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
  478. Dim Dqlkwgl As Long                             '刚刚离开网格列
  479. Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
  480. Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
  481. Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
  482. Dim Wbkbhlock As Boolean                        '文本框改变值锁
  483. Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
  484. Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
  485. Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
  486. Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
  487. Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
  488. Dim Shsfts As Boolean                           '删除记录行是否提示
  489. Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
  492. Private Sub Form_KeyPress(KeyAscii As Integer)      '控制焦点转移和限制录入字符"'"
  493.     
  494.     Select Case KeyAscii
  495.     Case 39           '屏蔽字符"'"
  496.         KeyAscii = 0
  497.     End Select
  498.     
  499. End Sub
  501. Private Sub Form_Load()                              '窗 体 装 入
  502.     
  503.     '初始化各种锁值(Fixed)
  504.     Changelock = False             '网格行列改变控制锁
  505.     Gdtlock = False                '滚动条滚动控制
  506.     Yxxpdlock = True               '字段有效性判断锁
  507.     Hyxxpdlock = True              '行有效性判断锁
  508.     Wbkbhlock = False              '文本框内容改变锁
  509.     
  510.     '报表主标题及报表编码(Fixed)
  511.     ReportTitle = "相 关 档 案"
  512.     XtReportCode = "Rs_CorAr"
  513.     Load Dyymctbl
  514.     
  515.     
  516.     '调 入 网 格(Fixed)
  517.     
  518.     WglrGrid.Rows = 0
  519.     WglrGrid.Cols = 0
  521.     '设置标题栏宽度、网格宽度高度(Fixed)
  522.     Pic_Title.Move 50, Pic_Title.Top, Me.Width - 150, Pic_Title.Height
  523.     WglrGrid.Move 50, Pic_Title.Top + Pic_Title.Height, Me.Width - 150
  524.     WglrGrid.Height = Me.Height - WglrGrid.Top - 380
  525.     WglrGrid.Enabled = False
  526.     
  527.     '生成查询结果
  528.     'Call Sub_Query
  529.     
  530.     
  531.     '设置状态为修改状态
  532.     Lab_OperStatus = "2"
  533.     If int_if = 0 Then
  534.         Lbl_EmpNo.Visible = True
  535.         Lbl_EmpName.Visible = True
  536.     End If
  537.     
  538.     '编辑（增行、删行）权限索引
  539.     Str_RightEdit = "Rs_Ed_EmpCorAr_Edit"
  540.           
  541. End Sub
  543. Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
  544.     
  545.     '调入其它窗体或功能产生的有效性判断(包括数据回写)
  546.     If Not Fun_Drfrmyxxpd Then
  547.         Cancel = True
  548.         Exit Sub
  549.     End If
  550.     
  551.     '卸载打印页面窗体
  552.     Unload Dyymctbl
  553.     
  554. End Sub
  556. Private Sub Sub_Query()                            '生成查询结果
  557.     
  558.     Dim Sqlstr As String                           '临时使用字符串
  559.     Dim tmpRs As New ADODB.Recordset               '临时使用动态集
  560.     Dim jsqte As Long                              '临时计数器
  562.     '禁止网格刷新动作,为加快网格显示速度(Fixed)
  563.     WglrGrid.Redraw = False
  565.     '查询字符串
  566.     If int_if = 1 Then
  567.         Sqlstr = "SELECT * FROM Rs_ArMain WHERE 1=2"
  568.     Else
  569.         Sqlstr = "SELECT * FROM Rs_ArMain WHERE ArSort ='" & Lbl_ArName.Tag & "' AND EmpId = '" & EmpId & "' ORDER BY SNo"
  570.     End If
  571.     Set tmpRs = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  573.     With tmpRs
  574.         WglrGrid.Rows = WglrGrid.FixedRows
  575.         jsqte = WglrGrid.FixedRows
  577.         Do While Not .EOF
  579.             WglrGrid.AddItem ""
  580.             WglrGrid.TextMatrix(jsqte, 0) = "*"                                                                             '有效记录标识
  581.             WglrGrid.TextMatrix(jsqte, 1) = .Fields("EmpId")                                                                '记录唯一标识
  582.             WglrGrid.TextMatrix(jsqte, 2) = .Fields("EmpId")                                                                '职工ID
  583.             WglrGrid.TextMatrix(jsqte, 3) = Trim(.Fields("SNo") & "")                                                       '档案序号
  585.             i = 1: j = 1
  586.             While i <= WglrGrid.Cols - 4 - 2
  587.                 If Searched(j + 2) Then
  588.                     WglrGrid.TextMatrix(jsqte, Sydz(Format(j + 2, "000"), GridStr(), Szzls)) = Trim(.Fields(Lbl_ArName.Tag & Format(j, "000")) & "")
  589.                     i = i + 1
  590.                 End If
  591.                 j = j + 1
  592.             Wend
  594.             '<<]
  596.             WglrGrid.RowHeight(jsqte) = 300 'Sjhgd
  597.             .MoveNext
  598.             jsqte = jsqte + 1
  599.         Loop
  600.     End With
  602.     '将网格刷新解禁(Fixed)
  603.     WglrGrid.Redraw = True
  605.     '调整网格(Fixed)
  606.     Call Sub_AdjustGrid
  608. End Sub
  610. Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
  611.     
  612.     '屏蔽文本框,下拉组合框有效性判断
  613.     
  614.     Valilock = True
  615.     
  616.     '屏蔽网格失去焦点产生的有效性判断
  617.     
  618.     Changelock = True
  619.     
  620.     Select Case Button.Key
  621.     Case "ymsz"                                          '页面设置
  622.         Dyymctbl.Show 1
  623.     Case "yl"                                            '预 览
  624.         If WglrGrid.Rows - WglrGrid.FixedRows = 0 Then Exit Sub
  625.         If Fun_Drfrmyxxpd Then
  626.             Call bbyl(True)
  627.         End If
  628.     Case "dy"                                            '打 印
  629.         If WglrGrid.Rows - WglrGrid.FixedRows = 0 Then Exit Sub
  630.         If Fun_Drfrmyxxpd Then
  631.             Call bbyl(False)
  632.         End If
  633.     Case "zh"                                            '增 行
  634.         '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  635.         If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  636.             Exit Sub
  637.         End If
  638.         If WglrGrid.Rows - WglrGrid.FixedRows = 0 Then Exit Sub
  639.         Call zjlrfl
  640.     Case "sh"                                            '删 行
  641.         '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  642.         If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  643.             Exit Sub
  644.         End If
  645.         If WglrGrid.Rows - WglrGrid.FixedRows = 0 Then Exit Sub
  646.         Call Scdqfl
  647.     Case "arsort"                                       '选择档案类别
  648.         Call SelectArSort
  649.     Case "bz"                                            '帮 助
  650.         Call F1bz
  651.     Case "fh"                                            '退 出
  652.         Unload Me
  653.     End Select
  654.     
  655.     '解 锁
  656.     Valilock = False
  657.     Changelock = False
  658.     
  659. End Sub
  661. Private Function SelectArSort() As Boolean
  662. Dim tmpRs As New ADODB.Recordset
  663.     
  664.     Set tmpRs = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM Rs_ArSort ")
  665.     If tmpRs.EOF Then
  666.         Call Xtxxts("请先设置档案类别!", 0, 1)
  667.         Exit Function
  668.     End If
  669.     Ed_EmpCorArSortFrm.Show 1
  670.     If Trim(Ed_EmpCorArSortFrm.Cbo_ArSort.Tag) <> "" Then
  671.         Lbl_ArName.Tag = Ed_EmpCorArSortFrm.Cbo_ArSort.Tag
  672.         Lbl_ArName.Caption = "档案类别:  " & Ed_EmpCorArSortFrm.Cbo_ArSort.Text
  673.         
  674.         Call Ini_Grid
  675.         WglrGrid.SetFocus
  676.     End If
  678. End Function
  680. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  681.     
  682.     If Shift = 2 Then
  683.         Select Case UCase(Chr(KeyCode))
  684.         Case "P"                   'Ctrl+P 打印
  685.             If Tlb_Action.Buttons("dy").Enabled Then
  686.                 Call bbyl(False)
  687.             End If
  688.         End Select
  689.     End If
  690.     
  691. End Sub
  693. Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
  694.     
  695.     Dim xswbrr As String
  696.     
  697.     With WglrGrid
  698.         Zdlrqnr = Trim(.Text)
  699.         xswbrr = Trim(.Text)
  700.         
  701.         If GridBoolean(.Col, 3) Then   '列表框录入
  702.             
  703.             '填充列表框程序
  704.             Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
  705.         Else
  706.             Wbkbhlock = True
  707.             
  708.             '====以下为用户自定义
  709.             Ydtext.Text = xswbrr
  710.             '====以上为用户自定义
  711.             
  712.             Wbkbhlock = False
  713.             Ydtext.SelStart = Len(Ydtext.Text)
  714.         End If
  715.     End With
  716.     
  717. End Sub
  719. Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
  720.     '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
  722.     Dim Str_JudgeText As String                 '临时有效性判断字段内容(Fixed)
  723.     Dim Coljsq As Long                          '临时列计数器(Fixed)
  724.     Dim RecTemp   As New ADODB.Recordset          '临时使用动态集(Fixed)
  725.     Dim tmpRs As New ADODB.Recordset
  726.     
  727.     Dim Sqlstr As String                        '临时使用查询字符串(Fixed)
  728.     Dim tmpNo As Integer
  729.     
  730.     With WglrGrid
  731.         
  732.         '非录入状态或非数据行则其有效性为合法(Fixed)
  733.         If Yxxpdlock Or .Row < .FixedRows Then
  734.             sjzdyxxpd = True
  735.             Exit Function
  736.         End If
  737.         
  738.         '取得当前要判断字段内容(Fixed)
  739.         Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
  740.         
  741.         '根据不同字段进行相应的处理(依据其逻辑编号)
  742.         Select Case GridInt(Dqpdwgl, 1)
  743.             Case "7"                                                            '日期型
  744.                 If Not Trim(Str_JudgeText) = "" Then
  745.                     If Not IsDate(Trim(Str_JudgeText)) Then
  746.                         Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  747.                         GoTo Lrcwcl
  748.                     End If
  749.                 End If
  750.             
  751.         End Select
  752.         Select Case GridStr(Dqpdwgl, 1)
  754.             '[>>以下为自定义部分
  756.         Case "001"                   '职工号(字段不为空则做有效性判断及事后处理)
  757.             If Not Trim(Str_JudgeText) = "" Then
  759. '                **********************下面的代码，在根据工号选姓名时，可以参考
  760.                 '1.放置字段有效性判断
  761.                 Sqlstr = "SELECT EmpId,EmpName From Rs_BasicInfo WHERE EmpNo ='" & Str_JudgeText & "' AND YNStop <> 1"
  762.                 Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  763.                 If Not RecTemp.EOF Then
  764.                     .TextMatrix(Dqpdwgh, 2) = Trim(RecTemp.Fields("EmpId") & "")
  765.                 Else
  766.                     Tsxx = "此职工不存在!"
  767.                     GoTo Lrcwcl
  768.                 End If
  769.                 
  770.                 Sqlstr = "IF EXISTS(SELECT Sno FROM  Rs_ArMain WHERE ArSort ='" & Lbl_ArName.Tag & "' AND EmpId = " & .TextMatrix(Dqpdwgh, 2) & ")"
  771.                 Sqlstr = Sqlstr & " SELECT no= MAX(Sno)+1 FROM Rs_ArMain WHERE ArSort ='" & Lbl_ArName.Tag & "' AND EmpId ='" & WglrGrid.TextMatrix(Dqpdwgh, 2) & "'"
  772.                 Sqlstr = Sqlstr & " ELSE SELECT no =1 "
  773.                 Set tmpRs = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  774.                 If Not tmpRs.EOF Then
  775.                     tmpNo = tmpRs.Fields("no")
  776.                 End If
  777.                 
  779.                 '2.放置字段事后处理程序
  780.                 .TextMatrix(Dqpdwgh, 2) = Trim(RecTemp.Fields("EmpId") & "")                                        '隐藏EmpId
  781.                 .TextMatrix(Dqpdwgh, 3) = tmpNo                                                                     '档案序号
  782.                 .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("EmpName") & "")          '职工姓名
  783.             Else
  784.                 '3.清空相关字段
  785.                 .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = ""                                            '职工姓名
  786.             End If
  788.             '<<以上为自定义部分]
  789.         End Select
  790.         
  791.         '字段录入正确后为零字段清空(Fixed)
  792.         Call Qkwlzd(Dqpdwgh, Dqpdwgl)
  793.                 
  794.         
  795.         '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
  796.         sjzdyxxpd = True
  797.         Yxxpdlock = True
  798.         Exit Function
  799.     End With
  800.     
  801. Lrcwcl:    '录入错误处理(Fixed)
  802.     
  803.     With WglrGrid
  804.         '给出错误提示信息
  805.         Call Xtxxts(Tsxx, 0, 1)
  806.         
  807.         '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
  808.         Changelock = True
  809.         .Select Dqpdwgh, Dqpdwgl
  810.         Changelock = False
  811.         Call xswbk
  812.         
  813.         '函数返回False
  814.         sjzdyxxpd = False
  815.         Exit Function
  816.     End With
  817.     
  818. End Function
  820. Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
  821.     
  822.     Dim Lrywlz As Long                     '录入错误列值(Fixed)
  823.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  824.     Dim Sqlstr As String                   '临时查询字符串
  825.     Dim ItmEmpty As Boolean
  826.     Dim tmpNo As Integer
  827.     Dim i As Integer
  828.     With WglrGrid
  829.         
  830.         '判断行为空和无效数据行则清除当前行
  831.         If .Rows <= .FixedRows Then Exit Function   ' 如果没有记录，则退出
  832.         If .TextMatrix(Yxxpdh, 0) <> "*" Then
  833.             Sjhzyxxpd = True
  834.             Exit Function
  835.         Else
  836.             If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
  837.                 If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
  838.                     Changelock = True
  839.                     .RemoveItem Yxxpdh                                  '取消的情况删行
  840.                     
  841.                     If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  842.                         .AddItem ""
  843.                         .RowHeight(.Rows - 1) = Sjhgd
  844.                     End If
  845.                     
  846.                     Changelock = False
  847.                     Sjhzyxxpd = True
  848.                     Exit Function
  849.                 End If
  850.             End If
  851.         End If
  852.         
  853.         '行没有发生变化则不进行有效性判断
  854.         If Hyxxpdlock Then
  855.             Sjhzyxxpd = True
  856.             Exit Function
  857.         End If
  858.         
  859.         '以下为自定义部分[
  860.         
  861.         '1.1首先进行单个不能为空或不能为零判断(Fixed)
  862.         For jsqte = Qslz To .Cols - 1
  863.             
  864.             '字段不能为空
  865.             If GridInt(jsqte, 5) = 1 Then
  866.                 If Len(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
  867.                     Tsxx = GridStr(jsqte, 2)
  868.                     Lrywlz = jsqte
  869.                     GoTo Lrcwcl
  870.                     Exit For
  871.                 End If
  872.             End If
  873.             
  874.             '字段不能为零
  875.             If GridInt(jsqte, 5) = 2 Then
  876.                 If Val(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
  877.                     Tsxx = GridStr(jsqte, 2)
  878.                     Lrywlz = jsqte
  879.                     GoTo Lrcwcl
  880.                     Exit For
  881.                 End If
  882.             End If
  883.             
  884.         Next jsqte
  885.         
  886.         
  887.         '1.2进行其他有效性判断,编写格式同1.1
  888.         
  889.         '2.放置行处理程序(当数据行通过有效性判断)
  890. '        -------------------
  891.         '如果职工号为空则提示错误
  892.         If (int_if = 1) And (Trim(.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls))) = "") Then
  893.             Tsxx = "职工号不能为空!"
  894.             Lrywlz = Sydz("001", GridStr(), Szzls)
  895.             GoTo Lrcwcl
  896.         End If
  897. '        如果每一个项目都是空的，则提示错误
  898.         ItmEmpty = True
  899.         For jsqte = Qslz + 2 To .Cols - 1
  900.             If Trim(.TextMatrix(Yxxpdh, jsqte)) <> "" Then
  901.                 ItmEmpty = False
  902.                 Exit For
  903.             End If
  904.         Next
  905.         
  906.         
  907.         If ItmEmpty Then
  908.             Tsxx = "档案内容不能为空!"
  909.             GoTo Lrcwcl
  910.         End If
  911.         
  912. '        ----------------------
  913.         '直接录入，职员ID号取当前行第二列的值，档案序号取取当前行第三列的值
  914.         '查询列表调用,职员ID号不变，档案序号取行号
  915.         If int_if = 1 Then
  916.             EmpId = Val(WglrGrid.TextMatrix(Yxxpdh, 2))
  917.             tmpNo = Val(WglrGrid.TextMatrix(Yxxpdh, 3))
  918.         Else
  919.             tmpNo = Yxxpdh
  920.         End If
  921.         
  922.         On Error GoTo Swcwcl
  923.         
  924.         Cw_DataEnvi.DataConnect.BeginTrans
  926.         
  927.         With RecTemp
  928.             
  929.             '判断此行记录ID是否为零,如不为零则修改记录;否则为新增记录,然后将新增后记录ID回写网格
  930.             If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 1))) <> 0 Then
  931.                 If .State = 1 Then .Close
  932.                 .Open "SELECT * From Rs_ArMain WHERE ArSort = '" & Lbl_ArName.Tag & "' AND EmpId = " & EmpId & "AND SNo = " & tmpNo, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  933.                 
  934.                 If Not .EOF Then
  936.                 i = 1 '
  937.                 j = 1
  938.                 While i <= WglrGrid.Cols - 4 - 2
  939.                     If Searched(j + 2) Then
  940.                         .Fields(Lbl_ArName.Tag & Format(j, "000")) = WglrGrid.TextMatrix(Yxxpdh, Sydz(Format(j + 2, "000"), GridStr(), Szzls))
  941.                         i = i + 1
  942.                     End If
  943.                     j = j + 1
  944.                 Wend
  945.                     .Update
  946.                 End If
  947.                 
  948.             Else
  949.                 '重新排序
  950.                 
  951.                 Sqlstr = "EXECUTE Rs_Sp_ArMainOrder  '" & Lbl_ArName.Tag & "'," & EmpId & " ," & tmpNo & ",1"
  952.                 Cw_DataEnvi.DataConnect.Execute (Sqlstr)
  953.                 
  954.                 If .State = 1 Then .Close
  955.                 .Open "SELECT * From Rs_ArMain WHERE 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  957.                 .AddNew
  958.                 .Fields("ArSort") = Lbl_ArName.Tag
  959.                 .Fields("EmpId") = EmpId
  960.                 .Fields("SNo") = tmpNo
  961.                 
  962.                 i = 1 '
  963.                 j = 1
  964.                 While i <= WglrGrid.Cols - 4 - 2
  965.                     If Searched(j + 2) Then
  966.                         .Fields(Lbl_ArName.Tag & Format(j, "000")) = WglrGrid.TextMatrix(Yxxpdh, Sydz(Format(j + 2, "000"), GridStr(), Szzls))
  967.                         i = i + 1
  968.                     End If
  969.                     j = j + 1
  970.                 Wend
  971.                 
  972.                 .Update
  973.                                
  974.                 WglrGrid.TextMatrix(Yxxpdh, 1) = .Fields("EmpID")                                                '记录唯一标识
  975.                 
  976.             End If
  977.             
  978.         End With
  979.         
  980.         Cw_DataEnvi.DataConnect.CommitTrans
  981.         
  982.     End With
  983.     
  984.     '以上为自定义部分]
  985.     
  986.     Sjhzyxxpd = True
  987.     Hyxxpdlock = True
  988.     Exit Function
  989.     
  990. Swcwcl:
  991.     
  992.     Cw_DataEnvi.DataConnect.RollbackTrans
  993.     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  994.     Call Xtxxts(Tsxx, 0, 1)
  995.     Exit Function
  996.     
  997. Lrcwcl:      '录入错误处理
  998.     
  999.     With WglrGrid
  1000.         Call Xtxxts(Tsxx, 0, 1)
  1001.         Changelock = True
  1002.         .Select Yxxpdh, Lrywlz
  1003.         Changelock = False
  1004.         Call xswbk
  1005.         
  1006.         Sjhzyxxpd = False
  1007.         Exit Function
  1008.     End With
  1009.     
  1010. End Function
  1012. Private Function Searched(i As Integer) As Boolean
  1013. Dim tmpRs As New ADODB.Recordset
  1014. Dim j As Integer
  1015. Dim tmpStr As String
  1017. Searched = False
  1018. tmpStr = "SELECT * FROM Xt_Grid WHERE Grid_code = '" & Lbl_ArName.Tag & "' AND ColIndex ='" & Format(i, "000") & "'"
  1019.     Set tmpRs = Cw_DataEnvi.DataConnect.Execute(tmpStr)
  1020.     If tmpRs.RecordCount > 0 Then Searched = True
  1022. End Function
  1023. Public Sub Ini_Grid()
  1024.     
  1025.     If (Lbl_ArName.Tag <> "") Then
  1026.         GridCode = Lbl_ArName.Tag     '网格属性编码
  1027.         
  1028.         WglrGrid.Enabled = True
  1029.         
  1030.         Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  1031.         Qslz = GridInf(1)
  1032.         Sjhgd = GridInf(2)
  1033.         Pmbcsjhs = GridInf(3)
  1034.         Fzxwghs = GridInf(4)
  1035.         Sfblbzkd = GridInf(5)
  1036.         Shsfts = GridInf(6)
  1037.         Sfxshjwg = GridInf(7)
  1038.         Szzls = WglrGrid.Cols - 1
  1039.         If int_if = 1 Then
  1040.             WglrGrid.ColHidden(Sydz("001", GridStr(), Szzls)) = False
  1041.             WglrGrid.ColHidden(Sydz("002", GridStr(), Szzls)) = False
  1042.         Else
  1043.             WglrGrid.ColHidden(Sydz("001", GridStr(), Szzls)) = True
  1044.             WglrGrid.ColHidden(Sydz("002", GridStr(), Szzls)) = True
  1045.         End If
  1046.     End If
  1047.     Sub_Query
  1048.     
  1049. End Sub
  1052. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
  1053. Private Sub Sub_AdjustGrid()
  1054.     
  1055.     '调 整 网 格
  1056.     With WglrGrid
  1057.         '加 1 保持一行录入行
  1058.         If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1059.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  1060.             For jsqte = .FixedRows To .Rows - 1
  1061.                 .RowHeight(jsqte) = Sjhgd
  1062.             Next jsqte
  1063.         End If
  1064.         
  1065.         '判断是否有辅助行和录入行,如没有则加行
  1066.         Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  1067.             .AddItem ""
  1068.             .RowHeight(.Rows - 1) = Sjhgd
  1069.         Loop
  1070.     
  1071.     End With
  1072.     
  1073. End Sub
  1075. Private Sub Lrzdbz()                                                      '录入字段帮助
  1076. Dim sSql As String
  1077. Dim tmpRs As New ADODB.Recordset
  1078.     
  1079.     If Not Ydcommand.Visible Then
  1080.         Exit Sub
  1081.     End If
  1082.     
  1083.     With WglrGrid
  1084.         
  1085.         Valilock = True
  1086.         
  1087.         '处理通用部分
  1088.         Changelock = True        '调入另外窗体必须加锁
  1089.         Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
  1090.         Changelock = False
  1091.         
  1092.         If Len(Xtfhcs) <> 0 Then
  1093.             If GridInt(.Col, 7) = 0 Then
  1094.                 Ydtext.Text = Xtfhcs
  1095.             Else
  1096.                 Ydtext.Text = Xtfhcsfz
  1097.             End If
  1099. '           [>>
  1100.             sSql = "SELECT EmpId ,EmpName From Rs_BasicInfo WHERE EmpNo ='" & Xtfhcs & "' AND YNStop <> 1"
  1101.                 Set tmpRs = Cw_DataEnvi.DataConnect.Execute(sSql)
  1103.                 If tmpRs.EOF Then
  1104.                     Tsxx = "此职工不存在!"
  1105.                     GoTo Lrcwcl
  1106.                 Else
  1107.                     WglrGrid.TextMatrix(WglrGrid.Row, 2) = tmpRs.Fields("EmpId")
  1108.                     
  1109.                 End If
  1110. '            <<]
  1111.         End If
  1112.         
  1113.         Valilock = False
  1114.         
  1115.         If Ydtext.Visible Then
  1116.             Ydtext.SetFocus
  1117.         End If
  1118.             
  1119.     End With
  1120.     Exit Sub
  1121.     
  1122. Lrcwcl:        '录入错误处理(Fixed)
  1123.     
  1124.     With WglrGrid
  1125.         '给出错误提示信息
  1126.         Call Xtxxts(Tsxx, 0, 1)
  1127.         
  1128.         '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
  1129.         Changelock = True
  1130.         .Select Dqpdwgh, Dqpdwgl
  1131.         Changelock = False
  1132.         Call xswbk
  1133.         
  1134. '        '函数返回False
  1135. '        sjzdyxxpd = False
  1136. '        Exit Function
  1137.     End With
  1139.     
  1140.     
  1141. End Sub
  1143. Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
  1144.     
  1145.     Call Cxxswbk
  1146.     
  1147. End Sub
  1148. Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  1149.   
  1150.     Fun_Drfrmyxxpd = True
  1151.     
  1152.     With WglrGrid
  1153.         '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  1154.         If .Row < 0 Then Exit Function
  1155.         
  1156.         If Ydtext.Visible Or YdCombo.Visible Then
  1157.             Call Lrsjhx
  1158.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1159.                 Fun_Drfrmyxxpd = False
  1160.                 Exit Function
  1161.             End If
  1162.         End If
  1163.         
  1164.         
  1165.         '进行行有效性判断
  1166.         If Not Sjhzyxxpd(.Row) Then
  1167.             Fun_Drfrmyxxpd = False
  1168.             Exit Function
  1169.         End If
  1170.     End With
  1171.   
  1172. End Function
  1173. Private Sub WglrGrid_EnterCell()                                                 '显示当前数据行相关信息
  1174.     
  1175.     With WglrGrid
  1176.         If .Row >= .FixedRows Then
  1177.             '[>>
  1178.             '此处可以填写显示与此网格行相关信息
  1179.             '<<]
  1180.         End If
  1181.     End With
  1182.     
  1183. End Sub
  1184. Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  1185.     
  1186.     '网格得到焦点,如果当前选择行为非数据行
  1187.     '则调整当前焦点至有效数据行
  1188.     
  1189.     With WglrGrid
  1190.         If .Row < .FixedRows And .Rows > .FixedRows Then
  1191.             Changelock = True
  1192.             .Select .FixedRows, .Col
  1193.             Changelock = False
  1194.         End If
  1195.         If .Col < Qslz Then
  1196.             Changelock = True
  1197.             .Select .Row, Qslz
  1198.             Changelock = False
  1199.         End If
  1200.     End With
  1201.     
  1202. End Sub
  1204. Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  1205.     
  1206.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  1207.     If Changelock Then
  1208.         Exit Sub
  1209.     End If
  1210.     
  1211.     '引发网格RowcolChange事件
  1212.     With WglrGrid
  1213.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1214.             .Select 0, 0
  1215.         End If
  1216.     End With
  1217.     
  1218. End Sub
  1219. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
  1221.     If Gdtlock Then
  1222.         Exit Sub
  1223.     End If
  1224.  
  1225.     With WglrGrid
  1226.         If Ydtext.Visible Or YdCombo.Visible Then
  1227.             Gdtlock = True
  1228.             .TopRow = Dqtoprow
  1229.             .LeftCol = Dqleftcol
  1230.             Gdtlock = False
  1231.             Exit Sub
  1232.         End If
  1233.     End With
  1234.     
  1235. End Sub
  1236. Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  1237.   
  1238.     If Changelock Then
  1239.         Exit Sub
  1240.     End If
  1242.     '记录刚刚离开网格单元的行列值
  1243.     Dqlkwgh = WglrGrid.Row
  1244.     Dqlkwgl = WglrGrid.Col
  1246.     '判断是否需要录入数据回写
  1247.     If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1248.         Exit Sub
  1249.     End If
  1250.     
  1251.     Call Lrsjhx
  1252.     
  1253. End Sub
  1254. Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
  1255.    
  1256.     Valilock = True       '屏蔽文本框失去焦点进行有效性判断
  1257.     
  1258.     With WglrGrid
  1259.         If Changelock Then
  1260.             Exit Sub
  1261.         End If
  1262.         If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1263.             Exit Sub
  1264.         End If
  1265.         If .Row <> Dqlkwgh Then
  1266.             If Not Sjhzyxxpd(Dqlkwgh) Then
  1267.                 Exit Sub
  1268.             End If
  1269.         End If
  1270.     End With
  1271.     
  1272.     Call fhyxh
  1273.     Call Xldql
  1274.    
  1275. End Sub
  1276. Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
  1278.     With WglrGrid
  1279.         If .CellWidth = 0 Then Exit Sub
  1280.         Call xswbk
  1281.     End With
  1282.   
  1283. End Sub
  1285. Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
  1286.  
  1287.     Valilock = True
  1288.     Ydtext.Visible = False
  1289.     YdCombo.Visible = False
  1290.     Ydcommand.Visible = False
  1291.     
  1292. End Sub
  1296. Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  1297.     With WglrGrid
  1298.         Select Case KeyCode
  1299.         Case vbKeyEscape                'ESC 键放弃录入
  1300.             Valilock = True
  1301.             .SetFocus
  1302.             Call Ycwbk
  1303.             Valilock = False
  1304.         Case vbKeyReturn                '回 车 键 =13
  1305.             KeyCode = 0
  1306.             .SetFocus
  1307.             Call Lrsjhx
  1308.             Rowjsq = .Row
  1309.             Coljsq = .Col + 1
  1310.             If Coljsq > .Cols - 1 Then
  1311.                 If Rowjsq < .Rows - 1 Then
  1312.                     Rowjsq = Rowjsq + 1
  1313.                 End If
  1314.                 Coljsq = Qslz
  1315.             End If
  1316.             Do While Rowjsq <= .Rows - 1
  1317.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1318.                     Coljsq = Coljsq + 1
  1319.                     If Coljsq > .Cols - 1 Then
  1320.                         Rowjsq = Rowjsq + 1
  1321.                         Coljsq = Qslz
  1322.                     End If
  1323.                 Else
  1324.                     Exit Do
  1325.                 End If
  1326.             Loop
  1327.             .Select Rowjsq, Coljsq
  1328.             
  1329.         Case vbKeyLeft                  '左 箭 头 =37
  1330.             If .Col - 1 = Qslz Then
  1331.                 If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1332.                     GoTo jzzx
  1333.                 End If
  1334.             End If
  1335.             If .Col > Qslz Then
  1336.                 KeyCode = 0
  1337.                 .SetFocus
  1338.                 Call Lrsjhx
  1339.                 Coljsq = .Col - 1
  1340.                 Do While Coljsq > Qslz
  1341.                     If Coljsq - 1 = Qslz Then
  1342.                         If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1343.                             GoTo jzzx
  1344.                         End If
  1345.                     End If
  1346.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1347.                         Coljsq = Coljsq - 1
  1348.                     Else
  1349.                         Exit Do
  1350.                     End If
  1351.                 Loop
  1352.                 .Select .Row, Coljsq
  1353.             End If
  1354.             
  1355.         Case vbKeyRight                 '右 箭 头 =39
  1356.             KeyCode = 0
  1357.             .SetFocus
  1358.             Call Lrsjhx
  1359.             Rowjsq = .Row
  1360.             Coljsq = .Col + 1
  1361.             If Coljsq > .Cols - 1 Then
  1362.                 If Rowjsq < .Rows - 1 Then
  1363.                     Rowjsq = Rowjsq + 1
  1364.                 End If
  1365.                 Coljsq = Qslz
  1366.             End If
  1367.             Do While Rowjsq <= .Rows - 1
  1368.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1369.                     Coljsq = Coljsq + 1
  1370.                     If Coljsq > .Cols - 1 Then
  1371.                         Rowjsq = Rowjsq + 1
  1372.                         Coljsq = Qslz
  1373.                     End If
  1374.                 Else
  1375.                     Exit Do
  1376.                 End If
  1377.             Loop
  1378.             .Select Rowjsq, Coljsq
  1379.         Case Else
  1380.             
  1381.         End Select
  1382.         
  1383. jzzx:
  1384.         
  1385.     End With
  1386.     
  1387. End Sub
  1389. Private Sub YdCombo_LostFocus()
  1390.     
  1391.     With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
  1392.         If Not Valilock Then                           '为TRUE
  1393.             Call Lrsjhx
  1394.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1395.                 Exit Sub
  1396.             End If
  1397.         End If
  1398.     End With
  1399. End Sub
  1401. Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  1402.     
  1403.     Call Lrzdbz
  1404.     
  1405. End Sub
  1407. Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
  1408.     
  1409.     Dim Rowjsq As Long, Coljsq As Long
  1410.     
  1411.     With WglrGrid
  1412.         Select Case KeyCode
  1413.         Case vbKeyF2
  1414.             Call Lrzdbz
  1415.         Case vbKeyEscape                'ESC 键放弃录入
  1416.             Valilock = True
  1417.             Call Ycwbk
  1418.             .SetFocus
  1419.         Case vbKeyReturn                '回 车 键 =13
  1420.             KeyCode = 0
  1421.             .SetFocus
  1422.             Call Lrsjhx
  1423.             Rowjsq = .Row
  1424.             Coljsq = .Col + 1
  1425.             If Coljsq > .Cols - 1 Then
  1426.                 If Rowjsq < .Rows - 1 Then
  1427.                     Rowjsq = Rowjsq + 1
  1428.                 End If
  1429.                 Coljsq = Qslz
  1430.             End If
  1431.             Do While Rowjsq <= .Rows - 1
  1432.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1433.                     Coljsq = Coljsq + 1
  1434.                     If Coljsq > .Cols - 1 Then
  1435.                         Rowjsq = Rowjsq + 1
  1436.                         Coljsq = Qslz
  1437.                     End If
  1438.                 Else
  1439.                     Exit Do
  1440.                 End If
  1441.             Loop
  1442.             If Rowjsq <= .Rows - 1 Then
  1443.                 .Select Rowjsq, Coljsq
  1444.             End If
  1445.             
  1446.         Case vbKeyUp                    '上 箭 头 =38
  1447.             KeyCode = 0
  1448.             .SetFocus
  1449.             Call Lrsjhx
  1450.             If .Row > .FixedRows Then
  1451.                 .Row = .Row - 1
  1452.             End If
  1453.             
  1454.         Case vbKeyDown                  '下 箭 头 =40
  1455.             KeyCode = 0
  1456.             .SetFocus
  1457.             Call Lrsjhx
  1458.             If .Row < .Rows - 1 Then
  1459.                 .Row = .Row + 1
  1460.             End If
  1461.             
  1462.         Case vbKeyLeft                  '左 箭 头 =37
  1463.             If .Col - 1 = Qslz Then
  1464.                 If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1465.                     GoTo jzzx
  1466.                 End If
  1467.             End If
  1468.             If Ydtext.SelStart = 0 And .Col > Qslz Then
  1469.                 KeyCode = 0
  1470.                 .SetFocus
  1471.                 Call Lrsjhx
  1472.                 Coljsq = .Col - 1
  1473.                 Do While Coljsq > Qslz
  1474.                     If Coljsq - 1 = Qslz Then
  1475.                         If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1476.                             GoTo jzzx
  1477.                         End If
  1478.                     End If
  1479.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1480.                         Coljsq = Coljsq - 1
  1481.                     Else
  1482.                         Exit Do
  1483.                     End If
  1484.                 Loop
  1485.                 .Select .Row, Coljsq
  1486.             End If
  1487. jzzx:
  1488.             
  1489.         Case vbKeyRight                 '右 箭 头 =39
  1490.             wblong = Len(Ydtext.Text)
  1491.             If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
  1492.                 KeyCode = 0
  1493.                 .SetFocus
  1494.                 Call Lrsjhx
  1495.                 Rowjsq = .Row
  1496.                 Coljsq = .Col + 1
  1497.                 If Coljsq > .Cols - 1 Then
  1498.                     If Rowjsq < .Rows - 1 Then
  1499.                         Rowjsq = Rowjsq + 1
  1500.                     End If
  1501.                     Coljsq = Qslz
  1502.                 End If
  1503.                 Do While Rowjsq <= .Rows - 1
  1504.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1505.                         Coljsq = Coljsq + 1
  1506.                         If Coljsq > .Cols - 1 Then
  1507.                             Rowjsq = Rowjsq + 1
  1508.                             Coljsq = Qslz
  1509.                         End If
  1510.                     Else
  1511.                         Exit Do
  1512.                     End If
  1513.                 Loop
  1514.                 .Select Rowjsq, Coljsq
  1515.             End If
  1516.         Case Else
  1517.             
  1518.         End Select
  1519.     End With
  1520.     
  1521. End Sub
  1523. Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  1524.     
  1525.     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1526.     
  1527.     If KeyAscii <> 0 Then
  1528.         Call Xyxhbz(Dqlrwgh)
  1529.     End If
  1530.     
  1531. End Sub
  1533. Private Sub ydtext_Change()                              '录入事中变化处理
  1534.     
  1535.     '防止程序改变但不进行处理
  1536.     
  1537.     If Wbkbhlock Then
  1538.         Exit Sub
  1539.     End If
  1540.     
  1541.     With WglrGrid
  1542.         
  1543.         '限制字段录入长度
  1544.         Wbkbhlock = True
  1545.         Select Case GridInt(.Col, 1)
  1546.         Case 8, 11   '金额型
  1547.             Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  1548.         Case 9, 12   '数量型
  1549.             Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  1550.         Case 10      '单价型
  1551.             Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1552.         Case Else    '其他类型
  1553.             If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  1554.                 Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  1555.             End If
  1556.         End Select
  1557.         Wbkbhlock = False
  1558.     End With
  1559.     
  1560. End Sub
  1562. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  1563.     
  1564.     With WglrGrid
  1565.         If Not Valilock Then
  1566.             Call Lrsjhx
  1567.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1568.                 Exit Sub
  1569.             End If
  1570.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1571.                 Exit Sub
  1572.             End If
  1573.         End If
  1574.     End With
  1575.     
  1576. End Sub
  1577. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  1578.     
  1579.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  1580.    
  1581.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1582.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1583.         Exit Sub
  1584.     End If
  1585.     
  1586.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1587.     If Not Fun_AllowInput Then
  1588.         Exit Sub
  1589.     End If
  1590.   
  1591.     '显示文本框前返回有效行列（解决滚动条问题）
  1592.     Call Xldqh
  1593.     Call Xldql
  1594.   
  1595.     '隐藏文本框,帮助按钮,列表组合框
  1596.     Call Ycwbk
  1597.   
  1598.     With WglrGrid
  1599.         Dqlrwgh = .Row
  1600.         Dqlrwgl = .Col
  1601.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1602.             Exit Sub
  1603.         End If
  1604.      
  1605.         Wbkpy = 30
  1606.         Wbkpy1 = 15
  1607.     
  1608.         If GridBoolean(.Col, 3) Then
  1609.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1610.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1611.             YdCombo.Width = .CellWidth - Wbkpy1
  1612.             Call Wbkcl
  1613.             YdCombo.Visible = True
  1614.             YdCombo.SetFocus
  1615.             Ydcommand.Visible = False
  1616.             Ydtext.Visible = False
  1617.         Else
  1618.             If GridBoolean(.Col, 2) Then
  1619.                 Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1620.                 Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1621.                 Ydcommand.Visible = True
  1622.             Else
  1623.                 Ydcommand.Visible = False
  1624.             End If
  1625.      
  1626.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1627.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1628.             
  1629.             If Ydcommand.Visible Then
  1630.                 If Sfblbzkd Then
  1631.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1632.                 Else
  1633.                     Ydtext.Width = .CellWidth - Wbkpy1
  1634.                 End If
  1635.             Else
  1636.                 Ydtext.Width = .CellWidth - Wbkpy1
  1637.             End If
  1638.             
  1639.             Ydtext.Height = .CellHeight - Wbkpy1
  1640.       
  1641.             If GridInt(.Col, 2) <> 0 Then
  1642.                 Ydtext.MaxLength = GridInt(.Col, 2)
  1643.             Else
  1644.                 Ydtext.MaxLength = 3000
  1645.             End If
  1646.       
  1647.             Call Wbkcl
  1648.       
  1649.             Ydtext.Visible = True
  1650.             Ydtext.SetFocus
  1651.         End If
  1652.         
  1653.         Dqtoprow = .TopRow
  1654.         Dqleftcol = .LeftCol
  1655.     
  1656.         '重置锁值
  1657.         Valilock = False
  1658.         Wbkbhlock = False
  1659.         
  1660.     End With
  1661.  
  1662. End Sub
  1664. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  1665.     
  1666.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  1667.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1668.         Exit Function
  1669.     End If
  1670.     
  1671.     '[>>
  1672.     
  1673.     '此处可以填写禁止文本框激活使单据处于录入状态的理由
  1674.     
  1675.     '<<]
  1676.     
  1677.     Fun_AllowInput = True
  1678.     
  1679. End Function
  1681. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  1682.                    
  1683.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  1684.   
  1685.     Wbkpy = 30
  1686.     Wbkpy1 = 15
  1687.     
  1688.     With WglrGrid
  1689.         If YdCombo.Visible Then
  1690.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1691.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1692.             YdCombo.Width = .CellWidth - Wbkpy1
  1693.         End If
  1694.         If Ydcommand.Visible Then
  1695.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1696.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1697.         End If
  1698.         If Ydtext.Visible Then
  1699.             If Ydcommand.Visible Then
  1700.                 If Sfblbzkd Then
  1701.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1702.                 Else
  1703.                     Ydtext.Width = .CellWidth - Wbkpy1
  1704.                 End If
  1705.             Else
  1706.                 Ydtext.Width = .CellWidth - Wbkpy1
  1707.             End If
  1708.       
  1709.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1710.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1711.             Ydtext.Height = .CellHeight - Wbkpy1
  1712.         End If
  1713.    End With
  1715. End Sub
  1717. Private Sub Lrsjhx()                                                   '文本框录入数据回写
  1718.     
  1719.     With WglrGrid
  1720.         If YdCombo.Visible Then
  1721.             .Text = Trim(YdCombo.Text)
  1722.         End If
  1723.         If Ydtext.Visible Then
  1724.             .Text = Trim(Ydtext.Text)
  1725.         End If
  1726.         
  1727.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  1728.         If Zdlrqnr <> Trim(.Text) Then
  1729.             Yxxpdlock = False
  1730.             Hyxxpdlock = False
  1731.         End If
  1732.         
  1733.         '如果字段录入内容不为空则写数据行有效性标志
  1734.         
  1735.         If Len(Trim(.Text)) <> 0 Then
  1736.             Call Xyxhbz(.Row)
  1737.         End If
  1738.         
  1739.         '隐藏文本框,帮助按钮,列表组合框
  1740.         Call Ycwbk
  1741.     End With
  1742.     
  1743. End Sub
  1745. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行，删行快捷键
  1746.     
  1747.     '如果单据操作状态为浏览状态则不能显示录入载体
  1748.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1749.         Exit Sub
  1750.     End If
  1751.     
  1752.     Select Case KeyCode
  1753.     Case vbKeyF2                   '按F2键参照
  1754.         Call xswbk
  1755.         Call Lrzdbz
  1756.     Case vbKeyDelete               '删行
  1757.         Call Scdqfl
  1758.     Case vbKeyInsert               '增行
  1759.         Call zjlrfl
  1760.     End Select
  1761.     
  1762. End Sub
  1763. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
  1765.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1766.     If Not Fun_AllowInput Then
  1767.         Exit Sub
  1768.     End If
  1769.   
  1770.     With WglrGrid
  1771.   
  1772.         '屏 蔽 回 车 键
  1773.         If KeyAscii = vbKeyReturn Then
  1774.             KeyAscii = 0
  1775.             Rowjsq = .Row
  1776.             Coljsq = .Col + 1
  1777.             If Coljsq > .Cols - 1 Then
  1778.                 If Rowjsq < .Rows - 1 Then
  1779.                     Rowjsq = Rowjsq + 1
  1780.                 End If
  1781.                 Coljsq = Qslz
  1782.             End If
  1783.             Do While Rowjsq <= .Rows - 1
  1784.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1785.                     Coljsq = Coljsq + 1
  1786.                     If Coljsq > .Cols - 1 Then
  1787.                         Rowjsq = Rowjsq + 1
  1788.                         Coljsq = Qslz
  1789.                     End If
  1790.                 Else
  1791.                     Exit Do
  1792.                 End If
  1793.             Loop
  1794.           
  1795.             If Rowjsq <= .Rows - 1 Then
  1796.                .Select Rowjsq, Coljsq
  1797.             End If
  1798.        
  1799.              Exit Sub
  1800.         End If
  1801.      
  1802.         '接受用户录入
  1803.         Select Case KeyAscii
  1804.             Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
  1805.           
  1806.                 '显示录入载体
  1807.                 Call xswbk
  1809.             Case Else
  1811.                 '防止非编辑字段SendKeys()出现死循环
  1812.                 If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1813.                    Exit Sub
  1814.                 End If
  1816.                 '如果此字段为列表框录入则调入相应列表框
  1817.                 If GridBoolean(.Col, 3) Then
  1819.                     '列表框录入
  1820.                     Call xswbk
  1821.                 Else
  1823.                     Ydtext.Text = ""
  1824.             
  1825.                     '录入限制
  1826.                     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1827.             
  1828.                     If KeyAscii = 0 Then
  1829.                         Exit Sub
  1830.                     End If
  1832.                     '如果录入字符有效则写有效行数据标志
  1833.                     Call Xyxhbz(.Row)
  1834.                     Call xswbk
  1835.                     Ydtext.Text = ""
  1836.                     Valilock = True
  1837.                     SendKeys Chr(KeyAscii), True
  1838.                     DoEvents
  1839.                     Valilock = False
  1840.                 End If
  1841.         End Select
  1842.     End With
  1843.         
  1844. End Sub
  1846. Private Sub zjlrfl()                                                    '增加录入分录
  1847.     
  1848.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1849.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
  1850.         Exit Sub
  1851.     End If
  1852.     
  1853.     With WglrGrid
  1854.   
  1855.         '处于录入状态不能增行
  1856.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1857.             If Not Fun_Drfrmyxxpd Then
  1858.                 Exit Sub
  1859.             End If
  1860.         Else
  1861.             Exit Sub
  1862.         End If
  1863.     
  1864.         '处于非数据行和最后一行时不能增行
  1865.         If .Row < .FixedRows Or .Row = .Rows - 1 Then
  1866.             Exit Sub
  1867.         End If
  1868.     
  1869.         .AddItem "", .Row
  1870.         .RowHeight(.Row) = Sjhgd
  1871.     
  1872.         If .Row <> .Rows - 1 Then
  1873.             If .TextMatrix(.Row + 1, 0) = "*" Then
  1874.                 .TextMatrix(.Row, 0) = "*"
  1875.             Else
  1876.                 .RemoveItem .Rows - 1
  1877.             End If
  1878.         End If
  1879.         Call Xldqh
  1880.         Call Xldql
  1881.         Hyxxpdlock = False
  1882.     End With
  1883.     
  1884. End Sub
  1886. Private Sub Scdqfl()                                                    '删除当前分录
  1887.     
  1888.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1889.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
  1890.         Exit Sub
  1891.     End If
  1892.     
  1893.     
  1894.     Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean '(Fixed)
  1895.     Dim Sqlstr As String   '临时使用连接字符串
  1896.     
  1897.     With WglrGrid
  1898.         Scqwghz = .Row
  1899.         Scqwglz = .Col
  1900.         
  1901.         If .TextMatrix(.Row, 0) = "*" Then
  1902.             '判断是否为录入状态
  1903.             If Ydtext.Visible Or YdCombo.Visible Then
  1904.                 Sflrzt = True
  1905.                 Validate = True
  1906.                 Call Lrsjhx
  1907.                 Validate = False
  1908.             End If
  1909.             
  1910.             Call Xldqh
  1911.             Changelock = True
  1912.             .Select .Row, 0
  1913.             Changelock = False
  1914.             If Shsfts Then
  1915.                 .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
  1916.                 Tsxx = "请确认是否删除当前记录?"
  1917.                 Yhanswer = Xtxxts(Tsxx, 2, 2)
  1918.                 If Yhanswer = 2 Then
  1919.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  1920.                     Changelock = True
  1921.                     .Select Scqwghz, Scqwglz
  1922.                     Changelock = False
  1923.                     
  1924.                     '如为录入状态,则恢复录入
  1925.                     If Sflrzt Then
  1926.                         Call xswbk
  1927.                     End If
  1928.                     
  1929.                     Exit Sub
  1930.                 End If
  1931.             End If
  1932.             
  1933.             '[>>以下为自定义部分
  1934.             '直接录入，职员ID号取当前行第二列的值，档案序号取取当前行第三列的值
  1935.             '查询列表调用,职员ID号不变，档案序号取行号
  1936.             If int_if = 1 Then
  1937.                 EmpId = Val(WglrGrid.TextMatrix(.Row, 2))
  1938.                 tmpNo = Val(WglrGrid.TextMatrix(.Row, 3))
  1939.             Else
  1940.                 tmpNo = .Row
  1941.             End If
  1942.             
  1943.             On Error GoTo Swcwcl
  1944.             
  1945.             Cw_DataEnvi.DataConnect.BeginTrans
  1946.                    
  1947.             
  1948.             If Val(WglrGrid.TextMatrix(.Row, 1)) <> 0 Then
  1949.                 Sqlstr = "DELETE Rs_ArMain WHERE ArSort ='" & Lbl_ArName.Tag & "' AND EmpId = " & EmpId & " AND SNo = " & tmpNo
  1950.                 Cw_DataEnvi.DataConnect.Execute (Sqlstr)
  1951.                 '重新排序
  1952.                 Sqlstr = "EXECUTE Rs_Sp_ArMainOrder  '" & Lbl_ArName.Tag & "'," & EmpId & " ," & tmpNo & ",0"
  1953.                 Cw_DataEnvi.DataConnect.Execute (Sqlstr)
  1954.             End If
  1955.             
  1956.             Cw_DataEnvi.DataConnect.CommitTrans
  1957.             
  1958.             '<<以上为自定义部分]
  1959.             
  1960.             .RemoveItem .Row                                                    '正常的删除行
  1961.             
  1962.         '[>>
  1963.             For i = .Row To .Rows - 2                                           'SNo
  1964.                 .TextMatrix(i, 2) = .Row
  1965.             Next i
  1967.             
  1968.         '<<]
  1969.             If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1970.                 .AddItem ""
  1971.                 .RowHeight(.Rows - 1) = Sjhgd
  1972.             End If
  1973.             
  1974.             Changelock = True
  1975.             .Select .Row, Scqwglz
  1976.             Changelock = False
  1977.         End If
  1978.         
  1979.     End With
  1980.     
  1981.     Exit Sub
  1982.     
  1983.     '[>>事务错误处理
  1984.     
  1985. Swcwcl:
  1986.     
  1987.     Cw_DataEnvi.DataConnect.RollbackTrans
  1988.     
  1989.     Tsxx = "删除过程中出现错误!"
  1990.     Call Xtxxts(Tsxx, 0, 1)
  1991.     Exit Sub
  1992.     '<<]
  1993. End Sub
  1995. Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  1996.     
  1997.     If Not GridBoolean(Sjl, 5) Then
  1998.         Exit Sub
  1999.     End If
  2000.     
  2001.     With WglrGrid
  2002.         If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
  2003.             .TextMatrix(sjh, Sjl) = ""
  2004.         End If
  2005.     End With
  2006.     
  2007. End Sub
  2009. Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  2010.     
  2011.     With WglrGrid
  2012.         If .Row >= .FixedRows Then
  2013.             If .TextMatrix(.Row, 0) <> "*" Then
  2014.                 For Rowjsq = .FixedRows To .Rows - 1
  2015.                     If .TextMatrix(Rowjsq, 0) <> "*" Then
  2016.                         Exit For
  2017.                     End If
  2018.                 Next Rowjsq
  2019.                 If Rowjsq <= .Rows - 1 Then
  2020.                     Changelock = True
  2021.                     .Select Rowjsq, .Col
  2022.                     Changelock = False
  2023.                 Else
  2024.                     Changelock = True
  2025.                     .Select .Rows - 1, .Col
  2026.                     Changelock = False
  2027.                 End If
  2028.             End If
  2029.             Call Xldqh
  2030.         End If
  2031.     End With
  2032.     
  2033. End Sub
  2035. Private Sub Xldqh()                                                      '显露当前行
  2036.     
  2037.     Dim Toprowte As Long
  2038.     
  2039.     With WglrGrid
  2040.         Toprowte = 0
  2041.         
  2042.         Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
  2043.             Toprowte = .TopRow
  2044.             .TopRow = .TopRow + 1
  2045.         Loop
  2046.         
  2047.         Toprowte = 0
  2048.         
  2049.         Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
  2050.             Toprowte = .TopRow
  2051.             .TopRow = .TopRow - 1
  2052.         Loop
  2053.     End With
  2054.     
  2055. End Sub
  2057. Private Sub Xldql()                                                     '显露当前列
  2058.     
  2059.     Dim Leftcolte As Long
  2060.     
  2061.     With WglrGrid
  2062.         If .Col >= Qslz And .Col >= .FixedCols Then
  2063.             If .LeftCol > .Col Then
  2064.                 .LeftCol = .Col
  2065.             End If
  2066.             Leftcolte = 0
  2067.             Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
  2068.                 Leftcolte = .LeftCol
  2069.                 .LeftCol = .LeftCol + 1
  2070.             Loop
  2071.         End If
  2072.     End With
  2073.     
  2074. End Sub
  2076. Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
  2077.  
  2078.     With WglrGrid
  2079.         For Coljsq = Qslz To .Cols - 1
  2080.             If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
  2081.                 pdhwk = False
  2082.                 Exit Function
  2083.             End If
  2084.         Next Coljsq
  2085.         pdhwk = True
  2086.     End With
  2087.     
  2088. End Function
  2090. Private Sub Xyxhbz(sjh As Long)                                         '写行有效性标志,并判断是否增行
  2091.    
  2092.    With WglrGrid
  2093.         If .TextMatrix(sjh, 0) = "*" Then
  2094.             Exit Sub
  2095.         End If
  2096.         .TextMatrix(sjh, 0) = "*"
  2097.         If sjh >= .Rows - Fzxwghs - 1 Then
  2098.             .AddItem ""
  2099.             .RowHeight(.Rows - 1) = Sjhgd
  2100.         End If
  2101.    End With
  2102.    
  2103. End Sub
  2104. Private Sub WglrGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  2105.     
  2106.     Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
  2108. End Sub
  2110. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  2111.     
  2112.     Select Case Button.Key
  2113.         Case "bcgs"                                       '保存表格格式
  2114.             Call Bcwggs(WglrGrid, GridCode, GridStr())
  2115.         Case "hfmrgs"                                     '恢复默认格式
  2116.             Call Hfmrgs(WglrGrid, GridCode, GridStr())
  2117.     End Select
  2118.     
  2119. End Sub
  2121. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  2122.     
  2123.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  2124.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  2125.     Bbxbtgs = 1                                         '报 表 小 标 题 行 数
  2126.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  2127.     ReDim Bbxbt(1 To Bbxbtgs)
  2128.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  2129.     
  2130.     ReportTitle = Lbl_ArName.Caption
  2131.     '职工号和姓名在小标题栏显示
  2132.     If Lbl_EmpNo.Visible = True Then
  2133.         Bbxbt(1) = Lbl_EmpNo.Caption & "  " & Lbl_EmpName.Caption
  2134.     Else
  2135.         Bbxbtgs = 1
  2136.         ReDim Bbxbt(1 To Bbxbtgs)
  2137.         ReDim bbxbtzzxs(1 To Bbxbtgs)
  2138.     End If
  2139.     If Bbbwhgs <> 0 Then
  2140.         ReDim Bbbwh(1 To Bbbwhgs)
  2141.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  2142.     End If
  2143.     
  2144.     Bbzbt = ReportTitle
  2145.     
  2146.     Call Scyxsjb(WglrGrid)                               '生成报表数据
  2147.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  2148.     
  2149.     If Not bbylte Then
  2150.         Unload DY_Tybbyldy
  2151.     End If
  2152.     
  2153. End Sub