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

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

企业管理

开发平台：

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_CheckDataSub 
  5.    BackColor       =   &H00C0C0C0&
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "单人考核得分"
  8.    ClientHeight    =   6990
  9.    ClientLeft      =   660
  10.    ClientTop       =   1155
  11.    ClientWidth     =   8790
  12.    HelpContextID   =   231300201
  13.    Icon            =   "单人考核得分.frx":0000
  14.    KeyPreview      =   -1  'True
  15.    LinkTopic       =   "Form4"
  16.    MaxButton       =   0   'False
  17.    MinButton       =   0   'False
  18.    ScaleHeight     =   6990
  19.    ScaleWidth      =   8790
  20.    StartUpPosition =   1  '所有者中心
  21.    Begin VB.PictureBox Pic_Title 
  22.       BackColor       =   &H00FFFFFF&
  23.       Height          =   825
  24.       Left            =   60
  25.       Picture         =   "单人考核得分.frx":1042
  26.       ScaleHeight     =   765
  27.       ScaleWidth      =   10725
  28.       TabIndex        =   7
  29.       Top             =   570
  30.       Width           =   10785
  31.       Begin VB.Label tsLabel 
  32.          BackColor       =   &H80000018&
  33.          BackStyle       =   0  'Transparent
  34.          Caption         =   "考核类别:"
  35.          ForeColor       =   &H00000000&
  36.          Height          =   255
  37.          Index           =   0
  38.          Left            =   120
  39.          TabIndex        =   12
  40.          Top             =   120
  41.          Width           =   3975
  42.       End
  43.       Begin VB.Label tsLabel 
  44.          BackColor       =   &H80000018&
  45.          BackStyle       =   0  'Transparent
  46.          Caption         =   "工号:"
  47.          ForeColor       =   &H00000000&
  48.          Height          =   255
  49.          Index           =   1
  50.          Left            =   4260
  51.          TabIndex        =   11
  52.          Top             =   120
  53.          Width           =   1815
  54.       End
  55.       Begin VB.Label tsLabel 
  56.          BackColor       =   &H80000018&
  57.          BackStyle       =   0  'Transparent
  58.          Caption         =   "姓名:"
  59.          ForeColor       =   &H00000000&
  60.          Height          =   255
  61.          Index           =   2
  62.          Left            =   6360
  63.          TabIndex        =   10
  64.          Top             =   120
  65.          Width           =   2235
  66.       End
  67.       Begin VB.Label tsLabel 
  68.          BackColor       =   &H80000018&
  69.          BackStyle       =   0  'Transparent
  70.          Caption         =   "序号:"
  71.          ForeColor       =   &H00000000&
  72.          Height          =   255
  73.          Index           =   4
  74.          Left            =   4260
  75.          TabIndex        =   9
  76.          Top             =   420
  77.          Width           =   1815
  78.       End
  79.       Begin VB.Label tsLabel 
  80.          BackColor       =   &H80000018&
  81.          BackStyle       =   0  'Transparent
  82.          Caption         =   "测 评 者:"
  83.          ForeColor       =   &H00000000&
  84.          Height          =   255
  85.          Index           =   3
  86.          Left            =   120
  87.          TabIndex        =   8
  88.          Top             =   420
  89.          Width           =   3975
  90.       End
  91.    End
  92.    Begin VB.TextBox Ydtext 
  93.       BackColor       =   &H00C0FFFF&
  94.       BorderStyle     =   0  'None
  95.       Height          =   300
  96.       Left            =   8790
  97.       MultiLine       =   -1  'True
  98.       TabIndex        =   0
  99.       Top             =   1440
  100.       Visible         =   0   'False
  101.       Width           =   1185
  102.    End
  103.    Begin VB.ComboBox YdCombo 
  104.       Height          =   300
  105.       Left            =   8790
  106.       Style           =   2  'Dropdown List
  107.       TabIndex        =   3
  108.       Top             =   1830
  109.       Visible         =   0   'False
  110.       Width           =   1695
  111.    End
  112.    Begin VB.Timer Timer1 
  113.       Interval        =   1
  114.       Left            =   10020
  115.       Top             =   1410
  116.    End
  117.    Begin VB.CommandButton Ydcommand 
  118.       Height          =   300
  119.       Left            =   10530
  120.       Picture         =   "单人考核得分.frx":1DF82
  121.       Style           =   1  'Graphical
  122.       TabIndex        =   1
  123.       Top             =   1830
  124.       Visible         =   0   'False
  125.       Width           =   300
  126.    End
  127.    Begin VSFlex8Ctl.VSFlexGrid WglrGrid 
  128.       Height          =   5385
  129.       Left            =   60
  130.       TabIndex        =   4
  131.       Top             =   1500
  132.       Width           =   8625
  133.       _ExtentX        =   15214
  134.       _ExtentY        =   9499
  135.       Appearance      =   1
  136.       BorderStyle     =   1
  137.       Enabled         =   -1  'True
  138.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  139.          Name            =   "宋体"
  140.          Size            =   9
  141.          Charset         =   134
  142.          Weight          =   400
  143.          Underline       =   0   'False
  144.          Italic          =   0   'False
  145.          Strikethrough   =   0   'False
  146.       EndProperty
  147.       MousePointer    =   0
  148.       BackColor       =   16777215
  149.       ForeColor       =   -2147483640
  150.       BackColorFixed  =   12632256
  151.       ForeColorFixed  =   -2147483630
  152.       BackColorSel    =   -2147483635
  153.       ForeColorSel    =   -2147483634
  154.       BackColorBkg    =   -2147483636
  155.       BackColorAlternate=   16777215
  156.       GridColor       =   -2147483633
  157.       GridColorFixed  =   -2147483632
  158.       TreeColor       =   -2147483632
  159.       FloodColor      =   192
  160.       SheetBorder     =   -2147483642
  161.       FocusRect       =   1
  162.       HighLight       =   1
  163.       AllowSelection  =   -1  'True
  164.       AllowBigSelection=   -1  'True
  165.       AllowUserResizing=   0
  166.       SelectionMode   =   0
  167.       GridLines       =   1
  168.       GridLinesFixed  =   2
  169.       GridLineWidth   =   1
  170.       Rows            =   50
  171.       Cols            =   10
  172.       FixedRows       =   1
  173.       FixedCols       =   1
  174.       RowHeightMin    =   0
  175.       RowHeightMax    =   0
  176.       ColWidthMin     =   0
  177.       ColWidthMax     =   0
  178.       ExtendLastCol   =   0   'False
  179.       FormatString    =   ""
  180.       ScrollTrack     =   0   'False
  181.       ScrollBars      =   3
  182.       ScrollTips      =   0   'False
  183.       MergeCells      =   1
  184.       MergeCompare    =   0
  185.       AutoResize      =   -1  'True
  186.       AutoSizeMode    =   0
  187.       AutoSearch      =   0
  188.       MultiTotals     =   -1  'True
  189.       SubtotalPosition=   1
  190.       OutlineBar      =   0
  191.       OutlineCol      =   0
  192.       Ellipsis        =   0
  193.       ExplorerBar     =   0
  194.       PicturesOver    =   0   'False
  195.       FillStyle       =   0
  196.       RightToLeft     =   0   'False
  197.       PictureType     =   0
  198.       TabBehavior     =   0
  199.       OwnerDraw       =   0
  200.       Editable        =   0   'False
  201.       ShowComboButton =   -1  'True
  202.       WordWrap        =   0   'False
  203.       TextStyle       =   0
  204.       TextStyleFixed  =   0
  205.       OleDragMode     =   0
  206.       OleDropMode     =   0
  207.       DataMode        =   0
  208.       VirtualData     =   -1  'True
  209.       Begin MSComctlLib.ImageList ImageList1 
  210.          Left            =   9120
  211.          Top             =   780
  212.          _ExtentX        =   1005
  213.          _ExtentY        =   1005
  214.          BackColor       =   -2147483643
  215.          ImageWidth      =   16
  216.          ImageHeight     =   16
  217.          MaskColor       =   12632256
  218.          _Version        =   393216
  219.          BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  220.             NumListImages   =   29
  221.             BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  222.                Picture         =   "单人考核得分.frx":1E30C
  223.                Key             =   "sz"
  224.             EndProperty
  225.             BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  226.                Picture         =   "单人考核得分.frx":1E6A6
  227.                Key             =   "dy"
  228.             EndProperty
  229.             BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  230.                Picture         =   "单人考核得分.frx":1EA40
  231.                Key             =   "yl"
  232.             EndProperty
  233.             BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  234.                Picture         =   "单人考核得分.frx":1EDDA
  235.                Key             =   "xg"
  236.             EndProperty
  237.             BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  238.                Picture         =   "单人考核得分.frx":1F174
  239.                Key             =   "zh"
  240.             EndProperty
  241.             BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  242.                Picture         =   "单人考核得分.frx":1F50E
  243.                Key             =   "sh"
  244.             EndProperty
  245.             BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  246.                Picture         =   "单人考核得分.frx":1F8A8
  247.                Key             =   "bc"
  248.             EndProperty
  249.             BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  250.                Picture         =   "单人考核得分.frx":1FC42
  251.                Key             =   "fq"
  252.             EndProperty
  253.             BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  254.                Picture         =   "单人考核得分.frx":1FFDC
  255.                Key             =   "bz"
  256.             EndProperty
  257.             BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  258.                Picture         =   "单人考核得分.frx":20376
  259.                Key             =   "tc"
  260.             EndProperty
  261.             BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  262.                Picture         =   "单人考核得分.frx":20710
  263.                Key             =   "bcgs"
  264.             EndProperty
  265.             BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  266.                Picture         =   "单人考核得分.frx":20AAA
  267.                Key             =   "mrlk"
  268.             EndProperty
  269.             BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  270.                Picture         =   "单人考核得分.frx":20E44
  271.                Key             =   "xsxm"
  272.             EndProperty
  273.             BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  274.                Picture         =   "单人考核得分.frx":211DE
  275.                Key             =   "first"
  276.             EndProperty
  277.             BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  278.                Picture         =   "单人考核得分.frx":21578
  279.                Key             =   "prev"
  280.             EndProperty
  281.             BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  282.                Picture         =   "单人考核得分.frx":21912
  283.                Key             =   "next"
  284.             EndProperty
  285.             BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  286.                Picture         =   "单人考核得分.frx":21CAC
  287.                Key             =   "last"
  288.             EndProperty
  289.             BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  290.                Picture         =   "单人考核得分.frx":22046
  291.                Key             =   "xx"
  292.             EndProperty
  293.             BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  294.                Picture         =   "单人考核得分.frx":223E0
  295.                Key             =   "define"
  296.             EndProperty
  297.             BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  298.                Picture         =   "单人考核得分.frx":2277A
  299.                Key             =   "exec"
  300.             EndProperty
  301.             BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  302.                Picture         =   "单人考核得分.frx":22B14
  303.                Key             =   "xz"
  304.             EndProperty
  305.             BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  306.                Picture         =   "单人考核得分.frx":22EAE
  307.                Key             =   "sc"
  308.             EndProperty
  309.             BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  310.                Picture         =   "单人考核得分.frx":23248
  311.                Key             =   "sx"
  312.             EndProperty
  313.             BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  314.                Picture         =   "单人考核得分.frx":235E2
  315.                Key             =   "cx"
  316.             EndProperty
  317.             BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  318.                Picture         =   "单人考核得分.frx":2397C
  319.                Key             =   "zd"
  320.             EndProperty
  321.             BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  322.                Picture         =   "单人考核得分.frx":23D16
  323.                Key             =   "dz"
  324.             EndProperty
  325.             BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  326.                Picture         =   "单人考核得分.frx":240B0
  327.                Key             =   "ph"
  328.             EndProperty
  329.             BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  330.                Picture         =   "单人考核得分.frx":2444A
  331.                Key             =   "fz"
  332.             EndProperty
  333.             BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  334.                Picture         =   "单人考核得分.frx":247E4
  335.                Key             =   "dw"
  336.             EndProperty
  337.          EndProperty
  338.       End
  339.    End
  340.    Begin MSComctlLib.Toolbar Tlb_Action 
  341.       Align           =   1  'Align Top
  342.       Height          =   570
  343.       Left            =   0
  344.       TabIndex        =   2
  345.       Top             =   0
  346.       Width           =   8790
  347.       _ExtentX        =   15505
  348.       _ExtentY        =   1005
  349.       ButtonWidth     =   820
  350.       ButtonHeight    =   953
  351.       AllowCustomize  =   0   'False
  352.       Wrappable       =   0   'False
  353.       Appearance      =   1
  354.       Style           =   1
  355.       ImageList       =   "ImageList1"
  356.       _Version        =   393216
  357.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  358.          NumButtons      =   6
  359.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  360.             Caption         =   "设置"
  361.             Key             =   "ymsz"
  362.             Object.ToolTipText     =   "打印页面设置"
  363.             ImageKey        =   "sz"
  364.          EndProperty
  365.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  366.             Caption         =   "打印"
  367.             Key             =   "dy"
  368.             Object.ToolTipText     =   "打印当前单据或Ctrl+P"
  369.             ImageKey        =   "dy"
  370.          EndProperty
  371.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  372.             Caption         =   "预览"
  373.             Key             =   "yl"
  374.             ImageKey        =   "yl"
  375.          EndProperty
  376.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  377.             Style           =   3
  378.          EndProperty
  379.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  380.             Caption         =   "帮助"
  381.             Key             =   "bz"
  382.             ImageKey        =   "bz"
  383.          EndProperty
  384.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  385.             Caption         =   "退出"
  386.             Key             =   "fh"
  387.             ImageKey        =   "tc"
  388.          EndProperty
  389.       EndProperty
  390.       BorderStyle     =   1
  391.       Begin MSComctlLib.Toolbar GsToolbar 
  392.          Height          =   540
  393.          Left            =   7080
  394.          TabIndex        =   6
  395.          Top             =   0
  396.          Width           =   1695
  397.          _ExtentX        =   2990
  398.          _ExtentY        =   953
  399.          ButtonWidth     =   1455
  400.          ButtonHeight    =   953
  401.          AllowCustomize  =   0   'False
  402.          Appearance      =   1
  403.          Style           =   1
  404.          ImageList       =   "ImageList1"
  405.          _Version        =   393216
  406.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  407.             NumButtons      =   2
  408.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  409.                Caption         =   "保存格式"
  410.                Key             =   "bcgs"
  411.                ImageKey        =   "bcgs"
  412.             EndProperty
  413.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  414.                Caption         =   "默认列宽"
  415.                Key             =   "hfmrgs"
  416.                ImageKey        =   "mrlk"
  417.             EndProperty
  418.          EndProperty
  419.       End
  420.    End
  421.    Begin VB.Label Lab_OperStatus 
  422.       BackColor       =   &H000080FF&
  423.       Caption         =   "1"
  424.       Height          =   345
  425.       Left            =   10500
  426.       TabIndex        =   5
  427.       Top             =   1440
  428.       Visible         =   0   'False
  429.       Width           =   345
  430.    End
  431. End
  432. Attribute VB_Name = "Khgl_CheckDataSub"
  433. Attribute VB_GlobalNameSpace = False
  434. Attribute VB_Creatable = False
  435. Attribute VB_PredeclaredId = True
  436. Attribute VB_Exposed = False
  437. '**************************************************************************************
  438. '*    模 块 名 称 :单人考核数据录入-考核数据
  439. '*    功 能 描 述 :
  440. '*    程序员姓名  :张洪军
  441. '*    最后修改人  :张洪军
  442. '*    最后修改时间:2001/12/24
  443. '*    备        注:程序中所有依实际情况自定义部分均用[>> <<]括起
  444. '*
  445. '*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
  446. '*
  447. '*    3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) 1-浏览 2-修改
  448. '*
  449. '***************************************************************************************
  450.  
  451. '以下为自定义变量
  452. Public int_BaseMainID As Integer                '考核数据主表id号
  453. Public str_TitleCode As String                  '考核类别编码
  454. Dim strFactor()   As String                     '保存考核要素评价标准类型和评价标准编码,用于设置参照条件
  457.  
  458. '其它固定使用变量
  459. Dim Tsxx As String                              '系统信息提示(Fixed)
  460. Dim ReportTitle As String                       '报表主标题(Fixed)
  461.    
  462. '以下为固定使用变量(网格)
  463. Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
  464. Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
  465. Dim GridCode As String                          '显示网格网格代码
  466. Dim GridInf() As Variant                        '整个网格设置信息
  467. Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
  468. Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
  469. Dim Sfxshjwg As Boolean                         '是否显示合计网格
  470. Dim Qslz As Long                                '网格隐藏(非操作显示)列数
  471. Dim Sjhgd As Double                             '网格数据行高度
  472. Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
  473. Dim GridStr()  As String                        '网格列信息(字符型)
  474. Dim GridInt() As Integer                        '网格列信息(整型)
  475. Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
  476. Dim Dqlrwgh As Long                             '当前录入数据网格行
  477. Dim Dqlrwgl As Long                             '当前录入数据网格列
  478. Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
  479. Dim Dqlkwgl As Long                             '刚刚离开网格列
  480. Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
  481. Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
  482. Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
  483. Dim Wbkbhlock As Boolean                        '文本框改变值锁
  484. Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
  485. Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
  486. Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
  487. Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
  488. Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
  489. Dim Shsfts As Boolean                           '删除记录行是否提示
  490. Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
  492. Private Sub Form_KeyPress(KeyAscii As Integer)      '限制录入字符"'"
  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              '文本框内容改变锁
  510.      
  511.     '报表主标题及报表编码(Fixed)
  512.     ReportTitle = "单人考核得分"
  513.     XtReportCode = "Khgl_CheckDataSingle"
  514.     Load Dyymctbl
  515.     
  516.     '调 入 网 格(Fixed)
  517.     GridCode = "Khgl_CheckDataSub"      '网格属性编码
  518.     Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  519.     
  520.     Qslz = GridInf(1)
  521.     Sjhgd = GridInf(2)
  522.     Pmbcsjhs = GridInf(3)
  523.     Fzxwghs = GridInf(4)
  524.     Sfblbzkd = GridInf(5)
  525.     Shsfts = GridInf(6)
  526.     Sfxshjwg = GridInf(7)
  527.     Szzls = WglrGrid.Cols - 1
  528.     
  529.     '设置标题栏宽度、网格宽度高度(Fixed)
  530.     Pic_Title.Move 50, Pic_Title.Top, Me.Width - 150, Pic_Title.Height
  531.     WglrGrid.Move 50, Pic_Title.Top + Pic_Title.Height, Me.Width - 150
  532.     WglrGrid.Height = Me.Height - WglrGrid.Top - 380
  533.     
  534.     '<<以下自定义
  535.     WglrGrid.ColAlignment(2) = flexAlignLeftCenter
  536.    
  537.     
  538.     
  539.     '>>以上自定义
  540.      
  541.     '生成查询结果
  542.     Call Sub_Query
  543.     
  544.     '设置状态为修改状态
  545.     Lab_OperStatus = "2"
  546.  
  547. End Sub
  549. Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
  550.     If Not Fun_Drfrmyxxpd Then
  551.        Cancel = True
  552.        Exit Sub
  553.     End If
  555.     '卸载打印页面窗体
  556.     Unload Dyymctbl
  558. End Sub
  560. Private Sub Sub_Query()                              '生成查询结果
  562.     Dim Sqlstr As String                           '临时使用字符串
  563.     Dim RecTemp As New ADODB.Recordset             '临时使用动态集
  564.     Dim Jsqte, jsqteh, jsqtel As Long              '临时计数器
  565.     Dim str_titleRoot As String                    '考核类别根结点编码
  567.     '禁止网格刷新动作,为加快网格显示速度(Fixed)
  568.     WglrGrid.Redraw = False
  569.     
  570.     '取考核类别编码方案
  571.     Sqlstr = "select * from Gy_CodeScheme where ItemCode='" & Trim("Khgl_Title") & "'"
  572.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  573.     
  574.     '取考核类别编码的根结点编码
  575.     str_titleRoot = Mid(str_TitleCode, 1, Mid(RecTemp.Fields("CodeScheme"), 1, 1))
  576.     RecTemp.Close
  578.     '本张单据查询字符串,填充考核要素编码、考核指标、考核要素名称
  579.     Sqlstr = " SELECT FactorCode,FactorName,CheckName,AppraiseType,AppraiseCode " & _
  580.              " FROM Kh_v_ValMark where TitleCode='" & str_titleRoot & "'" & _
  581.              " Order By ValMarkID"
  582.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  583.       
  584.     With RecTemp
  585.      
  586.         WglrGrid.Rows = WglrGrid.FixedRows
  587.      
  588.         If .EOF Then
  589.             WglrGrid.Redraw = True
  590.             Exit Sub
  591.         End If
  592.      
  593.         Jsqte = WglrGrid.FixedRows
  594.         
  595.         ReDim strFactor(.RecordCount + 1, 3)
  596.         ReDim sItem(.RecordCount + 1)
  597.         
  598.         Do While Not .EOF
  599.             WglrGrid.AddItem ""
  600.             WglrGrid.TextMatrix(Jsqte, 1) = Trim(.Fields("FactorCode") & "")   '考核要素编码
  601.             WglrGrid.TextMatrix(Jsqte, 2) = Trim(.Fields("CheckName") & "")    '考核指标
  602.             WglrGrid.TextMatrix(Jsqte, 3) = Trim(.Fields("FactorName") & "")   '考核要素
  603.             strFactor(Jsqte, 1) = Trim(.Fields("AppraiseType") & "")           '评价标准类型
  604.             strFactor(Jsqte, 2) = Trim(.Fields("AppraiseCode") & "")           '评价标准编码
  605.             strFactor(Jsqte, 3) = Trim(.Fields("FactorCode") & "")             '考核要素编码
  606.             
  607.             '<<]
  608.        
  609.             WglrGrid.RowHeight(Jsqte) = Sjhgd
  610.             .MoveNext
  611.             Jsqte = Jsqte + 1
  612.         Loop
  613.         
  614.         '填充考核得分
  615.         For jsqteh = WglrGrid.FixedRows To WglrGrid.Rows - 1
  616.             For jsqtel = WglrGrid.FixedCols To WglrGrid.Cols - 1
  617.                 Sqlstr = " SELECT CheckValues FROM Kh_BaseSub  " & _
  618.                          " where   FactorCode ='" & strFactor(jsqteh, 3) & "'" & _
  619.                          " and   BaseMainID   = " & int_BaseMainID
  620.                 Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  621.                 If Not RecTemp.EOF() Then
  622.                     WglrGrid.TextMatrix(jsqteh, jsqtel) = Trim(RecTemp.Fields("CheckValues") & "")    '考核得分
  623.                 End If
  624.             Next jsqtel
  625.         Next jsqteh
  626.     End With
  627.     
  628.     
  629.     
  630.             
  631.     '将网格刷新解禁(Fixed)
  632.     WglrGrid.Redraw = True
  633.        
  634. End Sub
  636. Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
  637.      
  638.     '屏蔽文本框,下拉组合框有效性判断
  639.      
  640.     Valilock = True
  641.      
  642.     '屏蔽网格失去焦点产生的有效性判断
  643.      
  644.     Changelock = True
  645.      
  646.     Select Case Button.Key
  647.         Case "ymsz"                                          '页面设置
  648.             Dyymctbl.Show 1
  649.         Case "yl"                                            '预 览
  650.             If Fun_Drfrmyxxpd Then
  651.                 Call bbyl(True)
  652.             End If
  653.         Case "dy"                                            '打 印
  654.             If Fun_Drfrmyxxpd Then
  655.                 Call bbyl(False)
  656.             End If
  657.         Case "bz"                                            '帮 助
  658.             Call F1bz
  659.         Case "fh"                                            '退 出
  660.             Unload Me
  661.             
  662.     End Select
  663.        
  664.     '解 锁
  665.     Valilock = False
  666.     Changelock = False
  667.         
  668. End Sub
  670. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  671.   
  672.     If Shift = 2 Then
  673.         Select Case UCase(Chr(KeyCode))
  674.             Case "P"                   'Ctrl+P 打印
  675.                 If Tlb_Action.Buttons("dy").Enabled Then
  676.                     Call bbyl(False)
  677.                 End If
  678.         End Select
  679.     End If
  680.     
  681. End Sub
  683. Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
  684.  
  685.     Dim xswbrr As String
  686.  
  687.     With WglrGrid
  688.         Zdlrqnr = Trim(.Text)
  689.         xswbrr = Trim(.Text)
  690.     
  691.         If GridBoolean(.Col, 3) Then   '列表框录入
  692.     
  693.             '填充列表框程序
  694.             Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
  695.         Else
  696.             Wbkbhlock = True
  697.        
  698.             '====以下为用户自定义
  699.             Ydtext.Text = xswbrr
  700.             '====以上为用户自定义
  701.          
  702.             Wbkbhlock = False
  703.             Ydtext.SelStart = Len(Ydtext.Text)
  704.         End If
  705.     End With
  706.     
  707. End Sub
  709. Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long)        '录入数据字段有效性判断,同时进行字段录入事后处理
  710.     
  711.     Dim Str_JudgeText As String            '临时有效性判断字段内容
  712.     Dim Coljsq As Long                     '临时列计数器
  713.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  714.     Dim Dbl_Qcye As Double                 '临时期初余额
  715.  
  716.     With WglrGrid
  717.     
  718.         '非录入状态有效性为合法
  719.         If Yxxpdlock Or .Row < .FixedRows Then
  720.            sjzdyxxpd = True
  721.            Exit Function
  722.         End If
  723.  
  724.         Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
  725.         Select Case GridStr(Dqpdwgl, 1)
  726.          
  727.             '以下为自定义部分[
  728.                 '1.放置字段有效性判断程序
  729.                     'Case "004"
  730.                     
  731.                 '2.放置字段事后处理程序
  732.                 
  733.             '以上为自定义部分]
  734.             
  735.         End Select
  736.      
  737.         '字段录入正确后为零字段清空
  738.         Call Qkwlzd(Dqpdwgh, Dqpdwgl)
  739.     
  740.         sjzdyxxpd = True
  741.         Yxxpdlock = True
  742.         Exit Function
  743.     
  744.     End With
  745.   
  746. Lrcwcl:    '录入错误处理
  748.     With WglrGrid
  749.         Call Xtxxts(Tsxx, 0, 1)
  750.         Changelock = True
  751.         .Select Dqpdwgh, Dqpdwgl
  752.         Changelock = False
  753.         Call xswbk
  754.         sjzdyxxpd = False
  755.         Exit Function
  756.     End With
  757.     
  758. End Function
  760. Private Function Sjhzyxxpd(Yxxpdh As Long, Yxxpdl As Long) As Boolean    '录入数据单元有效性判断,同时进行单元处理
  761.  
  762.     Dim Lrywlz As Long                     '录入错误列值(Fixed)
  763.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  764.     Dim Sqlstr As String                   '临时查询字符串
  765.         
  767.     With WglrGrid
  769.         '单元没有发生变化则不进行有效性判断
  770.         If Hyxxpdlock Then          ' 单元改变
  771.             Sjhzyxxpd = True
  772.             Exit Function
  773.         End If
  774.     
  775.         '以下为自定义部分[
  776.     
  777.         '1.1首先进行单个不能为空或不能为零判断(Fixed)
  778.         For Jsqte = Qslz To .Cols - 1
  779.             '字段不能为空
  780.             If GridInt(Jsqte, 5) = 1 Then
  781.                 If Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
  782.                     Tsxx = GridStr(Jsqte, 2)
  783.                     Lrywlz = Jsqte
  784.                     GoTo Lrcwcl
  785.                     Exit For
  786.                 End If
  787.             End If
  788.             
  789.             '字段不能为零
  790.             If GridInt(Jsqte, 5) = 2 Then
  791.                 If Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
  792.                     Tsxx = GridStr(Jsqte, 2)
  793.                     Lrywlz = Jsqte
  794.                     GoTo Lrcwcl
  795.                     Exit For
  796.                 End If
  797.             End If
  798.         Next Jsqte
  799.     
  800.     
  801.         '1.2进行其他有效性判断,编写格式同1.1
  802.         '如果是分值规则，则录入数据不能超过最大值和最小值
  803.         If strFactor(Yxxpdh, 1) = "0" And Len(Trim(.TextMatrix(Yxxpdh, Yxxpdl))) > 0 Then
  804.             Sqlstr = " SELECT PointMin,PointMax " & _
  805.                      " FROM Kh_Point where PointCode=" & strFactor(Yxxpdh, 2)
  806.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  807.         
  808.             If (Val(Trim(.TextMatrix(Yxxpdh, Yxxpdl))) < RecTemp.Fields("PointMin")) Or (Val(Trim(.TextMatrix(Yxxpdh, Yxxpdl))) > RecTemp.Fields("PointMax")) Then
  809.                 Tsxx = Trim(.TextMatrix(Yxxpdh, Sydz("003", GridStr(), Szzls))) + "最大值为" + Str(RecTemp.Fields("PointMax")) + ",最小值为" + Str(RecTemp.Fields("PointMin")) + "!"
  810.                 Lrywlz = Yxxpdl
  811.                 GoTo Lrcwcl
  812.             End If
  813.         End If
  814.         '2.放置行处理程序(当数据行通过有效性判断)
  815.            
  816.         
  817.         On Error GoTo Swcwcl
  818.     
  819.         Cw_DataEnvi.DataConnect.BeginTrans
  820.     
  821.         With RecTemp
  822.             If .State = 1 Then .Close
  824.             .Open "  SELECT * FROM Kh_BaseSub  " & _
  825.                   "  WHERE FactorCode='" + strFactor(Yxxpdh, 3) + "' and BaseMainID=" & int_BaseMainID, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  826.                   
  827.             If Not RecTemp.EOF Then
  828.                 .Fields("CheckValues") = Val(WglrGrid.TextMatrix(Yxxpdh, Yxxpdl))     '考核得分
  829.                 .Update
  830.             Else
  831.                 .AddNew
  832.                 .Fields("FactorCode") = strFactor(Yxxpdh, 3)                          '考核要素
  833.                 .Fields("BaseMainID") = int_BaseMainID                                '考核数据主表id
  834.                 .Fields("CheckValues") = Val(WglrGrid.TextMatrix(Yxxpdh, Yxxpdl))     '考核得分
  835.                 .Update
  836.             End If
  837.         End With
  838.          
  839.         Cw_DataEnvi.DataConnect.CommitTrans
  840.          
  841.     End With
  843.     '以上为自定义部分]
  846.     Sjhzyxxpd = True
  847.     Hyxxpdlock = True
  848.     Exit Function
  850. Swcwcl:
  852.     Cw_DataEnvi.DataConnect.RollbackTrans
  853.     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  854.     Call Xtxxts(Tsxx, 0, 1)
  855.     Exit Function
  857. Lrcwcl:      '录入错误处理
  859.     With WglrGrid
  860.         Call Xtxxts(Tsxx, 0, 1)
  861.         Changelock = True
  862.         .Select Yxxpdh, Lrywlz
  863.         Changelock = False
  864.         Call xswbk
  865.         Sjhzyxxpd = False
  866.         Exit Function
  867.     End With
  868.     
  869. End Function
  872. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
  873. Private Sub Lrzdbz()                                                      '录入字段帮助
  874.   
  875.     If Not Ydcommand.Visible Then
  876.         Exit Sub
  877.     End If
  878.    
  879.     With WglrGrid
  880.      
  881.         Valilock = True
  882.     
  883.         '处理通用部分
  884.         Changelock = True        '调入另外窗体必须加锁
  885.         Xtcdcsfz = strFactor(.Row, 3)
  886.         Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
  887.         Changelock = False
  888.         
  889.         If Len(Xtfhcs) <> 0 Then
  890.             If GridInt(.Col, 7) = 0 Then
  891.                 Ydtext.Text = Xtfhcs
  892.             Else
  893.                 Ydtext.Text = Xtfhcsfz
  894.             End If
  895.         End If
  896.         
  897.         Valilock = False
  898.   
  899.         If Ydtext.Visible Then
  900.             Ydtext.SetFocus
  901.         End If
  902.     End With
  903.     
  904. End Sub
  906. Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
  907.    
  908.     Call Cxxswbk
  909.    
  910. End Sub
  912. Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  913.   
  914.     Fun_Drfrmyxxpd = True
  915.     
  916.     With WglrGrid
  917.    
  918.         '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  919.   
  920.         If Ydtext.Visible Or YdCombo.Visible Then
  921.             Call Lrsjhx
  922.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  923.                 Fun_Drfrmyxxpd = False
  924.                 Exit Function
  925.             End If
  926.         End If
  927.    
  928.         '进行行有效性判断
  929.         If Not Sjhzyxxpd(.Row, .Col) Then
  930.             Fun_Drfrmyxxpd = False
  931.             Exit Function
  932.         End If
  933.     End With
  934.   
  935. End Function
  937. Private Sub WglrGrid_EnterCell()                                          '显示当前数据行相关信息
  939.     With WglrGrid
  940.         If .Row >= .FixedRows Then
  941.             '[>>
  942.                 '此处可以填写显示与此网格行相关信息
  943.             '<<]
  944.         End If
  945.     End With
  946.    
  947. End Sub
  949. Private Sub WglrGrid_GotFocus()                                           '网格得到焦点
  951.     '网格得到焦点,如果当前选择行为非数据行
  952.     '则调整当前焦点至有效数据行
  954.     With WglrGrid
  955.         If .Row < .FixedRows And .Rows > .FixedRows Then
  956.             Changelock = True
  957.             .Select .FixedRows, .Col
  958.             Changelock = False
  959.         End If
  960.         If .Col < Qslz Then
  961.             Changelock = True
  962.             .Select .Row, Qslz
  963.             Changelock = False
  964.         End If
  965.     End With
  967. End Sub
  969. Private Sub WglrGrid_LostFocus()                                          '录入网格失去焦点
  971.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  972.     If Changelock Then
  973.         Exit Sub
  974.     End If
  976.     '引发网格RowcolChange事件
  977.     With WglrGrid
  978.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  979.             .Select 0, 0
  980.         End If
  981.     End With
  983. End Sub
  985. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                             '限制用户在录入过程中滚动鼠标
  987.     If Gdtlock Then
  988.         Exit Sub
  989.     End If
  990.  
  991.     With WglrGrid
  992.         If Ydtext.Visible Or YdCombo.Visible Then
  993.             Gdtlock = True
  994.             .TopRow = Dqtoprow
  995.             .LeftCol = Dqleftcol
  996.             Gdtlock = False
  997.             Exit Sub
  998.         End If
  999.     End With
  1000.     
  1001. End Sub
  1003. Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  1005.     If Changelock Then
  1006.         Exit Sub
  1007.     End If
  1009.     '记录刚刚离开网格单元的行列值
  1010.     Dqlkwgh = WglrGrid.Row
  1011.     Dqlkwgl = WglrGrid.Col
  1013.     '判断是否需要录入数据回写
  1014.     If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1015.         Exit Sub
  1016.     End If
  1017.     
  1018.     Call Lrsjhx
  1019.     
  1020. End Sub
  1022. Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
  1023.    
  1024.     Valilock = True       '屏蔽文本框失去焦点进行有效性判断
  1025.     
  1026.     With WglrGrid
  1027.         If Changelock Then
  1028.             Exit Sub
  1029.         End If
  1030.         If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1031.             Exit Sub
  1032.         End If
  1033.         If .Row <> Dqlkwgh Or .Col <> Dqlkwgl Then
  1034.             If Not Sjhzyxxpd(Dqlkwgh, Dqlkwgl) Then
  1035.                 Exit Sub
  1036.             End If
  1037.         End If
  1038.    End With
  1039.    
  1040.    Call fhyxh
  1041.    Call Xldql
  1042.    
  1043. End Sub
  1045. Private Sub WglrGrid_DblClick()                                    '鼠标双击网格显示文本框
  1046.   
  1047.     With WglrGrid
  1048.         Call xswbk
  1049.     End With
  1050.     
  1051. End Sub
  1053. Private Sub Ycwbk()                                                '隐藏文本框,帮助按钮,列表组合框
  1054.     
  1055.     Valilock = True
  1056.     Ydtext.Visible = False
  1057.     YdCombo.Visible = False
  1058.     Ydcommand.Visible = False
  1059.     
  1060. End Sub
  1062. Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  1063.     
  1064.     With WglrGrid
  1065.         Select Case KeyCode
  1066.             Case vbKeyEscape                'ESC 键放弃录入
  1067.                 Valilock = True
  1068.                 .SetFocus
  1069.                 Call Ycwbk
  1070.                 Valilock = False
  1071.                 
  1072.             Case vbKeyReturn                '回 车 键 =13
  1073.                 KeyCode = 0
  1074.                 .SetFocus
  1075.                 Call Lrsjhx
  1076.                 Rowjsq = .Row
  1077.                 Coljsq = .Col + 1
  1078.                 If Coljsq > .Cols - 1 Then
  1079.                     If Rowjsq < .Rows - 1 Then
  1080.                         Rowjsq = Rowjsq + 1
  1081.                     End If
  1082.                     Coljsq = Qslz
  1083.                 End If
  1084.                 Do While Rowjsq <= .Rows - 1
  1085.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1086.                         Coljsq = Coljsq + 1
  1087.                         If Coljsq > .Cols - 1 Then
  1088.                             Rowjsq = Rowjsq + 1
  1089.                             Coljsq = Qslz
  1090.                         End If
  1091.                     Else
  1092.                         Exit Do
  1093.                     End If
  1094.                 Loop
  1095.                 .Select Rowjsq, Coljsq
  1096.                 
  1097.             Case vbKeyLeft                  '左 箭 头 =37
  1098.                 If .Col - 1 = Qslz Then
  1099.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1100.                         GoTo jzzx
  1101.                     End If
  1102.                 End If
  1103.                 If .Col > Qslz Then
  1104.                     KeyCode = 0
  1105.                     .SetFocus
  1106.                     Call Lrsjhx
  1107.                     Coljsq = .Col - 1
  1108.                     Do While Coljsq > Qslz
  1109.                         If Coljsq - 1 = Qslz Then
  1110.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1111.                                 GoTo jzzx
  1112.                             End If
  1113.                         End If
  1114.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1115.                             Coljsq = Coljsq - 1
  1116.                         Else
  1117.                             Exit Do
  1118.                         End If
  1119.                     Loop
  1120.                     .Select .Row, Coljsq
  1121.                 End If
  1123.             Case vbKeyRight                 '右 箭 头 =39
  1124.                 KeyCode = 0
  1125.                 .SetFocus
  1126.                 Call Lrsjhx
  1127.                 Rowjsq = .Row
  1128.                 Coljsq = .Col + 1
  1129.                 If Coljsq > .Cols - 1 Then
  1130.                     If Rowjsq < .Rows - 1 Then
  1131.                         Rowjsq = Rowjsq + 1
  1132.                     End If
  1133.                     Coljsq = Qslz
  1134.                 End If
  1135.                 Do While Rowjsq <= .Rows - 1
  1136.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1137.                         Coljsq = Coljsq + 1
  1138.                         If Coljsq > .Cols - 1 Then
  1139.                             Rowjsq = Rowjsq + 1
  1140.                             Coljsq = Qslz
  1141.                         End If
  1142.                     Else
  1143.                         Exit Do
  1144.                     End If
  1145.                 Loop
  1146.                 .Select Rowjsq, Coljsq
  1147.         Case Else
  1148.     End Select
  1149.    
  1150. jzzx:
  1151.    
  1152.     End With
  1153.     
  1154. End Sub
  1156. Private Sub YdCombo_LostFocus()                    '列表框失去焦点
  1157.     
  1158.     With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
  1159.         If Not Valilock Then                           '为TRUE
  1160.             Call Lrsjhx
  1161.             If Not Sjhzyxxpd(Dqlrwgh, .Col) Then
  1162.                 Exit Sub
  1163.             End If
  1164.         End If
  1165.     End With
  1166.     
  1167. End Sub
  1169. Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  1170.     
  1171.     Call Lrzdbz
  1172.     
  1173. End Sub
  1175. Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
  1176.    
  1177.     Dim Rowjsq As Long, Coljsq As Long
  1178.    
  1179.     With WglrGrid
  1180.         Select Case KeyCode
  1181.             Case vbKeyF2
  1182.                 Call Lrzdbz
  1183.             Case vbKeyEscape                'ESC 键放弃录入
  1184.                 Valilock = True
  1185.                 Call Ycwbk
  1186.                 .SetFocus
  1187.             Case vbKeyReturn                '回 车 键 =13
  1188.                 KeyCode = 0
  1189.                 .SetFocus
  1190.                 Call Lrsjhx
  1191.                 Rowjsq = .Row
  1192.                 Coljsq = .Col + 1
  1193.                 If Coljsq > .Cols - 1 Then
  1194.                     If Rowjsq < .Rows - 1 Then
  1195.                         Rowjsq = Rowjsq + 1
  1196.                     End If
  1197.                     Coljsq = Qslz
  1198.                 End If
  1199.                 Do While Rowjsq <= .Rows - 1
  1200.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1201.                         Coljsq = Coljsq + 1
  1202.                         If Coljsq > .Cols - 1 Then
  1203.                             Rowjsq = Rowjsq + 1
  1204.                             Coljsq = Qslz
  1205.                         End If
  1206.                     Else
  1207.                         Exit Do
  1208.                     End If
  1209.                 Loop
  1210.                 If Rowjsq <= .Rows - 1 Then
  1211.                     .Select Rowjsq, Coljsq
  1212.                 End If
  1213.                 
  1214.             Case vbKeyUp                    '上 箭 头 =38
  1215.                 KeyCode = 0
  1216.                 .SetFocus
  1217.                 Call Lrsjhx
  1218.                 If .Row > .FixedRows Then
  1219.                     .Row = .Row - 1
  1220.                 End If
  1221.                 
  1222.             Case vbKeyDown                  '下 箭 头 =40
  1223.                 KeyCode = 0
  1224.                 .SetFocus
  1225.                 Call Lrsjhx
  1226.                 If .Row < .Rows - 1 Then
  1227.                     .Row = .Row + 1
  1228.                 End If
  1229.             Case vbKeyLeft                  '左 箭 头 =37
  1230.                 If .Col - 1 = Qslz Then
  1231.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1232.                         GoTo jzzx
  1233.                     End If
  1234.                 End If
  1235.                 If Ydtext.SelStart = 0 And .Col > Qslz Then
  1236.                     KeyCode = 0
  1237.                     .SetFocus
  1238.                     Call Lrsjhx
  1239.                     Coljsq = .Col - 1
  1240.                     Do While Coljsq > Qslz
  1241.                         If Coljsq - 1 = Qslz Then
  1242.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1243.                                 GoTo jzzx
  1244.                             End If
  1245.                         End If
  1246.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1247.                             Coljsq = Coljsq - 1
  1248.                         Else
  1249.                             Exit Do
  1250.                         End If
  1251.                     Loop
  1252.                     .Select .Row, Coljsq
  1253.                 End If
  1254. jzzx:
  1255.            
  1256.            
  1257.             Case vbKeyRight                 '右 箭 头 =39
  1258.                 wblong = Len(Ydtext.Text)
  1259.                 If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
  1260.                     KeyCode = 0
  1261.                     .SetFocus
  1262.                     Call Lrsjhx
  1263.                     Rowjsq = .Row
  1264.                     Coljsq = .Col + 1
  1265.                     If Coljsq > .Cols - 1 Then
  1266.                         If Rowjsq < .Rows - 1 Then
  1267.                             Rowjsq = Rowjsq + 1
  1268.                         End If
  1269.                         Coljsq = Qslz
  1270.                     End If
  1271.                     Do While Rowjsq <= .Rows - 1
  1272.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1273.                             Coljsq = Coljsq + 1
  1274.                             If Coljsq > .Cols - 1 Then
  1275.                                 Rowjsq = Rowjsq + 1
  1276.                                 Coljsq = Qslz
  1277.                             End If
  1278.                         Else
  1279.                             Exit Do
  1280.                         End If
  1281.                     Loop
  1282.                     .Select Rowjsq, Coljsq
  1283.                 End If
  1284.             Case Else
  1285.         End Select
  1286.     End With
  1287.     
  1288. End Sub
  1290. Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  1291.   
  1292.     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1294. End Sub
  1296. Private Sub ydtext_Change()                              '录入事中变化处理
  1298.     '防止程序改变但不进行处理
  1300.     If Wbkbhlock Then
  1301.          Exit Sub
  1302.     End If
  1304.     With WglrGrid
  1306.         '限制字段录入长度
  1307.         Wbkbhlock = True
  1308.         
  1309.         Select Case GridInt(.Col, 1)
  1310.             Case 8, 11   '金额型
  1311.                 Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  1312.             Case 9, 12   '数量型
  1313.                 Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  1314.             Case 10      '单价型
  1315.                 Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1316.             Case Else    '其他类型
  1317.                 If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  1318.                     Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  1319.                 End If
  1320.         End Select
  1321.         
  1322.         Wbkbhlock = False
  1323.     End With
  1324.     
  1325. End Sub
  1327. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  1328.   
  1329.     With WglrGrid
  1330.         If Not Valilock Then
  1331.             Call Lrsjhx
  1332.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1333.                 Exit Sub
  1334.             End If
  1335.             If Not Sjhzyxxpd(Dqlrwgh, .Col) Then
  1336.                 Exit Sub
  1337.             End If
  1338.         End If
  1339.     End With
  1340.   
  1341. End Sub
  1343. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  1344.   
  1345.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  1346.   
  1347.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1348.     If Not Fun_AllowInput Then
  1349.         Exit Sub
  1350.     End If
  1351.   
  1352.     '显示文本框前返回有效行列（解决滚动条问题）
  1353.     Call Xldqh
  1354.     Call Xldql
  1355.   
  1356.     '隐藏文本框,帮助按钮,列表组合框
  1357.     Call Ycwbk
  1358.   
  1359.     With WglrGrid
  1360.         Dqlrwgh = .Row
  1361.         Dqlrwgl = .Col
  1362.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1363.             Exit Sub
  1364.         End If
  1365.      
  1366.         Wbkpy = 30
  1367.         Wbkpy1 = 15
  1368.     
  1369.         On Error Resume Next
  1370.         
  1371.         If GridBoolean(.Col, 3) Then
  1372.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1373.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1374.             YdCombo.Width = .CellWidth - Wbkpy1
  1375.             Call Wbkcl
  1376.             YdCombo.Visible = True
  1377.             YdCombo.SetFocus
  1378.             Ydcommand.Visible = False
  1379.             Ydtext.Visible = False
  1380.         Else
  1381.             If GridBoolean(.Col, 2) And (strFactor(.Row, 1) = "1") Then
  1382.                     Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1383.                     Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1384.                     Ydcommand.Visible = True
  1385.             Else
  1386.                 Ydcommand.Visible = False
  1387.             End If
  1388.      
  1389.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1390.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1391.             
  1392.             If Ydcommand.Visible Then
  1393.                 If Sfblbzkd Then
  1394.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1395.                 Else
  1396.                     Ydtext.Width = .CellWidth - Wbkpy1
  1397.                 End If
  1398.             Else
  1399.                 Ydtext.Width = .CellWidth - Wbkpy1
  1400.             End If
  1401.             
  1402.             Ydtext.Height = .CellHeight - Wbkpy1
  1403.       
  1404.             If GridInt(.Col, 2) <> 0 Then
  1405.                 Ydtext.MaxLength = GridInt(.Col, 2)
  1406.             Else
  1407.                 Ydtext.MaxLength = 3000
  1408.             End If
  1409.       
  1410.             Call Wbkcl
  1411.       
  1412.             Ydtext.Visible = True
  1413.             Ydtext.SetFocus
  1414.         End If
  1415.     
  1416.         Dqtoprow = .TopRow
  1417.         Dqleftcol = .LeftCol
  1418.     
  1419.         '重置锁值
  1420.         Valilock = False
  1421.         Wbkbhlock = False
  1422.     End With
  1423.  
  1424. End Sub
  1426. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  1427.    
  1428.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  1429.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1430.         Exit Function
  1431.     End If
  1432.    
  1433.     '[>>
  1434.     
  1435.         '此处可以填写禁止文本框激活使单据处于录入状态的理由
  1436.    
  1437.     '<<]
  1438.    
  1439.     Fun_AllowInput = True
  1440.     
  1441. End Function
  1443. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  1444.                    
  1445.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  1446.     
  1447.     Wbkpy = 30
  1448.     Wbkpy1 = 15
  1449.     
  1450.     With WglrGrid
  1451.         If YdCombo.Visible Then
  1452.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1453.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1454.             YdCombo.Width = .CellWidth - Wbkpy1
  1455.         End If
  1456.         If Ydcommand.Visible Then
  1457.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1458.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1459.         End If
  1460.         If Ydtext.Visible Then
  1461.             If Ydcommand.Visible Then
  1462.                 If Sfblbzkd Then
  1463.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1464.                 Else
  1465.                     Ydtext.Width = .CellWidth - Wbkpy1
  1466.                 End If
  1467.             Else
  1468.                 Ydtext.Width = .CellWidth - Wbkpy1
  1469.             End If
  1470.       
  1471.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1472.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1473.             Ydtext.Height = .CellHeight - Wbkpy1
  1474.         End If
  1475.     End With
  1477. End Sub
  1479. Private Sub Lrsjhx()                                                             '文本框录入数据回写
  1480.   
  1481.     With WglrGrid
  1482.         If YdCombo.Visible Then
  1483.             .Text = Trim(YdCombo.Text)
  1484.         End If
  1485.         If Ydtext.Visible Then
  1486.             .Text = Trim(Ydtext.Text)
  1487.         End If
  1488.    
  1489.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  1490.         If Zdlrqnr <> Trim(.Text) Then
  1491.             Yxxpdlock = False
  1492.             Hyxxpdlock = False
  1493.         End If
  1494.    
  1495.         '隐藏文本框,帮助按钮,列表组合框
  1496.         Call Ycwbk
  1497.    
  1498.     End With
  1499.     
  1500. End Sub
  1502. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)              '网格快捷键
  1503.   
  1504.     '如果单据操作状态为浏览状态则不能显示录入载体
  1505.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1506.         Exit Sub
  1507.     End If
  1509.     Select Case KeyCode
  1510.         Case vbKeyF2                   '按F2键参照
  1511.             Call xswbk
  1512.             Call Lrzdbz
  1513.     End Select
  1515. End Sub
  1517. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                              '网格接受键盘录入
  1519.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1520.     If Not Fun_AllowInput Then
  1521.         Exit Sub
  1522.     End If
  1523.   
  1524.     With WglrGrid
  1525.   
  1526.         '屏 蔽 回 车 键
  1527.         If KeyAscii = vbKeyReturn Then
  1528.             KeyAscii = 0
  1529.             Rowjsq = .Row
  1530.             Coljsq = .Col + 1
  1531.             If Coljsq > .Cols - 1 Then
  1532.                 If Rowjsq < .Rows - 1 Then
  1533.                     Rowjsq = Rowjsq + 1
  1534.                 End If
  1535.                 Coljsq = Qslz
  1536.             End If
  1537.             Do While Rowjsq <= .Rows - 1
  1538.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1539.                     Coljsq = Coljsq + 1
  1540.                     If Coljsq > .Cols - 1 Then
  1541.                         Rowjsq = Rowjsq + 1
  1542.                         Coljsq = Qslz
  1543.                     End If
  1544.                 Else
  1545.                     Exit Do
  1546.                 End If
  1547.             Loop
  1548.           
  1549.             If Rowjsq <= .Rows - 1 Then
  1550.                 .Select Rowjsq, Coljsq
  1551.             End If
  1552.        
  1553.             Exit Sub
  1554.        
  1555.         End If
  1556.      
  1557.         '接受用户录入
  1558.         Select Case KeyAscii
  1559.             Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
  1560.                 '显示录入载体
  1561.                 Call xswbk
  1562.             Case Else
  1563.                 
  1564.                 '防止非编辑字段SendKeys()出现死循环
  1565.                 If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1566.                     Exit Sub
  1567.                 End If
  1568.                 
  1569.                 '如果此字段为列表框录入则调入相应列表框
  1570.                 If GridBoolean(.Col, 3) Then
  1571.                    '列表框录入
  1572.                     Call xswbk
  1573.                 Else
  1574.                     Ydtext.Text = ""
  1575.             
  1576.                     '录入限制
  1577.                     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1578.                     If KeyAscii = 0 Then
  1579.                         Exit Sub
  1580.                     End If
  1581.                     Call xswbk
  1582.                     Ydtext.Text = ""
  1583.                     Valilock = True
  1584.                     SendKeys Chr(KeyAscii), True
  1585.                     DoEvents
  1586.                     Valilock = False
  1587.                 End If
  1588.         End Select
  1589.     End With
  1591. End Sub
  1593. Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  1594.     
  1595.     If Not GridBoolean(Sjl, 5) Then
  1596.         Exit Sub
  1597.     End If
  1598.     
  1599.     With WglrGrid
  1600.         If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
  1601.             .TextMatrix(sjh, Sjl) = ""
  1602.         End If
  1603.     End With
  1605. End Sub
  1607. Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  1608.     
  1609.     With WglrGrid
  1610.         If .Row >= .FixedRows Then
  1611.             Call Xldqh
  1612.         End If
  1613.     End With
  1615. End Sub
  1617. Private Sub Xldqh()                                                      '显露当前行
  1618.     
  1619.     Dim Toprowte As Long
  1620.     With WglrGrid
  1621.         Toprowte = 0
  1622.         Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
  1623.             Toprowte = .TopRow
  1624.             .TopRow = .TopRow + 1
  1625.         Loop
  1626.         Toprowte = 0
  1627.         Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
  1628.             Toprowte = .TopRow
  1629.             If .TopRow > 1 Then
  1630.                 .TopRow = .TopRow - 1
  1631.             End If
  1632.         Loop
  1633.     End With
  1635. End Sub
  1637. Private Sub Xldql()                                                                  '显露当前列
  1638.     
  1639.     Dim Leftcolte As Long
  1640.     With WglrGrid
  1641.         If .Col >= Qslz And .Col >= .FixedCols Then
  1642.             If .LeftCol > .Col Then
  1643.                 .LeftCol = .Col
  1644.             End If
  1645.             Leftcolte = 0
  1646.             Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
  1647.                 Leftcolte = .LeftCol
  1648.                 .LeftCol = .LeftCol + 1
  1649.             Loop
  1650.         End If
  1651.     End With
  1653. End Sub
  1655. Private Sub WglrGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  1656.     Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
  1657. End Sub
  1659. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  1660.     
  1661.     Select Case Button.Key
  1662.         Case "bcgs"                                       '保存表格格式
  1663.             Call Bcwggs(WglrGrid, GridCode, GridStr())
  1664.         Case "hfmrgs"                                     '恢复默认格式
  1665.             Call Hfmrgs(WglrGrid, GridCode, GridStr())
  1666.     End Select
  1668. End Sub
  1670. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  1671.     
  1672.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  1673.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  1674.     Bbxbtgs = 2                                          '报 表 小 标 题 行 数
  1675.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  1676.     ReDim Bbxbt(1 To Bbxbtgs)
  1677.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  1678.     If Bbbwhgs <> 0 Then
  1679.         ReDim Bbbwh(1 To Bbbwhgs)
  1680.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  1681.     End If
  1682.     Bbzbt = ReportTitle
  1683.     Bbxbt(1) = Fun_FormatOutPut(tsLabel(0).Caption, 50) + Fun_FormatOutPut(tsLabel(1).Caption, 20) + Fun_FormatOutPut(tsLabel(2).Caption, 20)
  1684.     bbxbtzzxs(1) = 0
  1685.     Bbxbt(2) = Fun_FormatOutPut(tsLabel(3).Caption, 50) + Fun_FormatOutPut(tsLabel(4).Caption, 20)
  1686.     bbxbtzzxs(2) = 0
  1687.     Call Scyxsjb(WglrGrid)                               '生成报表数据
  1688.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  1689.     If Not bbylte Then
  1690.         Unload DY_Tybbyldy
  1691.     End If
  1693. End Sub