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

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

企业管理

开发平台：

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 Khgl_ValMark 
  5.    BackColor       =   &H00C0C0C0&
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "选择考核要素"
  8.    ClientHeight    =   5730
  9.    ClientLeft      =   675
  10.    ClientTop       =   720
  11.    ClientWidth     =   8235
  12.    HelpContextID   =   231200602
  13.    Icon            =   "选择考核要素.frx":0000
  14.    KeyPreview      =   -1  'True
  15.    LinkTopic       =   "Form4"
  16.    MaxButton       =   0   'False
  17.    MinButton       =   0   'False
  18.    ScaleHeight     =   5730
  19.    ScaleWidth      =   8235
  20.    StartUpPosition =   1  '所有者中心
  21.    Begin VB.CommandButton Ydcommand 
  22.       Height          =   300
  23.       Left            =   6570
  24.       Picture         =   "选择考核要素.frx":1042
  25.       Style           =   1  'Graphical
  26.       TabIndex        =   1
  27.       Top             =   2010
  28.       Visible         =   0   'False
  29.       Width           =   300
  30.    End
  31.    Begin VB.PictureBox Pic_Title 
  32.       BackColor       =   &H00FFFFFF&
  33.       Height          =   855
  34.       Left            =   0
  35.       Picture         =   "选择考核要素.frx":13CC
  36.       ScaleHeight     =   795
  37.       ScaleWidth      =   11715
  38.       TabIndex        =   7
  39.       Top             =   540
  40.       Width           =   11775
  41.       Begin MSComctlLib.ImageList ImageList1 
  42.          Left            =   60
  43.          Top             =   480
  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   =   25
  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.          EndProperty
  154.       End
  155.       Begin MSComctlLib.ImageCombo Imgcbo_Check 
  156.          Height          =   315
  157.          Left            =   1020
  158.          TabIndex        =   13
  159.          Top             =   210
  160.          Width           =   2415
  161.          _ExtentX        =   4260
  162.          _ExtentY        =   556
  163.          _Version        =   393216
  164.          ForeColor       =   -2147483640
  165.          BackColor       =   -2147483643
  166.       End
  167.       Begin VB.Label tsLabel 
  168.          BackColor       =   &H80000018&
  169.          BackStyle       =   0  'Transparent
  170.          Caption         =   "考核指标:"
  171.          ForeColor       =   &H00000000&
  172.          Height          =   195
  173.          Index           =   3
  174.          Left            =   60
  175.          TabIndex        =   12
  176.          Top             =   300
  177.          Width           =   975
  178.       End
  179.       Begin VB.Label tsLabel 
  180.          BackColor       =   &H80000018&
  181.          BackStyle       =   0  'Transparent
  182.          ForeColor       =   &H00000000&
  183.          Height          =   195
  184.          Index           =   2
  185.          Left            =   7440
  186.          TabIndex        =   11
  187.          Top             =   300
  188.          Width           =   645
  189.       End
  190.       Begin VB.Label tsLabel 
  191.          BackColor       =   &H80000018&
  192.          BackStyle       =   0  'Transparent
  193.          Caption         =   "要素权重和:"
  194.          ForeColor       =   &H00000000&
  195.          Height          =   195
  196.          Index           =   1
  197.          Left            =   6360
  198.          TabIndex        =   10
  199.          Top             =   300
  200.          Width           =   1035
  201.       End
  202.       Begin VB.Label Lab_TitleText 
  203.          BackStyle       =   0  'Transparent
  204.          ForeColor       =   &H00FF0000&
  205.          Height          =   225
  206.          Left            =   750
  207.          TabIndex        =   9
  208.          Top             =   690
  209.          Width           =   1455
  210.       End
  211.       Begin VB.Label tsLabel 
  212.          BackColor       =   &H80000018&
  213.          BackStyle       =   0  'Transparent
  214.          Caption         =   "考核类别:"
  215.          ForeColor       =   &H00000000&
  216.          Height          =   195
  217.          Index           =   0
  218.          Left            =   3480
  219.          TabIndex        =   8
  220.          Top             =   300
  221.          Width           =   3435
  222.       End
  223.    End
  224.    Begin VB.TextBox Ydtext 
  225.       BackColor       =   &H00C0FFFF&
  226.       BorderStyle     =   0  'None
  227.       Height          =   330
  228.       Left            =   4860
  229.       MultiLine       =   -1  'True
  230.       TabIndex        =   0
  231.       Top             =   1620
  232.       Visible         =   0   'False
  233.       Width           =   1185
  234.    End
  235.    Begin VB.ComboBox YdCombo 
  236.       Height          =   300
  237.       Left            =   4860
  238.       Style           =   2  'Dropdown List
  239.       TabIndex        =   3
  240.       Top             =   2010
  241.       Visible         =   0   'False
  242.       Width           =   1665
  243.    End
  244.    Begin VB.Timer Timer1 
  245.       Interval        =   1
  246.       Left            =   6090
  247.       Top             =   1560
  248.    End
  249.    Begin VSFlex8Ctl.VSFlexGrid WglrGrid 
  250.       Height          =   4155
  251.       Left            =   60
  252.       TabIndex        =   4
  253.       Top             =   1500
  254.       Width           =   8025
  255.       _ExtentX        =   14155
  256.       _ExtentY        =   7329
  257.       Appearance      =   1
  258.       BorderStyle     =   1
  259.       Enabled         =   -1  'True
  260.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  261.          Name            =   "宋体"
  262.          Size            =   9
  263.          Charset         =   134
  264.          Weight          =   400
  265.          Underline       =   0   'False
  266.          Italic          =   0   'False
  267.          Strikethrough   =   0   'False
  268.       EndProperty
  269.       MousePointer    =   0
  270.       BackColor       =   16777215
  271.       ForeColor       =   -2147483640
  272.       BackColorFixed  =   12632256
  273.       ForeColorFixed  =   -2147483630
  274.       BackColorSel    =   -2147483635
  275.       ForeColorSel    =   -2147483634
  276.       BackColorBkg    =   -2147483636
  277.       BackColorAlternate=   16777215
  278.       GridColor       =   -2147483633
  279.       GridColorFixed  =   -2147483632
  280.       TreeColor       =   -2147483632
  281.       FloodColor      =   192
  282.       SheetBorder     =   -2147483642
  283.       FocusRect       =   1
  284.       HighLight       =   1
  285.       AllowSelection  =   -1  'True
  286.       AllowBigSelection=   -1  'True
  287.       AllowUserResizing=   0
  288.       SelectionMode   =   0
  289.       GridLines       =   1
  290.       GridLinesFixed  =   2
  291.       GridLineWidth   =   1
  292.       Rows            =   50
  293.       Cols            =   10
  294.       FixedRows       =   1
  295.       FixedCols       =   1
  296.       RowHeightMin    =   0
  297.       RowHeightMax    =   0
  298.       ColWidthMin     =   0
  299.       ColWidthMax     =   0
  300.       ExtendLastCol   =   0   'False
  301.       FormatString    =   ""
  302.       ScrollTrack     =   0   'False
  303.       ScrollBars      =   3
  304.       ScrollTips      =   0   'False
  305.       MergeCells      =   0
  306.       MergeCompare    =   0
  307.       AutoResize      =   -1  'True
  308.       AutoSizeMode    =   0
  309.       AutoSearch      =   0
  310.       MultiTotals     =   -1  'True
  311.       SubtotalPosition=   1
  312.       OutlineBar      =   0
  313.       OutlineCol      =   0
  314.       Ellipsis        =   0
  315.       ExplorerBar     =   0
  316.       PicturesOver    =   0   'False
  317.       FillStyle       =   0
  318.       RightToLeft     =   0   'False
  319.       PictureType     =   0
  320.       TabBehavior     =   0
  321.       OwnerDraw       =   0
  322.       Editable        =   0   'False
  323.       ShowComboButton =   -1  'True
  324.       WordWrap        =   0   'False
  325.       TextStyle       =   0
  326.       TextStyleFixed  =   0
  327.       OleDragMode     =   0
  328.       OleDropMode     =   0
  329.       DataMode        =   0
  330.       VirtualData     =   -1  'True
  331.    End
  332.    Begin MSComctlLib.Toolbar Tlb_Action 
  333.       Align           =   1  'Align Top
  334.       Height          =   570
  335.       Left            =   0
  336.       TabIndex        =   2
  337.       Top             =   0
  338.       Width           =   8235
  339.       _ExtentX        =   14526
  340.       _ExtentY        =   1005
  341.       ButtonWidth     =   820
  342.       ButtonHeight    =   953
  343.       AllowCustomize  =   0   'False
  344.       Wrappable       =   0   'False
  345.       Appearance      =   1
  346.       Style           =   1
  347.       ImageList       =   "ImageList1"
  348.       _Version        =   393216
  349.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  350.          NumButtons      =   8
  351.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  352.             Caption         =   "设置"
  353.             Key             =   "ymsz"
  354.             Object.ToolTipText     =   "打印页面设置"
  355.             ImageKey        =   "sz"
  356.          EndProperty
  357.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  358.             Caption         =   "打印"
  359.             Key             =   "dy"
  360.             Object.ToolTipText     =   "打印当前单据或Ctrl+P"
  361.             ImageKey        =   "dy"
  362.          EndProperty
  363.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  364.             Caption         =   "预览"
  365.             Key             =   "yl"
  366.             ImageKey        =   "yl"
  367.          EndProperty
  368.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  369.             Style           =   3
  370.          EndProperty
  371.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  372.             Caption         =   "删行"
  373.             Key             =   "sh"
  374.             Object.ToolTipText     =   "删除当前记录行或Delete"
  375.             ImageKey        =   "sh"
  376.          EndProperty
  377.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  378.             Style           =   3
  379.          EndProperty
  380.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  381.             Caption         =   "帮助"
  382.             Key             =   "bz"
  383.             ImageKey        =   "bz"
  384.          EndProperty
  385.          BeginProperty Button8 {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            =   6510
  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            =   5100
  427.       TabIndex        =   5
  428.       Top             =   1650
  429.       Visible         =   0   'False
  430.       Width           =   345
  431.    End
  432. End
  433. Attribute VB_Name = "Khgl_ValMark"
  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. '*    最后修改时间:2001/12/13
  444. '*    备        注:程序中所有依实际情况自定义部分均用[>> <<]括起,注意此种录入需要修改"Sub Scdqfl"
  445. '*
  446. '*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
  447. '*
  448. '*    3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) 1-浏览 2-修改
  449. '**************************************************************************************************
  450.  
  451.  '以下为自定义变量
  452. Public str_TitleCode As String                  '考核类别编码
  453. Dim str_CheckCode As String                     '考核指标编码
  454.  
  455. '其它固定使用变量
  456. Dim Tsxx As String                              '系统信息提示(Fixed)
  457. Dim ReportTitle As String                       '报表主标题(Fixed)
  458.     
  459. '以下为固定使用变量(网格)
  460. Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
  461. Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
  462. Dim GridCode As String                          '显示网格网格代码
  463. Dim GridInf() As Variant                        '整个网格设置信息
  464. Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
  465. Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
  466. Dim Sfxshjwg As Boolean                         '是否显示合计网格
  467. Dim Qslz As Long                                '网格隐藏(非操作显示)列数
  468. Dim Sjhgd As Double                             '网格数据行高度
  469. Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
  470. Dim GridStr()  As String                        '网格列信息(字符型)
  471. Dim GridInt() As Integer                        '网格列信息(整型)
  472. Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
  473. Dim Dqlrwgh As Long                             '当前录入数据网格行
  474. Dim Dqlrwgl As Long                             '当前录入数据网格列
  475. Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
  476. Dim Dqlkwgl As Long                             '刚刚离开网格列
  477. Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
  478. Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
  479. Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
  480. Dim Wbkbhlock As Boolean                        '文本框改变值锁
  481. Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
  482. Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
  483. Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
  484. Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
  485. Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
  486. Dim Shsfts As Boolean                           '删除记录行是否提示
  487. Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
  488.     
  489. Private Sub Form_KeyPress(KeyAscii As Integer)      '控制焦点转移和限制录入字符"'"
  491.     Select Case KeyAscii
  492.         Case 39           '屏蔽字符"'"
  493.             KeyAscii = 0
  494.     End Select
  495.     
  496. End Sub
  498. Private Sub Form_Load()                              '窗 体 装 入
  499.   
  500.     '初始化各种锁值(Fixed)
  501.     Changelock = False             '网格行列改变控制锁
  502.     Gdtlock = False                '滚动条滚动控制
  503.     Yxxpdlock = True               '字段有效性判断锁
  504.     Hyxxpdlock = True              '行有效性判断锁
  505.     Wbkbhlock = False              '文本框内容改变锁
  506.    
  507.     '报表主标题及报表编码(Fixed)
  508.     ReportTitle = "选择考核要素"
  509.     XtReportCode = "Khgl_ValMark"
  510.     Load Dyymctbl
  512.     '调 入 网 格(Fixed)
  513.     GridCode = "Khgl_ValMark"      '网格属性编码
  514.     Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  515.     
  516.     Qslz = GridInf(1)
  517.     Sjhgd = GridInf(2)
  518.     Pmbcsjhs = GridInf(3)
  519.     Fzxwghs = GridInf(4)
  520.     Sfblbzkd = GridInf(5)
  521.     Shsfts = GridInf(6)
  522.     Sfxshjwg = GridInf(7)
  523.     Szzls = WglrGrid.Cols - 1
  524.     
  525.     '设置标题栏宽度、网格宽度高度(Fixed)
  526.     Pic_Title.Move 50, Pic_Title.Top, Me.Width - 150, Pic_Title.Height
  527.     WglrGrid.Move 50, Pic_Title.Top + Pic_Title.Height, Me.Width - 150
  528.     WglrGrid.Height = Me.Height - WglrGrid.Top - 380
  530.     '填充考核要素列表框
  531.     Xtcdcsfz = str_TitleCode
  532.     FillImageCombo Imgcbo_Check, "Khgl_Target", 1
  533.     str_CheckCode = GetComboKey(Imgcbo_Check, 0)
  536.     '生成查询结果
  537.     Call Sub_Query
  538.     
  539.     '权重和
  540.     TsLabel(2).Caption = Format(Weigh(), "###0.00")
  541.     
  542.     '设置状态为修改状态
  543.     Lab_OperStatus = "2"
  544.   
  545. End Sub
  547. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  548.     Dim Answer As Integer
  549.     
  550.         '调 整 网 格
  551.     With WglrGrid
  552.         '判断是否有辅助行和录入行,如没有则加行
  553.         Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  554.            .AddItem ""
  555.            .RowHeight(.Rows - 1) = Sjhgd
  556.         Loop
  557.     End With
  558.     
  559.     
  560.     '如果权重和不等于1，提示是否退出
  561.     If (Val(TsLabel(2).Caption) <> 1) Then
  562.         If (Val(TsLabel(2).Caption) <> 0) Then
  563.             Tsxx = "权重和不等于1,是否关闭?"
  564.             Answer = Xtxxts(Tsxx, 2, 2)
  565.             If Answer = 1 Then
  566.                 Cancel = False
  567.             Else
  568.                 Cancel = True
  569.             End If
  570.         End If
  571.     End If
  572. End Sub
  574. Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
  576.     '调入其它窗体或功能产生的有效性判断(包括数据回写)
  577.     If Not Fun_Drfrmyxxpd Then
  578.        Cancel = True
  579.        Exit Sub
  580.     End If
  582.     '卸载打印页面窗体
  583.     Unload Dyymctbl
  584.    
  585. End Sub
  587. Private Sub Sub_Query()                              '生成查询结果
  588.    
  589.     Dim Sqlstr As String                           '临时使用字符串
  590.     Dim RecTemp As New ADODB.Recordset             '临时使用动态集
  591.     Dim Jsqte As Long                              '临时计数器
  593.     '禁止网格刷新动作,为加快网格显示速度(Fixed)
  594.     WglrGrid.Redraw = False
  596.     '查询字符串
  597.     Sqlstr = " SELECT Kh_ValMark.*,Kh_Factor.FactorName  FROM Kh_ValMark LEFT OUTER JOIN " & _
  598.              " Kh_Factor ON Kh_ValMark.FactorCode = Kh_Factor.FactorCode " & _
  599.              " Where Kh_ValMark.TitleCode='" + str_TitleCode + "' " & _
  600.              " and Kh_ValMark.CheckCode='" + str_CheckCode + "'" & _
  601.              " ORDER BY Kh_ValMark.ValMarkID"
  602.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  603.       
  604.     With RecTemp
  605.         WglrGrid.Rows = WglrGrid.FixedRows
  606.         Jsqte = WglrGrid.FixedRows
  607.         
  608.         Do While Not .EOF
  609.               
  610.             WglrGrid.AddItem ""
  611.             WglrGrid.TextMatrix(Jsqte, 0) = "*"                                                                         '有效记录标识
  612.             WglrGrid.TextMatrix(Jsqte, 1) = .Fields("ValMarkID")                                                         '记录唯一标识
  613.             WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("FactorCode") & "")                 '指标编码
  614.             WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("FactorName") & "")                 '指标名称
  615.             
  616.            
  617.             If .Fields("FactorWeigh") <> 0 Then
  618.                 WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = .Fields("FactorWeigh")                      '指标权重
  619.             End If
  620.             
  621.             '<<]
  622.            
  623.             WglrGrid.RowHeight(Jsqte) = Sjhgd
  624.             .MoveNext
  625.             Jsqte = Jsqte + 1
  626.         Loop
  627.     End With
  628.             
  629.     '将网格刷新解禁(Fixed)
  630.     WglrGrid.Redraw = True
  632.     '调整网格(Fixed)
  633.     Call Sub_AdjustGrid
  634.              
  635. End Sub
  642. Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
  643.      
  644.     '屏蔽文本框,下拉组合框有效性判断
  645.      
  646.     Valilock = True
  647.      
  648.     '屏蔽网格失去焦点产生的有效性判断
  649.      
  650.     Changelock = True
  651.      
  652.     Select Case Button.Key
  653.         Case "ymsz"                                          '页面设置
  654.             Dyymctbl.Show 1
  655.         Case "yl"                                            '预 览
  656.             If Fun_Drfrmyxxpd Then
  657.                 Call bbyl(True)
  658.             End If
  659.         Case "dy"                                            '打 印
  660.             If Fun_Drfrmyxxpd Then
  661.                 Call bbyl(False)
  662.             End If
  663.         Case "sh"                                            '删 行
  664.             Call Scdqfl
  665.         Case "bz"                                            '帮 助
  666.             Call F1bz
  667.         Case "fh"                                            '退 出
  668.             Unload Me
  669.     End Select
  670.        
  671.     '解 锁
  672.     Valilock = False
  673.     Changelock = False
  674.         
  675. End Sub
  677. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  679.     If Shift = 2 Then
  680.         Select Case UCase(Chr(KeyCode))
  681.             Case "P"                   'Ctrl+P 打印
  682.                 If Tlb_Action.Buttons("dy").Enabled Then
  683.                     Call bbyl(False)
  684.                 End If
  685.             End Select
  686.     End If
  687.     
  688. End Sub
  690. Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
  691.     
  692.     Dim xswbrr As String
  693.     
  694.     With WglrGrid
  695.         Zdlrqnr = Trim(.Text)
  696.         xswbrr = Trim(.Text)
  697.     
  698.         If GridBoolean(.Col, 3) Then   '列表框录入
  699.     
  700.             '填充列表框程序
  701.             Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
  702.         Else
  703.             Wbkbhlock = True
  704.        
  705.             '====以下为用户自定义
  706.             Ydtext.Text = xswbrr
  707.             '====以上为用户自定义
  708.          
  709.             Wbkbhlock = False
  710.             Ydtext.SelStart = Len(Ydtext.Text)
  711.         End If
  712.     End With
  713.     
  714. End Sub
  716. Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
  717.  '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
  719.     Dim Str_JudgeText As String                 '临时有效性判断字段内容(Fixed)
  720.     Dim Coljsq As Long                          '临时列计数器(Fixed)
  721.     Dim RecTemp As New ADODB.Recordset          '临时使用动态集(Fixed)
  722.     Dim Sqlstr As String                        '临时使用查询字符串(Fixed)
  723.     Dim str_Temp As String                      '考核要素
  725.     With WglrGrid
  726.     
  727.         '非录入状态或非数据行则其有效性为合法(Fixed)
  728.         If Yxxpdlock Or .Row < .FixedRows Then
  729.             sjzdyxxpd = True
  730.             Exit Function
  731.         End If
  732.       
  733.         '取得当前要判断字段内容(Fixed)
  734.         Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
  735.       
  736.         '根据不同字段进行相应的处理(依据其逻辑编号)
  737.         Select Case GridStr(Dqpdwgl, 1)
  738.          
  739.             '[>>以下为自定义部分
  740.          
  741.             Case "002"                   '考核要素(字段不为空则做有效性判断及事后处理)
  742.                 If Not Trim(Str_JudgeText) = "" Then
  743.                     '1.放置字段有效性判断
  744.                     
  745.                     Sqlstr = "SELECT FactorCode,FactorName From Kh_Factor Where CheckCode='" + str_CheckCode + "' and  FactorCode='" & Str_JudgeText & "' Or FactorName='" & Str_JudgeText & "'"
  746.                     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  747.                   
  748.                     If RecTemp.EOF Then
  749.                         Tsxx = "考核要素不存在!"
  750.                         GoTo Lrcwcl
  751.                     End If
  752.                     
  753.                     
  754.                     '2.放置字段事后处理程序
  755.                     .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("FactorCode") & "")      '显示考核要素编码
  756.                     .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("FactorName") & "")      '显示考核要素名称
  757.                     
  758.                     str_Temp = Trim((.TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls))))
  759.                     For Jsqte = .FixedRows To .Rows - 1
  760.                         If (Dqpdwgh <> Jsqte) And (str_Temp = Trim((.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls))))) Then
  761.                             Tsxx = "考核要素重复!"
  762.                             GoTo Lrcwcl
  763.                             End If
  764.                     Next Jsqte
  765.                 Else
  766.                     '3.清空相关字段
  767.                     .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = ""                                             '显示考核要素名称
  768.                 End If
  769.                 
  770.                 
  771.             Case "004"                   '考核权重(字段不为空则做有效性判断及事后处理)
  772.                 If Not Trim(Str_JudgeText) = "" Then
  773.                     '1.放置字段有效性判断
  774.                                       
  775.                     If (Val(Trim(Str_JudgeText)) > 1) Or (Val(Trim(Str_JudgeText)) <= 0) Then
  776.                         Tsxx = "指标权重有效值为大于0并且小于等于1!"
  777.                         GoTo Lrcwcl
  778.                     End If
  779.                     
  780.                     TsLabel(2).Caption = Format(Weigh(), "###0.00")
  781.                     
  782.                     '2.清空相关字段
  783.                     
  784.                 End If
  785.                 
  786.             '<<以上为自定义部分]
  787.         End Select
  788.      
  789.         '字段录入正确后为零字段清空(Fixed)
  790.         Call Qkwlzd(Dqpdwgh, Dqpdwgl)
  791.      
  792.         '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
  793.         sjzdyxxpd = True
  794.         Yxxpdlock = True
  795.         Exit Function
  796.     End With
  797.   
  798. Lrcwcl:    '录入错误处理(Fixed)
  800.     With WglrGrid
  801.         '给出错误提示信息
  802.         Call Xtxxts(Tsxx, 0, 1)
  803.       
  804.         '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
  805.         Changelock = True
  806.         .Select Dqpdwgh, Dqpdwgl
  807.         Changelock = False
  808.         Call xswbk
  809.       
  810.         '函数返回False
  811.         sjzdyxxpd = False
  812.         Exit Function
  813.     End With
  814.     
  815. End Function
  817. Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
  818.  
  819.     Dim Lrywlz As Long                     '录入错误列值(Fixed)
  820.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  821.     Dim Sqlstr As String                   '临时查询字符串
  822.  
  823.     With WglrGrid
  824.  
  825.         '判断行为空和无效数据行则清除当前行
  826.         If .Rows <= .FixedRows Then Exit Function   ' 如果没有记录，则退出
  827.         If .TextMatrix(Yxxpdh, 0) <> "*" Then
  828.             Sjhzyxxpd = True
  829.             Exit Function
  830.         Else
  831.             If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
  832.                 If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
  833.                     Changelock = True
  834.                     .RemoveItem Yxxpdh
  835.                     
  836.                     If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  837.                         .AddItem ""
  838.                         .RowHeight(.Rows - 1) = Sjhgd
  839.                     End If
  840.                     
  841.                     Changelock = False
  842.                     Sjhzyxxpd = True
  843.                     Exit Function
  844.                 End If
  845.             End If
  846.         End If
  847.   
  848.         '行没有发生变化则不进行有效性判断
  849.         If Hyxxpdlock Then
  850.             Sjhzyxxpd = True
  851.             Exit Function
  852.         End If
  854.         '以下为自定义部分[
  856.         '1.1首先进行单个不能为空或不能为零判断(Fixed)
  857.         For Jsqte = Qslz To .Cols - 1
  858.                
  859.             '字段不能为空
  860.             If GridInt(Jsqte, 5) = 1 Then
  861.                 If Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
  862.                     Tsxx = GridStr(Jsqte, 2)
  863.                     Lrywlz = Jsqte
  864.                     GoTo Lrcwcl
  865.                     Exit For
  866.                 End If
  867.             End If
  868.                
  869.             '字段不能为零
  870.             If GridInt(Jsqte, 5) = 2 Then
  871.                 If Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
  872.                     Tsxx = GridStr(Jsqte, 2)
  873.                     Lrywlz = Jsqte
  874.                     GoTo Lrcwcl
  875.                     Exit For
  876.                 End If
  877.             End If
  878.                
  879.             Next Jsqte
  882.         '1.2进行其他有效性判断,编写格式同1.1
  883.         
  884.             
  885.         '2.放置行处理程序(当数据行通过有效性判断)
  886.        
  887.         On Error GoTo Swcwcl
  889.         Cw_DataEnvi.DataConnect.BeginTrans
  890.          
  891.         With RecTemp
  893.             '判断此行记录ID是否为零,如不为零则修改记录;否则为新增记录,然后将新增后记录ID回写网格
  894.             If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 1))) <> 0 Then
  895.                 If .State = 1 Then .Close
  896.                 .Open "SELECT Kh_ValMark.* From Kh_ValMark WHERE ValMarkID = " & Val(WglrGrid.TextMatrix(Yxxpdh, 1)), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  898.                 If Not .EOF Then
  899.                     .Fields("FactorCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)))  '考核要素
  900.                     .Fields("FactorWeigh") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))  '指标权重
  901.                     .Update
  902.                 End If
  903.                  
  904.             Else
  905.                
  906.                 If .State = 1 Then .Close
  907.                 .Open "SELECT Kh_ValMark.* From Kh_ValMark WHERE 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  908.                  
  909.                 .AddNew
  910.                 .Fields("TitleCode") = str_TitleCode                                                         '考核类别
  911.                 .Fields("CheckCode") = str_CheckCode                                                         '考核指标
  912.                 .Fields("FactorCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)))     '考核要素
  913.                 .Fields("FactorWeigh") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))     '指标权重
  914.                 .Update
  915.                     
  916.                 WglrGrid.TextMatrix(Yxxpdh, 1) = .Fields("ValMarkID")                                        '记录唯一标识
  917.                     
  918.             End If
  919.                  
  920.         End With
  922.         Cw_DataEnvi.DataConnect.CommitTrans
  923.          
  924.     End With
  926.     '以上为自定义部分]
  928.     Sjhzyxxpd = True
  929.     Hyxxpdlock = True
  930.     Exit Function
  932. Swcwcl:
  934.     Cw_DataEnvi.DataConnect.RollbackTrans
  935.     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  936.     Call Xtxxts(Tsxx, 0, 1)
  937.     Exit Function
  939. Lrcwcl:      '录入错误处理
  941.     With WglrGrid
  942.         Call Xtxxts(Tsxx, 0, 1)
  943.         Changelock = True
  944.         .Select Yxxpdh, Lrywlz
  945.         Changelock = False
  946.         Call xswbk
  948.         Sjhzyxxpd = False
  949.         Exit Function
  950.     End With
  951.     
  952. End Function
  954. Private Function Weigh() As Double       '计算权重和
  955.     Weigh = 0
  956.         '调 整 网 格
  957.     With WglrGrid
  958.         For Jsqte = .FixedRows To .Rows - 1
  959.             Weigh = Weigh + Val(WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)))
  960.         Next Jsqte
  962.     End With
  963.     
  964.     Exit Function
  965. End Function
  966. Private Sub Imgcbo_Check_Click()
  967.     '读取组合框的选定值并刷新网格
  968.     str_CheckCode = GetComboKey(Imgcbo_Check, 0)
  969.     Call Sub_Query
  970.     '权重和
  971.     TsLabel(2).Caption = Format(Weigh(), "###0.00")
  972. End Sub
  976. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
  977. Private Sub Sub_AdjustGrid()
  979.     '调 整 网 格
  980.     With WglrGrid
  981.         '加 1 保持一行录入行
  982.         If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  983.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  984.             For Jsqte = .FixedRows To .Rows - 1
  985.                 .RowHeight(Jsqte) = Sjhgd
  986.             Next Jsqte
  987.         Else
  988.             '判断是否有辅助行和录入行,如没有则加行
  989.             Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  990.                 .AddItem ""
  991.                 .RowHeight(.Rows - 1) = Sjhgd
  992.             Loop
  993.         End If
  994.     End With
  995.   
  996. End Sub
  998. Private Sub Lrzdbz()                                                      '录入字段帮助
  999.   
  1000.     If Not Ydcommand.Visible Then
  1001.         Exit Sub
  1002.     End If
  1003.    
  1004.     With WglrGrid
  1005.      
  1006.         Valilock = True
  1007.     
  1008.         '处理通用部分
  1009.         Changelock = True        '调入另外窗体必须加锁
  1010.         '传递当前考核指标
  1011.         Xtcdcsfz = str_CheckCode
  1012.         Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
  1013.         Changelock = False
  1014.         
  1015.         If Len(Xtfhcs) <> 0 Then
  1016.             If GridInt(.Col, 7) = 0 Then
  1017.                 Ydtext.Text = Xtfhcs
  1018.             Else
  1019.                 Ydtext.Text = Xtfhcsfz
  1020.             End If
  1021.         End If
  1022.             
  1023.         Valilock = False
  1024.         
  1025.         If Ydtext.Visible Then
  1026.             Ydtext.SetFocus
  1027.         End If
  1028.     
  1029.     End With
  1030.     
  1031. End Sub
  1033. Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
  1034.    
  1035.     Call Cxxswbk
  1036.     
  1037. End Sub
  1039. Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  1040.   
  1041.     Fun_Drfrmyxxpd = True
  1042.     
  1043.     With WglrGrid
  1044.         '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  1045.         
  1046.         If Ydtext.Visible Or YdCombo.Visible Then
  1047.             Call Lrsjhx
  1048.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1049.                 Fun_Drfrmyxxpd = False
  1050.                 Exit Function
  1051.             End If
  1052.         End If
  1053.         
  1054.         '进行行有效性判断
  1055.         If Not Sjhzyxxpd(.Row) Then
  1056.             Fun_Drfrmyxxpd = False
  1057.             Exit Function
  1058.         End If
  1059.     End With
  1060.   
  1061. End Function
  1063. Private Sub WglrGrid_EnterCell()                                                 '显示当前数据行相关信息
  1064.    
  1065.     With WglrGrid
  1066.         If .Row >= .FixedRows Then
  1067.             '[>>
  1068.                 '此处可以填写显示与此网格行相关信息
  1069.             '<<]
  1070.         End If
  1071.    End With
  1072.    
  1073. End Sub
  1075. Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  1077.     '网格得到焦点,如果当前选择行为非数据行
  1078.     '则调整当前焦点至有效数据行
  1080.     With WglrGrid
  1081.         If .Row < .FixedRows And .Rows > .FixedRows Then
  1082.             Changelock = True
  1083.             .Select .FixedRows, .Col
  1084.             Changelock = False
  1085.         End If
  1086.         If .Col < Qslz Then
  1087.             Changelock = True
  1088.             .Select .Row, Qslz
  1089.             Changelock = False
  1090.         End If
  1091.     End With
  1093. End Sub
  1095. Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  1097.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  1098.     If Changelock Then
  1099.         Exit Sub
  1100.     End If
  1102.     '引发网格RowcolChange事件
  1103.     With WglrGrid
  1104.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1105.             .Select 0, 0
  1106.         End If
  1107.     End With
  1109. End Sub
  1111. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
  1113.     If Gdtlock Then
  1114.         Exit Sub
  1115.     End If
  1116.  
  1117.     With WglrGrid
  1118.         If Ydtext.Visible Or YdCombo.Visible Then
  1119.             Gdtlock = True
  1120.             .TopRow = Dqtoprow
  1121.             .LeftCol = Dqleftcol
  1122.             Gdtlock = False
  1123.             Exit Sub
  1124.         End If
  1125.     End With
  1126.     
  1127. End Sub
  1129. Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  1130.   
  1131.     If Changelock Then
  1132.         Exit Sub
  1133.     End If
  1135.     '记录刚刚离开网格单元的行列值
  1136.     Dqlkwgh = WglrGrid.Row
  1137.     Dqlkwgl = WglrGrid.Col
  1139.     '判断是否需要录入数据回写
  1140.     If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1141.         Exit Sub
  1142.     End If
  1143.     
  1144.     Call Lrsjhx
  1145.     
  1146. End Sub
  1148. Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
  1149.    
  1150.     Valilock = True       '屏蔽文本框失去焦点进行有效性判断
  1151.     
  1152.     With WglrGrid
  1153.         If Changelock Then
  1154.             Exit Sub
  1155.         End If
  1156.         If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1157.             Exit Sub
  1158.         End If
  1159.         If .Row <> Dqlkwgh Then
  1160.             If Not Sjhzyxxpd(Dqlkwgh) Then
  1161.                 Exit Sub
  1162.             End If
  1163.         End If
  1164.     End With
  1165.     
  1166.     Call fhyxh
  1167.     Call Xldql
  1168.    
  1169. End Sub
  1171. Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
  1173.     With WglrGrid
  1174.         Call xswbk
  1175.     End With
  1176.   
  1177. End Sub
  1179. Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
  1180.  
  1181.     Valilock = True
  1182.     Ydtext.Visible = False
  1183.     YdCombo.Visible = False
  1184.     Ydcommand.Visible = False
  1185.     
  1186. End Sub
  1188. Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  1189.     With WglrGrid
  1190.         Select Case KeyCode
  1191.             Case vbKeyEscape                'ESC 键放弃录入
  1192.                 Valilock = True
  1193.                 .SetFocus
  1194.                 Call Ycwbk
  1195.                 Valilock = False
  1196.             Case vbKeyReturn                '回 车 键 =13
  1197.                 KeyCode = 0
  1198.                 .SetFocus
  1199.                 Call Lrsjhx
  1200.                 Rowjsq = .Row
  1201.                 Coljsq = .Col + 1
  1202.                 If Coljsq > .Cols - 1 Then
  1203.                     If Rowjsq < .Rows - 1 Then
  1204.                         Rowjsq = Rowjsq + 1
  1205.                     End If
  1206.                     Coljsq = Qslz
  1207.                 End If
  1208.                 Do While Rowjsq <= .Rows - 1
  1209.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1210.                         Coljsq = Coljsq + 1
  1211.                         If Coljsq > .Cols - 1 Then
  1212.                             Rowjsq = Rowjsq + 1
  1213.                             Coljsq = Qslz
  1214.                         End If
  1215.                     Else
  1216.                         Exit Do
  1217.                     End If
  1218.                 Loop
  1219.                 .Select Rowjsq, Coljsq
  1220.                 
  1221.             Case vbKeyLeft                  '左 箭 头 =37
  1222.                 If .Col - 1 = Qslz Then
  1223.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1224.                         GoTo jzzx
  1225.                     End If
  1226.                 End If
  1227.                 If .Col > Qslz Then
  1228.                     KeyCode = 0
  1229.                     .SetFocus
  1230.                     Call Lrsjhx
  1231.                     Coljsq = .Col - 1
  1232.                     Do While Coljsq > Qslz
  1233.                         If Coljsq - 1 = Qslz Then
  1234.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1235.                                 GoTo jzzx
  1236.                             End If
  1237.                         End If
  1238.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1239.                             Coljsq = Coljsq - 1
  1240.                         Else
  1241.                             Exit Do
  1242.                         End If
  1243.                     Loop
  1244.                     .Select .Row, Coljsq
  1245.                 End If
  1247.             Case vbKeyRight                 '右 箭 头 =39
  1248.                 KeyCode = 0
  1249.                 .SetFocus
  1250.                 Call Lrsjhx
  1251.                 Rowjsq = .Row
  1252.                 Coljsq = .Col + 1
  1253.                 If Coljsq > .Cols - 1 Then
  1254.                     If Rowjsq < .Rows - 1 Then
  1255.                         Rowjsq = Rowjsq + 1
  1256.                     End If
  1257.                     Coljsq = Qslz
  1258.                 End If
  1259.                 Do While Rowjsq <= .Rows - 1
  1260.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1261.                         Coljsq = Coljsq + 1
  1262.                         If Coljsq > .Cols - 1 Then
  1263.                             Rowjsq = Rowjsq + 1
  1264.                             Coljsq = Qslz
  1265.                         End If
  1266.                     Else
  1267.                         Exit Do
  1268.                     End If
  1269.                 Loop
  1270.                 .Select Rowjsq, Coljsq
  1271.             Case Else
  1272.             
  1273.         End Select
  1274.    
  1275. jzzx:
  1276.    
  1277.     End With
  1278.     
  1279. End Sub
  1281. Private Sub YdCombo_LostFocus()
  1282.   
  1283.     With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
  1284.         If Not Valilock Then                           '为TRUE
  1285.             Call Lrsjhx
  1286.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1287.                 Exit Sub
  1288.             End If
  1289.         End If
  1290.     End With
  1291. End Sub
  1293. Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  1294.    
  1295.     Call Lrzdbz
  1296.    
  1297. End Sub
  1299. Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
  1300.    
  1301.     Dim Rowjsq As Long, Coljsq As Long
  1302.     
  1303.     With WglrGrid
  1304.         Select Case KeyCode
  1305.             Case vbKeyF2
  1306.                 Call Lrzdbz
  1307.             Case vbKeyEscape                'ESC 键放弃录入
  1308.                 Valilock = True
  1309.                 Call Ycwbk
  1310.                 .SetFocus
  1311.             Case vbKeyReturn                '回 车 键 =13
  1312.                 KeyCode = 0
  1313.                 .SetFocus
  1314.                 Call Lrsjhx
  1315.                 Rowjsq = .Row
  1316.                 Coljsq = .Col + 1
  1317.                 If Coljsq > .Cols - 1 Then
  1318.                     If Rowjsq < .Rows - 1 Then
  1319.                         Rowjsq = Rowjsq + 1
  1320.                     End If
  1321.                     Coljsq = Qslz
  1322.                 End If
  1323.                 Do While Rowjsq <= .Rows - 1
  1324.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1325.                         Coljsq = Coljsq + 1
  1326.                         If Coljsq > .Cols - 1 Then
  1327.                             Rowjsq = Rowjsq + 1
  1328.                             Coljsq = Qslz
  1329.                         End If
  1330.                     Else
  1331.                         Exit Do
  1332.                     End If
  1333.                 Loop
  1334.                 If Rowjsq <= .Rows - 1 Then
  1335.                     .Select Rowjsq, Coljsq
  1336.                 End If
  1337.                 
  1338.             Case vbKeyUp                    '上 箭 头 =38
  1339.                 KeyCode = 0
  1340.                 .SetFocus
  1341.                 Call Lrsjhx
  1342.                 If .Row > .FixedRows Then
  1343.                     .Row = .Row - 1
  1344.                 End If
  1345.                 
  1346.             Case vbKeyDown                  '下 箭 头 =40
  1347.                 KeyCode = 0
  1348.                 .SetFocus
  1349.                 Call Lrsjhx
  1350.                 If .Row < .Rows - 1 Then
  1351.                     .Row = .Row + 1
  1352.                 End If
  1353.                 
  1354.             Case vbKeyLeft                  '左 箭 头 =37
  1355.                 If .Col - 1 = Qslz Then
  1356.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1357.                         GoTo jzzx
  1358.                     End If
  1359.                 End If
  1360.                 If Ydtext.SelStart = 0 And .Col > Qslz Then
  1361.                     KeyCode = 0
  1362.                     .SetFocus
  1363.                     Call Lrsjhx
  1364.                     Coljsq = .Col - 1
  1365.                     Do While Coljsq > Qslz
  1366.                         If Coljsq - 1 = Qslz Then
  1367.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1368.                                 GoTo jzzx
  1369.                             End If
  1370.                         End If
  1371.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1372.                             Coljsq = Coljsq - 1
  1373.                         Else
  1374.                             Exit Do
  1375.                         End If
  1376.                     Loop
  1377.                     .Select .Row, Coljsq
  1378.                 End If
  1379. jzzx:
  1380.            
  1381.             Case vbKeyRight                 '右 箭 头 =39
  1382.                 wblong = Len(Ydtext.Text)
  1383.                 If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
  1384.                     KeyCode = 0
  1385.                     .SetFocus
  1386.                     Call Lrsjhx
  1387.                     Rowjsq = .Row
  1388.                     Coljsq = .Col + 1
  1389.                     If Coljsq > .Cols - 1 Then
  1390.                         If Rowjsq < .Rows - 1 Then
  1391.                             Rowjsq = Rowjsq + 1
  1392.                         End If
  1393.                         Coljsq = Qslz
  1394.                     End If
  1395.                     Do While Rowjsq <= .Rows - 1
  1396.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1397.                             Coljsq = Coljsq + 1
  1398.                             If Coljsq > .Cols - 1 Then
  1399.                                 Rowjsq = Rowjsq + 1
  1400.                                 Coljsq = Qslz
  1401.                             End If
  1402.                         Else
  1403.                             Exit Do
  1404.                         End If
  1405.                     Loop
  1406.                     .Select Rowjsq, Coljsq
  1407.                 End If
  1408.             Case Else
  1409.             
  1410.         End Select
  1411.     End With
  1412.     
  1413. End Sub
  1415. Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  1417.     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1418.     
  1419.     If KeyAscii <> 0 Then
  1420.         Call Xyxhbz(Dqlrwgh)
  1421.     End If
  1422.     
  1423. End Sub
  1425. Private Sub ydtext_Change()                              '录入事中变化处理
  1427.     '防止程序改变但不进行处理
  1429.     If Wbkbhlock Then
  1430.         Exit Sub
  1431.     End If
  1433.     With WglrGrid
  1435.         '限制字段录入长度
  1436.          Wbkbhlock = True
  1437.         Select Case GridInt(.Col, 1)
  1438.             Case 8, 11   '金额型
  1439.                 Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  1440.             Case 9, 12   '指标权重型
  1441.                 Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  1442.             Case 10      '单价型
  1443.                 Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1444.             Case Else    '其他类型
  1445.                 If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  1446.                     Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  1447.                 End If
  1448.         End Select
  1449.         Wbkbhlock = False
  1450.     End With
  1451.     
  1452. End Sub
  1454. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  1455.   
  1456.     With WglrGrid
  1457.         If Not Valilock Then
  1458.             Call Lrsjhx
  1459.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1460.                 Exit Sub
  1461.             End If
  1462.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1463.                 Exit Sub
  1464.             End If
  1465.         End If
  1466.     End With
  1467.   
  1468. End Sub
  1470. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  1471.     
  1472.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  1473.   
  1474.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1475.     If Not Fun_AllowInput Then
  1476.         Exit Sub
  1477.     End If
  1478.   
  1479.     '显示文本框前返回有效行列（解决滚动条问题）
  1480.     Call Xldqh
  1481.     Call Xldql
  1482.   
  1483.     '隐藏文本框,帮助按钮,列表组合框
  1484.     Call Ycwbk
  1485.   
  1486.     With WglrGrid
  1487.         Dqlrwgh = .Row
  1488.         Dqlrwgl = .Col
  1489.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1490.             Exit Sub
  1491.         End If
  1492.      
  1493.         Wbkpy = 30
  1494.         Wbkpy1 = 15
  1495.     
  1496.         If GridBoolean(.Col, 3) Then
  1497.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1498.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1499.             YdCombo.Width = .CellWidth - Wbkpy1
  1500.             Call Wbkcl
  1501.             YdCombo.Visible = True
  1502.             YdCombo.SetFocus
  1503.             Ydcommand.Visible = False
  1504.             Ydtext.Visible = False
  1505.         Else
  1506.             If GridBoolean(.Col, 2) Then
  1507.                 Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1508.                 Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1509.                 Ydcommand.Visible = True
  1510.             Else
  1511.                 Ydcommand.Visible = False
  1512.             End If
  1513.      
  1514.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1515.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1516.             
  1517.             If Ydcommand.Visible Then
  1518.                 If Sfblbzkd Then
  1519.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1520.                 Else
  1521.                     Ydtext.Width = .CellWidth - Wbkpy1
  1522.                 End If
  1523.             Else
  1524.                 Ydtext.Width = .CellWidth - Wbkpy1
  1525.             End If
  1526.             
  1527.             Ydtext.Height = .CellHeight - Wbkpy1
  1528.       
  1529.             If GridInt(.Col, 2) <> 0 Then
  1530.                 Ydtext.MaxLength = GridInt(.Col, 2)
  1531.             Else
  1532.                 Ydtext.MaxLength = 3000
  1533.             End If
  1534.       
  1535.             Call Wbkcl
  1536.       
  1537.             Ydtext.Visible = True
  1538.             Ydtext.SetFocus
  1539.         End If
  1540.         
  1541.         Dqtoprow = .TopRow
  1542.         Dqleftcol = .LeftCol
  1543.     
  1544.         '重置锁值
  1545.         Valilock = False
  1546.         Wbkbhlock = False
  1547.         
  1548.     End With
  1549.  
  1550. End Sub
  1552. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  1553.    
  1554.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  1555.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1556.         Exit Function
  1557.     End If
  1558.    
  1559.     '[>>
  1560.     
  1561.     '此处可以填写禁止文本框激活使单据处于录入状态的理由
  1562.     Dim Sqlstr As String
  1563.     Dim rec_temp As New Recordset
  1564.        '被考核结果单项否决表使用
  1565.     Sqlstr = " select 1 from Kh_Limen,Kh_Result WHERE Kh_Limen.ResultID=Kh_Result.ResultID" & _
  1566.              " and Kh_Result.TitleCode like '" & str_TitleCode & "%'" & _
  1567.              " and Kh_Limen.FactorCode='" & Trim(WglrGrid.TextMatrix(WglrGrid.Row, Sydz("002", GridStr(), Szzls))) & "'"
  1568.     Set rec_temp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1569.     '如果被使用并且时编码列则不允许修改
  1570.     If rec_temp.RecordCount > 0 And WglrGrid.Col = Sydz("002", GridStr(), Szzls) Then
  1571.         Exit Function
  1572.     End If
  1573.                 
  1574.     '被考核数据子表使用
  1575.     Sqlstr = " select 1 from Kh_BaseSub,Kh_BaseMain WHERE Kh_BaseSub.BaseMainID=Kh_BaseMain.BaseMainID" & _
  1576.              " and Kh_BaseMain.TitleCode like '" & str_TitleCode & "%'" & _
  1577.              " and Kh_BaseSub.FactorCode='" & Trim(WglrGrid.TextMatrix(WglrGrid.Row, Sydz("002", GridStr(), Szzls))) & "'"
  1578.     Set rec_temp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1579.     
  1580.     '如果被使用并且时编码列则不允许修改
  1581.     If rec_temp.RecordCount > 0 And WglrGrid.Col = Sydz("002", GridStr(), Szzls) Then
  1582.         Exit Function
  1583.     End If
  1584.     
  1585.     '<<]
  1586.    
  1587.     Fun_AllowInput = True
  1588.     
  1589. End Function
  1591. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  1592.                    
  1593.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  1594.   
  1595.     Wbkpy = 30
  1596.     Wbkpy1 = 15
  1597.     
  1598.     With WglrGrid
  1599.         If YdCombo.Visible Then
  1600.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1601.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1602.             YdCombo.Width = .CellWidth - Wbkpy1
  1603.         End If
  1604.         If Ydcommand.Visible Then
  1605.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1606.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1607.         End If
  1608.         If Ydtext.Visible Then
  1609.             If Ydcommand.Visible Then
  1610.                 If Sfblbzkd Then
  1611.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1612.                 Else
  1613.                     Ydtext.Width = .CellWidth - Wbkpy1
  1614.                 End If
  1615.             Else
  1616.                 Ydtext.Width = .CellWidth - Wbkpy1
  1617.             End If
  1618.       
  1619.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1620.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1621.             Ydtext.Height = .CellHeight - Wbkpy1
  1622.         End If
  1623.    End With
  1625. End Sub
  1627. Private Sub Lrsjhx()                                                   '文本框录入数据回写
  1628.   
  1629.     With WglrGrid
  1630.         If YdCombo.Visible Then
  1631.             .Text = Trim(YdCombo.Text)
  1632.         End If
  1633.         If Ydtext.Visible Then
  1634.             .Text = Trim(Ydtext.Text)
  1635.         End If
  1636.    
  1637.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  1638.         If Zdlrqnr <> Trim(.Text) Then
  1639.             Yxxpdlock = False
  1640.             Hyxxpdlock = False
  1641.         End If
  1642.    
  1643.         '如果字段录入内容不为空则写数据行有效性标志
  1644.    
  1645.         If Len(Trim(.Text)) <> 0 Then
  1646.             Call Xyxhbz(.Row)
  1647.         End If
  1648.    
  1649.         '隐藏文本框,帮助按钮,列表组合框
  1650.         Call Ycwbk
  1651.     End With
  1652.     
  1653. End Sub
  1655. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行，删行快捷键
  1656.   
  1657.     '如果单据操作状态为浏览状态则不能显示录入载体
  1658.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1659.         Exit Sub
  1660.     End If
  1662.     Select Case KeyCode
  1663.         Case vbKeyF2                   '按F2键参照
  1664.             Call xswbk
  1665.         Call Lrzdbz
  1666.             Case vbKeyDelete               '删行
  1667.         Call Scdqfl
  1668.             Case vbKeyInsert               '增行
  1669.         Call zjlrfl
  1670.     End Select
  1671.     
  1672. End Sub
  1674. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
  1676.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1677.     If Not Fun_AllowInput Then
  1678.         Exit Sub
  1679.     End If
  1680.   
  1681.     With WglrGrid
  1682.   
  1683.         '屏 蔽 回 车 键
  1684.         If KeyAscii = vbKeyReturn Then
  1685.             KeyAscii = 0
  1686.             Rowjsq = .Row
  1687.             Coljsq = .Col + 1
  1688.             If Coljsq > .Cols - 1 Then
  1689.                 If Rowjsq < .Rows - 1 Then
  1690.                     Rowjsq = Rowjsq + 1
  1691.                 End If
  1692.                 Coljsq = Qslz
  1693.             End If
  1694.             Do While Rowjsq <= .Rows - 1
  1695.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1696.                     Coljsq = Coljsq + 1
  1697.                     If Coljsq > .Cols - 1 Then
  1698.                         Rowjsq = Rowjsq + 1
  1699.                         Coljsq = Qslz
  1700.                     End If
  1701.                 Else
  1702.                     Exit Do
  1703.                 End If
  1704.             Loop
  1705.           
  1706.             If Rowjsq <= .Rows - 1 Then
  1707.                .Select Rowjsq, Coljsq
  1708.             End If
  1709.        
  1710.              Exit Sub
  1711.         End If
  1712.      
  1713.         '接受用户录入
  1714.         Select Case KeyAscii
  1715.             Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
  1716.           
  1717.                 '显示录入载体
  1718.                 Call xswbk
  1720.             Case Else
  1722.                 '防止非编辑字段SendKeys()出现死循环
  1723.                 If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1724.                    Exit Sub
  1725.                 End If
  1727.                 '如果此字段为列表框录入则调入相应列表框
  1728.                 If GridBoolean(.Col, 3) Then
  1730.                     '列表框录入
  1731.                     Call xswbk
  1732.                 Else
  1734.                     Ydtext.Text = ""
  1735.             
  1736.                     '录入限制
  1737.                     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1738.             
  1739.                     If KeyAscii = 0 Then
  1740.                         Exit Sub
  1741.                     End If
  1743.                     '如果录入字符有效则写有效行数据标志
  1744.                     Call Xyxhbz(.Row)
  1745.                     Call xswbk
  1746.                     Ydtext.Text = ""
  1747.                     Valilock = True
  1748.                     SendKeys Chr(KeyAscii), True
  1749.                     DoEvents
  1750.                     Valilock = False
  1751.                 End If
  1752.         End Select
  1753.     End With
  1754.         
  1755. End Sub
  1757. Private Sub zjlrfl()                                                    '增加录入分录
  1758.   
  1759.     With WglrGrid
  1760.   
  1761.         '处于录入状态不能增行
  1762.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1763.             If Not Fun_Drfrmyxxpd Then
  1764.                 Exit Sub
  1765.             End If
  1766.         Else
  1767.             Exit Sub
  1768.         End If
  1769.     
  1770.         '处于非数据行和最后一行时不能增行
  1771.         If .Row < .FixedRows Or .Row = .Rows - 1 Then
  1772.             Exit Sub
  1773.         End If
  1774.     
  1775.         .AddItem "", .Row
  1776.         .RowHeight(.Row) = Sjhgd
  1777.     
  1778.         If .Row <> .Rows - 1 Then
  1779.             If .TextMatrix(.Row + 1, 0) = "*" Then
  1780.                 .TextMatrix(.Row, 0) = "*"
  1781.             Else
  1782.                 .RemoveItem .Rows - 1
  1783.             End If
  1784.         End If
  1785.         Call Xldqh
  1786.         Call Xldql
  1787.         Hyxxpdlock = False
  1788.     End With
  1789.     
  1790. End Sub
  1792. Private Sub Scdqfl()                                                    '删除当前分录
  1793.  
  1794.     Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean '(Fixed)
  1795.     Dim Sqlstr As String   '临时使用连接字符串
  1796.     Dim rec_temp As New Recordset   '临时记录集
  1797.  
  1798.     With WglrGrid
  1799.         Scqwghz = .Row
  1800.         Scqwglz = .Col
  1801.         
  1802.         If .TextMatrix(.Row, 0) = "*" Then
  1803.             '判断是否为录入状态
  1804.             If Ydtext.Visible Or YdCombo.Visible Then
  1805.                 Sflrzt = True
  1806.                 Validate = True
  1807.                 Call Lrsjhx
  1808.                 Validate = False
  1809.             End If
  1810.        
  1811.             Call Xldqh
  1812.             Changelock = True
  1813.             .Select .Row, 0
  1814.             Changelock = False
  1815.             If Shsfts Then
  1816.                 .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
  1817.                 Tsxx = "请确认是否删除当前记录?"
  1818.                 yhAnswer = Xtxxts(Tsxx, 2, 2)
  1819.                 If yhAnswer = 2 Then
  1820.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  1821.                     Changelock = True
  1822.                     .Select Scqwghz, Scqwglz
  1823.                     Changelock = False
  1824.               
  1825.                     '如为录入状态,则恢复录入
  1826.                     If Sflrzt Then
  1827.                        Call xswbk
  1828.                     End If
  1829.               
  1830.                     Exit Sub
  1831.                 End If
  1832.             End If
  1833.        
  1834.             '[>>以下为自定义部分
  1835.        
  1836.             On Error GoTo Swcwcl
  1837.     
  1838.             Cw_DataEnvi.DataConnect.BeginTrans
  1839.        
  1840.             If Val(WglrGrid.TextMatrix(.Row, 1)) <> 0 Then
  1841.                 '被考核结果单项否决表使用
  1842.                 Sqlstr = " select 1 from Kh_Limen,Kh_Result WHERE Kh_Limen.ResultID=Kh_Result.ResultID" & _
  1843.                          " and Kh_Result.TitleCode like '" & str_TitleCode & "%'" & _
  1844.                          " and Kh_Limen.FactorCode='" & Trim(WglrGrid.TextMatrix(.Row, Sydz("002", GridStr(), Szzls))) & "'"
  1845.                 Set rec_temp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1846.                 If rec_temp.RecordCount > 0 Then
  1847.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  1848.                     Changelock = True
  1849.                     .Select Scqwghz, Scqwglz
  1850.                     Changelock = False
  1851.               
  1852.                     '如为录入状态,则恢复录入
  1853.                     If Sflrzt Then
  1854.                        Call xswbk
  1855.                     End If
  1856.                     
  1857.                     Tsxx = "该考核要素已经被使用,不能删除!"
  1858.                     Call Xtxxts(Tsxx, 0, 1)
  1859.                     Cw_DataEnvi.DataConnect.RollbackTrans
  1860.                     Exit Sub
  1861.                 End If
  1862.                 
  1863.                 '被考核数据子表使用
  1864.                 Sqlstr = " select 1 from Kh_BaseSub,Kh_BaseMain WHERE Kh_BaseSub.BaseMainID=Kh_BaseMain.BaseMainID" & _
  1865.                          " and Kh_BaseMain.TitleCode like '" & str_TitleCode & "%'" & _
  1866.                          " and Kh_BaseSub.FactorCode='" & Trim(WglrGrid.TextMatrix(.Row, Sydz("002", GridStr(), Szzls))) & "'"
  1867.                 Set rec_temp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1868.                 If rec_temp.RecordCount > 0 Then
  1869.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  1870.                     Changelock = True
  1871.                     .Select Scqwghz, Scqwglz
  1872.                     Changelock = False
  1873.               
  1874.                     '如为录入状态,则恢复录入
  1875.                     If Sflrzt Then
  1876.                        Call xswbk
  1877.                     End If
  1878.                     
  1879.                     Tsxx = "该考核要素已经被使用,不能删除!"
  1880.                     Call Xtxxts(Tsxx, 0, 1)
  1881.                     Cw_DataEnvi.DataConnect.RollbackTrans
  1882.                     Exit Sub
  1883.                 End If
  1884.             
  1885.             
  1886.                 Sqlstr = "Delete Kh_ValMark From Kh_ValMark WHERE ValMarkID = " & Val(WglrGrid.TextMatrix(.Row, 1))
  1887.                 Cw_DataEnvi.DataConnect.Execute (Sqlstr)
  1888.             End If
  1889.        
  1890.             Cw_DataEnvi.DataConnect.CommitTrans
  1891.                         
  1892.        
  1893.             '<<以上为自定义部分]
  1894.        
  1895.             .RemoveItem .Row
  1896.  
  1897.             If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1898.                 .AddItem ""
  1899.                 .RowHeight(.Rows - 1) = Sjhgd
  1900.             End If
  1901.             
  1902.             Changelock = True
  1903.             .Select .Row, Scqwglz
  1904.             Changelock = False
  1905.         End If
  1906.         
  1907.         '刷新权重和
  1908.         TsLabel(2).Caption = Format(Weigh(), "###0.00")
  1909.         
  1910.     End With
  1911.  
  1912.     Exit Sub
  1913.  
  1914.     '[>>事务错误处理
  1915.     
  1916. Swcwcl:
  1918.     Cw_DataEnvi.DataConnect.RollbackTrans
  1919.         
  1920.     WglrGrid.Cell(flexcpBackColor, WglrGrid.Row, Qslz, WglrGrid.Row, WglrGrid.Cols - 1) = &H80000005
  1921.     Changelock = True
  1922.     WglrGrid.Select Scqwghz, Scqwglz
  1923.     Changelock = False
  1925.     '如为录入状态,则恢复录入
  1926.     If Sflrzt Then
  1927.        Call xswbk
  1928.     End If
  1929.     
  1930.     If Err.Number = -2147217873 Then              '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
  1931.         Tsxx = "该考核要素已经被使用,不能删除!"
  1932.         Call Xtxxts(Tsxx, 0, 1)
  1933.         Exit Sub
  1934.     Else
  1935.         Tsxx = "出现未知情况,该考核要素不能被删除!"
  1936.         Call Xtxxts(Tsxx, 0, 1)
  1937.         Exit Sub
  1938.     End If
  1939.     '<<]
  1940. End Sub
  1942. Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  1944.     If Not GridBoolean(Sjl, 5) Then
  1945.         Exit Sub
  1946.     End If
  1947.     
  1948.     With WglrGrid
  1949.         If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
  1950.             .TextMatrix(sjh, Sjl) = ""
  1951.         End If
  1952.     End With
  1953.   
  1954. End Sub
  1956. Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  1957.   
  1958.     With WglrGrid
  1959.         If .Row >= .FixedRows Then
  1960.             If .TextMatrix(.Row, 0) <> "*" Then
  1961.                 For Rowjsq = .FixedRows To .Rows - 1
  1962.                     If .TextMatrix(Rowjsq, 0) <> "*" Then
  1963.                         Exit For
  1964.                     End If
  1965.                 Next Rowjsq
  1966.                 If Rowjsq <= .Rows - 1 Then
  1967.                     Changelock = True
  1968.                     .Select Rowjsq, .Col
  1969.                     Changelock = False
  1970.                 Else
  1971.                     Changelock = True
  1972.                     .Select .Rows - 1, .Col
  1973.                     Changelock = False
  1974.                 End If
  1975.             End If
  1976.             Call Xldqh
  1977.         End If
  1978.   End With
  1979.   
  1980. End Sub
  1982. Private Sub Xldqh()                                                      '显露当前行
  1984.     Dim Toprowte As Long
  1985.     
  1986.     With WglrGrid
  1987.         Toprowte = 0
  1988.         
  1989.         Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
  1990.             Toprowte = .TopRow
  1991.             .TopRow = .TopRow + 1
  1992.         Loop
  1993.         
  1994.         Toprowte = 0
  1995.         
  1996.         Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
  1997.             Toprowte = .TopRow
  1998.             .TopRow = .TopRow - 1
  1999.         Loop
  2000.     End With
  2001.     
  2002. End Sub
  2004. Private Sub Xldql()                                                     '显露当前列
  2005.  
  2006.     Dim Leftcolte As Long
  2007.     
  2008.     With WglrGrid
  2009.         If .Col >= Qslz And .Col >= .FixedCols Then
  2010.             If .LeftCol > .Col Then
  2011.                 .LeftCol = .Col
  2012.             End If
  2013.             Leftcolte = 0
  2014.             Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
  2015.                 Leftcolte = .LeftCol
  2016.                 .LeftCol = .LeftCol + 1
  2017.             Loop
  2018.         End If
  2019.     End With
  2020.     
  2021. End Sub
  2023. Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
  2024.  
  2025.     With WglrGrid
  2026.         For Coljsq = Qslz To .Cols - 1
  2027.             If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
  2028.                 pdhwk = False
  2029.                 Exit Function
  2030.             End If
  2031.         Next Coljsq
  2032.         pdhwk = True
  2033.     End With
  2034.     
  2035. End Function
  2037. Private Sub Xyxhbz(sjh As Long)                                         '写行有效性标志,并判断是否增行
  2038.    
  2039.    With WglrGrid
  2040.         If .TextMatrix(sjh, 0) = "*" Then
  2041.             Exit Sub
  2042.         End If
  2043.         .TextMatrix(sjh, 0) = "*"
  2044.         If sjh >= .Rows - Fzxwghs - 1 Then
  2045.             .AddItem ""
  2046.             .RowHeight(.Rows - 1) = Sjhgd
  2047.         End If
  2048.    End With
  2049.    
  2050. End Sub
  2052. Private Sub WglrGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  2053.     
  2054.     Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
  2056. End Sub
  2058. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  2059.     
  2060.     Select Case Button.Key
  2061.         Case "bcgs"                                       '保存表格格式
  2062.             Call Bcwggs(WglrGrid, GridCode, GridStr())
  2063.         Case "hfmrgs"                                     '恢复默认格式
  2064.             Call Hfmrgs(WglrGrid, GridCode, GridStr())
  2065.     End Select
  2066.     
  2067. End Sub
  2069. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  2070.   
  2071.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  2072.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  2073.     Bbxbtgs = 2                                          '报 表 小 标 题 行 数
  2074.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  2075.     ReDim Bbxbt(1 To Bbxbtgs)
  2076.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  2077.     
  2078.     If Bbbwhgs <> 0 Then
  2079.         ReDim Bbbwh(1 To Bbbwhgs)
  2080.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  2081.     End If
  2082.     
  2083.     Bbzbt = ReportTitle
  2084.     Bbxbt(1) = TsLabel(0).Caption
  2085.     bbxbtzzxs(1) = 0                                    '居左
  2086.     Bbxbt(2) = "考核指标:" + GetComboKey(Imgcbo_Check, 1)
  2087.     bbxbtzzxs(2) = 0                                    '居左
  2088.     
  2089.     Call Scyxsjb(WglrGrid)                               '生成报表数据
  2090.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  2091.   
  2092.     If Not bbylte Then
  2093.         Unload DY_Tybbyldy
  2094.     End If
  2095.     
  2096. End Sub