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

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

企业管理

开发平台：

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 FrmJcsz_MidCheckStand 
  5.    BackColor       =   &H00E9F4FA&
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "中控检验标准"
  8.    ClientHeight    =   5205
  9.    ClientLeft      =   675
  10.    ClientTop       =   720
  11.    ClientWidth     =   9345
  12.    Icon            =   "基础_中控检验标准.frx":0000
  13.    KeyPreview      =   -1  'True
  14.    LinkTopic       =   "Form4"
  15.    MaxButton       =   0   'False
  16.    MinButton       =   0   'False
  17.    ScaleHeight     =   5205
  18.    ScaleWidth      =   9345
  19.    StartUpPosition =   1  '所有者中心
  20.    Begin VB.ComboBox Cmb_MName 
  21.       Enabled         =   0   'False
  22.       Height          =   300
  23.       Left            =   4200
  24.       Style           =   2  'Dropdown List
  25.       TabIndex        =   20
  26.       Top             =   1740
  27.       Width           =   1630
  28.    End
  29.    Begin VB.ComboBox Cmb_LineName 
  30.       Enabled         =   0   'False
  31.       Height          =   300
  32.       Left            =   1500
  33.       Style           =   2  'Dropdown List
  34.       TabIndex        =   19
  35.       Top             =   1740
  36.       Width           =   1630
  37.    End
  38.    Begin VB.ComboBox YdCombo 
  39.       Height          =   300
  40.       Left            =   9000
  41.       Style           =   2  'Dropdown List
  42.       TabIndex        =   7
  43.       Top             =   960
  44.       Visible         =   0   'False
  45.       Width           =   1155
  46.    End
  47.    Begin VB.CommandButton Ydcommand1 
  48.       Height          =   300
  49.       Left            =   10680
  50.       Picture         =   "基础_中控检验标准.frx":1042
  51.       Style           =   1  'Graphical
  52.       TabIndex        =   6
  53.       Top             =   600
  54.       Visible         =   0   'False
  55.       Width           =   300
  56.    End
  57.    Begin VB.Timer Timer1 
  58.       Interval        =   1
  59.       Left            =   9690
  60.       Top             =   150
  61.    End
  62.    Begin VB.TextBox Ydtext 
  63.       BackColor       =   &H80000018&
  64.       BorderStyle     =   0  'None
  65.       Height          =   330
  66.       Left            =   7710
  67.       MultiLine       =   -1  'True
  68.       TabIndex        =   5
  69.       Top             =   960
  70.       Visible         =   0   'False
  71.       Width           =   1185
  72.    End
  73.    Begin VB.CommandButton Ydcommand 
  74.       Height          =   300
  75.       Left            =   10680
  76.       Picture         =   "基础_中控检验标准.frx":13CC
  77.       Style           =   1  'Graphical
  78.       TabIndex        =   4
  79.       Top             =   990
  80.       Visible         =   0   'False
  81.       Width           =   300
  82.    End
  83.    Begin VB.TextBox LrText 
  84.       ForeColor       =   &H00000000&
  85.       Height          =   300
  86.       Index           =   0
  87.       Left            =   960
  88.       TabIndex        =   2
  89.       Text            =   "0"
  90.       Top             =   780
  91.       Width           =   1650
  92.    End
  93.    Begin MSComctlLib.Toolbar Tlb_Action 
  94.       Align           =   1  'Align Top
  95.       Height          =   570
  96.       Left            =   0
  97.       TabIndex        =   3
  98.       Top             =   0
  99.       Width           =   9345
  100.       _ExtentX        =   16484
  101.       _ExtentY        =   1005
  102.       ButtonWidth     =   820
  103.       ButtonHeight    =   953
  104.       AllowCustomize  =   0   'False
  105.       Wrappable       =   0   'False
  106.       Appearance      =   1
  107.       Style           =   1
  108.       ImageList       =   "ImageList1"
  109.       _Version        =   393216
  110.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  111.          NumButtons      =   25
  112.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  113.             Caption         =   "打印"
  114.             Key             =   "dy"
  115.             Object.ToolTipText     =   "打印当前单据或Ctrl+P"
  116.             ImageKey        =   "dy"
  117.          EndProperty
  118.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  119.             Caption         =   "预览"
  120.             Key             =   "yl"
  121.             ImageKey        =   "yl"
  122.          EndProperty
  123.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  124.             Key             =   "fgh0"
  125.             Style           =   3
  126.          EndProperty
  127.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  128.             Caption         =   "新增"
  129.             Key             =   "xz"
  130.             Object.ToolTipText     =   "新增加一张单据或F5"
  131.             ImageKey        =   "xz"
  132.          EndProperty
  133.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  134.             Caption         =   "修改"
  135.             Key             =   "xg"
  136.             Object.ToolTipText     =   "修改当前单据或F3"
  137.             ImageKey        =   "xg"
  138.          EndProperty
  139.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  140.             Caption         =   "删除"
  141.             Key             =   "sc"
  142.             Object.ToolTipText     =   "删除当前单据"
  143.             ImageKey        =   "sc"
  144.          EndProperty
  145.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  146.             Key             =   "fgh1"
  147.             Style           =   3
  148.          EndProperty
  149.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  150.             Caption         =   "增行"
  151.             Key             =   "zh"
  152.             Object.ToolTipText     =   "插入一行或Insert"
  153.             ImageKey        =   "zh"
  154.          EndProperty
  155.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  156.             Caption         =   "删行"
  157.             Key             =   "sh"
  158.             Object.ToolTipText     =   "删除当前记录行或Delete"
  159.             ImageKey        =   "sh"
  160.          EndProperty
  161.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  162.             Key             =   "fgh2"
  163.             Style           =   3
  164.          EndProperty
  165.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  166.             Caption         =   "查询"
  167.             Key             =   "find"
  168.             ImageKey        =   "cx"
  169.          EndProperty
  170.          BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  171.             Key             =   "fgh9"
  172.             Style           =   3
  173.          EndProperty
  174.          BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  175.             Caption         =   "保存"
  176.             Key             =   "bc"
  177.             Object.ToolTipText     =   "保存单据或F6"
  178.             ImageKey        =   "bc"
  179.          EndProperty
  180.          BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  181.             Caption         =   "放弃"
  182.             Key             =   "fq"
  183.             Object.ToolTipText     =   "放弃此次操作"
  184.             ImageKey        =   "fq"
  185.          EndProperty
  186.          BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  187.             Enabled         =   0   'False
  188.             Object.Visible         =   0   'False
  189.             Key             =   "fgh3"
  190.             Style           =   3
  191.          EndProperty
  192.          BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  193.             Enabled         =   0   'False
  194.             Object.Visible         =   0   'False
  195.             Caption         =   "审核"
  196.             Key             =   "shsh"
  197.             ImageKey        =   "check"
  198.          EndProperty
  199.          BeginProperty Button17 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  200.             Enabled         =   0   'False
  201.             Object.Visible         =   0   'False
  202.             Caption         =   "弃审"
  203.             Key             =   "shqs"
  204.             ImageKey        =   "qs"
  205.          EndProperty
  206.          BeginProperty Button18 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  207.             Key             =   "fgh4"
  208.             Style           =   3
  209.          EndProperty
  210.          BeginProperty Button19 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  211.             Caption         =   "首张"
  212.             Key             =   "first"
  213.             ImageKey        =   "first"
  214.          EndProperty
  215.          BeginProperty Button20 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  216.             Caption         =   "上张"
  217.             Key             =   "prev"
  218.             ImageKey        =   "prev"
  219.          EndProperty
  220.          BeginProperty Button21 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  221.             Caption         =   "下张"
  222.             Key             =   "next"
  223.             ImageKey        =   "next"
  224.          EndProperty
  225.          BeginProperty Button22 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  226.             Caption         =   "末张"
  227.             Key             =   "last"
  228.             ImageKey        =   "last"
  229.          EndProperty
  230.          BeginProperty Button23 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  231.             Key             =   "fgh5"
  232.             Style           =   3
  233.          EndProperty
  234.          BeginProperty Button24 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  235.             Caption         =   "帮助"
  236.             Key             =   "bz"
  237.             ImageKey        =   "bz"
  238.          EndProperty
  239.          BeginProperty Button25 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  240.             Caption         =   "退出"
  241.             Key             =   "fh"
  242.             ImageKey        =   "tc"
  243.          EndProperty
  244.       EndProperty
  245.       BorderStyle     =   1
  246.    End
  247.    Begin MSComctlLib.ImageList ImageList1 
  248.       Left            =   10410
  249.       Top             =   1350
  250.       _ExtentX        =   1005
  251.       _ExtentY        =   1005
  252.       BackColor       =   -2147483643
  253.       ImageWidth      =   16
  254.       ImageHeight     =   16
  255.       MaskColor       =   12632256
  256.       _Version        =   393216
  257.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  258.          NumListImages   =   37
  259.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  260.             Picture         =   "基础_中控检验标准.frx":1756
  261.             Key             =   "sz"
  262.          EndProperty
  263.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  264.             Picture         =   "基础_中控检验标准.frx":1AF0
  265.             Key             =   "dy"
  266.          EndProperty
  267.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  268.             Picture         =   "基础_中控检验标准.frx":1E8A
  269.             Key             =   "yl"
  270.          EndProperty
  271.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  272.             Picture         =   "基础_中控检验标准.frx":2224
  273.             Key             =   "xg"
  274.          EndProperty
  275.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  276.             Picture         =   "基础_中控检验标准.frx":25BE
  277.             Key             =   "zh"
  278.          EndProperty
  279.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  280.             Picture         =   "基础_中控检验标准.frx":2958
  281.             Key             =   "sh"
  282.          EndProperty
  283.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  284.             Picture         =   "基础_中控检验标准.frx":2CF2
  285.             Key             =   "bc"
  286.          EndProperty
  287.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  288.             Picture         =   "基础_中控检验标准.frx":308C
  289.             Key             =   "fq"
  290.          EndProperty
  291.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  292.             Picture         =   "基础_中控检验标准.frx":3426
  293.             Key             =   "bz"
  294.          EndProperty
  295.          BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  296.             Picture         =   "基础_中控检验标准.frx":37C0
  297.             Key             =   "tc"
  298.          EndProperty
  299.          BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  300.             Picture         =   "基础_中控检验标准.frx":3B5A
  301.             Key             =   "bcgs"
  302.          EndProperty
  303.          BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  304.             Picture         =   "基础_中控检验标准.frx":3EF4
  305.             Key             =   "mrlk"
  306.          EndProperty
  307.          BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  308.             Picture         =   "基础_中控检验标准.frx":428E
  309.             Key             =   "xsxm"
  310.          EndProperty
  311.          BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  312.             Picture         =   "基础_中控检验标准.frx":4628
  313.             Key             =   "first"
  314.          EndProperty
  315.          BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  316.             Picture         =   "基础_中控检验标准.frx":49C2
  317.             Key             =   "prev"
  318.          EndProperty
  319.          BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  320.             Picture         =   "基础_中控检验标准.frx":4D5C
  321.             Key             =   "next"
  322.          EndProperty
  323.          BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  324.             Picture         =   "基础_中控检验标准.frx":50F6
  325.             Key             =   "last"
  326.          EndProperty
  327.          BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  328.             Picture         =   "基础_中控检验标准.frx":5490
  329.             Key             =   "xx"
  330.          EndProperty
  331.          BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  332.             Picture         =   "基础_中控检验标准.frx":582A
  333.             Key             =   "define"
  334.          EndProperty
  335.          BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  336.             Picture         =   "基础_中控检验标准.frx":5BC4
  337.             Key             =   "exec"
  338.          EndProperty
  339.          BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  340.             Picture         =   "基础_中控检验标准.frx":5F5E
  341.             Key             =   "xz"
  342.          EndProperty
  343.          BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  344.             Picture         =   "基础_中控检验标准.frx":62F8
  345.             Key             =   "sc"
  346.          EndProperty
  347.          BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  348.             Picture         =   "基础_中控检验标准.frx":6692
  349.             Key             =   "sx"
  350.          EndProperty
  351.          BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  352.             Picture         =   "基础_中控检验标准.frx":6A2C
  353.             Key             =   "cx"
  354.          EndProperty
  355.          BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  356.             Picture         =   "基础_中控检验标准.frx":6DC6
  357.             Key             =   "zd"
  358.          EndProperty
  359.          BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  360.             Picture         =   "基础_中控检验标准.frx":7160
  361.             Key             =   "dz"
  362.          EndProperty
  363.          BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  364.             Picture         =   "基础_中控检验标准.frx":74FA
  365.             Key             =   "ph"
  366.          EndProperty
  367.          BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  368.             Picture         =   "基础_中控检验标准.frx":7894
  369.             Key             =   "fz"
  370.          EndProperty
  371.          BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  372.             Picture         =   "基础_中控检验标准.frx":7C2E
  373.             Key             =   "dw"
  374.          EndProperty
  375.          BeginProperty ListImage30 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  376.             Picture         =   "基础_中控检验标准.frx":7FC8
  377.             Key             =   "hf"
  378.          EndProperty
  379.          BeginProperty ListImage31 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  380.             Picture         =   "基础_中控检验标准.frx":8362
  381.             Key             =   "pz"
  382.          EndProperty
  383.          BeginProperty ListImage32 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  384.             Picture         =   "基础_中控检验标准.frx":86FC
  385.             Key             =   "check"
  386.          EndProperty
  387.          BeginProperty ListImage33 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  388.             Picture         =   "基础_中控检验标准.frx":8A96
  389.             Key             =   "qs"
  390.          EndProperty
  391.          BeginProperty ListImage34 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  392.             Picture         =   "基础_中控检验标准.frx":8E30
  393.             Key             =   "fullcheck"
  394.          EndProperty
  395.          BeginProperty ListImage35 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  396.             Picture         =   "基础_中控检验标准.frx":91CA
  397.             Key             =   "qq"
  398.          EndProperty
  399.          BeginProperty ListImage36 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  400.             Picture         =   "基础_中控检验标准.frx":9564
  401.             Key             =   "bcw"
  402.          EndProperty
  403.          BeginProperty ListImage37 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  404.             Picture         =   "基础_中控检验标准.frx":98FE
  405.             Key             =   "ye"
  406.          EndProperty
  407.       EndProperty
  408.    End
  409.    Begin VSFlex8Ctl.VSFlexGrid WglrGrid 
  410.       Height          =   3345
  411.       Left            =   120
  412.       TabIndex        =   1
  413.       Top             =   2280
  414.       Width           =   10680
  415.       _ExtentX        =   18838
  416.       _ExtentY        =   5900
  417.       Appearance      =   1
  418.       BorderStyle     =   1
  419.       Enabled         =   -1  'True
  420.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  421.          Name            =   "宋体"
  422.          Size            =   9
  423.          Charset         =   134
  424.          Weight          =   400
  425.          Underline       =   0   'False
  426.          Italic          =   0   'False
  427.          Strikethrough   =   0   'False
  428.       EndProperty
  429.       MousePointer    =   0
  430.       BackColor       =   16777215
  431.       ForeColor       =   -2147483640
  432.       BackColorFixed  =   12640511
  433.       ForeColorFixed  =   -2147483630
  434.       BackColorSel    =   -2147483643
  435.       ForeColorSel    =   -2147483640
  436.       BackColorBkg    =   16777215
  437.       BackColorAlternate=   16777215
  438.       GridColor       =   -2147483633
  439.       GridColorFixed  =   -2147483632
  440.       TreeColor       =   -2147483632
  441.       FloodColor      =   192
  442.       SheetBorder     =   -2147483642
  443.       FocusRect       =   1
  444.       HighLight       =   1
  445.       AllowSelection  =   0   'False
  446.       AllowBigSelection=   0   'False
  447.       AllowUserResizing=   0
  448.       SelectionMode   =   0
  449.       GridLines       =   1
  450.       GridLinesFixed  =   2
  451.       GridLineWidth   =   1
  452.       Rows            =   5000
  453.       Cols            =   10
  454.       FixedRows       =   1
  455.       FixedCols       =   0
  456.       RowHeightMin    =   0
  457.       RowHeightMax    =   0
  458.       ColWidthMin     =   0
  459.       ColWidthMax     =   0
  460.       ExtendLastCol   =   0   'False
  461.       FormatString    =   ""
  462.       ScrollTrack     =   0   'False
  463.       ScrollBars      =   3
  464.       ScrollTips      =   0   'False
  465.       MergeCells      =   0
  466.       MergeCompare    =   0
  467.       AutoResize      =   -1  'True
  468.       AutoSizeMode    =   0
  469.       AutoSearch      =   0
  470.       MultiTotals     =   -1  'True
  471.       SubtotalPosition=   1
  472.       OutlineBar      =   0
  473.       OutlineCol      =   0
  474.       Ellipsis        =   0
  475.       ExplorerBar     =   0
  476.       PicturesOver    =   0   'False
  477.       FillStyle       =   0
  478.       RightToLeft     =   0   'False
  479.       PictureType     =   0
  480.       TabBehavior     =   0
  481.       OwnerDraw       =   0
  482.       Editable        =   0   'False
  483.       ShowComboButton =   -1  'True
  484.       WordWrap        =   -1  'True
  485.       TextStyle       =   0
  486.       TextStyleFixed  =   0
  487.       OleDragMode     =   0
  488.       OleDropMode     =   0
  489.       DataMode        =   0
  490.       VirtualData     =   -1  'True
  491.       Begin VSFlex8Ctl.VSFlexGrid HjGrid 
  492.          Height          =   885
  493.          Left            =   0
  494.          TabIndex        =   8
  495.          Top             =   2400
  496.          Visible         =   0   'False
  497.          Width           =   7545
  498.          _ExtentX        =   13309
  499.          _ExtentY        =   1561
  500.          Appearance      =   1
  501.          BorderStyle     =   0
  502.          Enabled         =   -1  'True
  503.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  504.             Name            =   "宋体"
  505.             Size            =   9
  506.             Charset         =   134
  507.             Weight          =   400
  508.             Underline       =   0   'False
  509.             Italic          =   0   'False
  510.             Strikethrough   =   0   'False
  511.          EndProperty
  512.          MousePointer    =   0
  513.          BackColor       =   14671839
  514.          ForeColor       =   -2147483640
  515.          BackColorFixed  =   -2147483633
  516.          ForeColorFixed  =   -2147483630
  517.          BackColorSel    =   -2147483643
  518.          ForeColorSel    =   -2147483640
  519.          BackColorBkg    =   16777215
  520.          BackColorAlternate=   14671839
  521.          GridColor       =   -2147483633
  522.          GridColorFixed  =   -2147483632
  523.          TreeColor       =   -2147483632
  524.          FloodColor      =   192
  525.          SheetBorder     =   -2147483642
  526.          FocusRect       =   1
  527.          HighLight       =   1
  528.          AllowSelection  =   0   'False
  529.          AllowBigSelection=   0   'False
  530.          AllowUserResizing=   0
  531.          SelectionMode   =   0
  532.          GridLines       =   1
  533.          GridLinesFixed  =   2
  534.          GridLineWidth   =   1
  535.          Rows            =   5000
  536.          Cols            =   10
  537.          FixedRows       =   1
  538.          FixedCols       =   0
  539.          RowHeightMin    =   0
  540.          RowHeightMax    =   0
  541.          ColWidthMin     =   0
  542.          ColWidthMax     =   0
  543.          ExtendLastCol   =   0   'False
  544.          FormatString    =   ""
  545.          ScrollTrack     =   0   'False
  546.          ScrollBars      =   3
  547.          ScrollTips      =   0   'False
  548.          MergeCells      =   0
  549.          MergeCompare    =   0
  550.          AutoResize      =   -1  'True
  551.          AutoSizeMode    =   0
  552.          AutoSearch      =   0
  553.          MultiTotals     =   -1  'True
  554.          SubtotalPosition=   1
  555.          OutlineBar      =   0
  556.          OutlineCol      =   0
  557.          Ellipsis        =   0
  558.          ExplorerBar     =   0
  559.          PicturesOver    =   0   'False
  560.          FillStyle       =   0
  561.          RightToLeft     =   0   'False
  562.          PictureType     =   0
  563.          TabBehavior     =   0
  564.          OwnerDraw       =   0
  565.          Editable        =   0   'False
  566.          ShowComboButton =   -1  'True
  567.          WordWrap        =   -1  'True
  568.          TextStyle       =   0
  569.          TextStyleFixed  =   0
  570.          OleDragMode     =   0
  571.          OleDropMode     =   0
  572.          DataMode        =   0
  573.          VirtualData     =   -1  'True
  574.       End
  575.    End
  576.    Begin MSComctlLib.ImageCombo cboline 
  577.       Height          =   315
  578.       Left            =   1500
  579.       TabIndex        =   0
  580.       Top             =   1200
  581.       Visible         =   0   'False
  582.       Width           =   1575
  583.       _ExtentX        =   2778
  584.       _ExtentY        =   556
  585.       _Version        =   393216
  586.       ForeColor       =   -2147483640
  587.       BackColor       =   -2147483643
  588.       Locked          =   -1  'True
  589.    End
  590.    Begin MSComctlLib.ImageCombo cboMname 
  591.       Height          =   315
  592.       Left            =   3600
  593.       TabIndex        =   10
  594.       Top             =   1200
  595.       Visible         =   0   'False
  596.       Width           =   1695
  597.       _ExtentX        =   2990
  598.       _ExtentY        =   556
  599.       _Version        =   393216
  600.       ForeColor       =   -2147483640
  601.       BackColor       =   -2147483643
  602.       Locked          =   -1  'True
  603.    End
  604.    Begin MSComctlLib.ImageCombo cbodot 
  605.       Height          =   315
  606.       Left            =   5820
  607.       TabIndex        =   17
  608.       Top             =   1200
  609.       Visible         =   0   'False
  610.       Width           =   1575
  611.       _ExtentX        =   2778
  612.       _ExtentY        =   556
  613.       _Version        =   393216
  614.       ForeColor       =   -2147483640
  615.       BackColor       =   -2147483643
  616.       Locked          =   -1  'True
  617.    End
  618.    Begin VB.ComboBox Cmb_MNumber 
  619.       Height          =   300
  620.       Left            =   4305
  621.       Style           =   2  'Dropdown List
  622.       TabIndex        =   22
  623.       Top             =   1740
  624.       Visible         =   0   'False
  625.       Width           =   1455
  626.    End
  627.    Begin VB.ComboBox Cmb_SiteName 
  628.       Enabled         =   0   'False
  629.       Height          =   300
  630.       Left            =   6825
  631.       Style           =   2  'Dropdown List
  632.       TabIndex        =   18
  633.       Top             =   1740
  634.       Width           =   1630
  635.    End
  636.    Begin VB.ComboBox Cmb_SiteCode 
  637.       Height          =   300
  638.       Left            =   7545
  639.       Style           =   2  'Dropdown List
  640.       TabIndex        =   21
  641.       Top             =   1740
  642.       Visible         =   0   'False
  643.       Width           =   915
  644.    End
  645.    Begin VB.ComboBox Cmb_LineCode 
  646.       Enabled         =   0   'False
  647.       Height          =   300
  648.       Left            =   1560
  649.       Style           =   2  'Dropdown List
  650.       TabIndex        =   23
  651.       Top             =   1740
  652.       Visible         =   0   'False
  653.       Width           =   1275
  654.    End
  655.    Begin VB.Label TsLabel 
  656.       Alignment       =   1  'Right Justify
  657.       AutoSize        =   -1  'True
  658.       BackStyle       =   0  'Transparent
  659.       Caption         =   "单据号："
  660.       Height          =   180
  661.       Index           =   0
  662.       Left            =   120
  663.       TabIndex        =   16
  664.       Top             =   840
  665.       Width           =   765
  666.    End
  667.    Begin VB.Label Lab_Checker 
  668.       Appearance      =   0  'Flat
  669.       BackColor       =   &H80000005&
  670.       BackStyle       =   0  'Transparent
  671.       ForeColor       =   &H00000000&
  672.       Height          =   225
  673.       Left            =   7170
  674.       TabIndex        =   15
  675.       Top             =   6360
  676.       Width           =   735
  677.    End
  678.    Begin VB.Label Lab_Bill 
  679.       Appearance      =   0  'Flat
  680.       BackColor       =   &H80000005&
  681.       BackStyle       =   0  'Transparent
  682.       ForeColor       =   &H00000000&
  683.       Height          =   225
  684.       Left            =   9030
  685.       TabIndex        =   14
  686.       Top             =   6330
  687.       Width           =   735
  688.    End
  689.    Begin VB.Label Lab_OperStatus 
  690.       BackColor       =   &H000080FF&
  691.       Caption         =   "1"
  692.       Height          =   345
  693.       Left            =   10290
  694.       TabIndex        =   13
  695.       Top             =   960
  696.       Visible         =   0   'False
  697.       Width           =   345
  698.    End
  699.    Begin VB.Label Lab_Djclzt 
  700.       BackColor       =   &H0000FFFF&
  701.       Caption         =   "1"
  702.       ForeColor       =   &H00808080&
  703.       Height          =   255
  704.       Left            =   10320
  705.       TabIndex        =   12
  706.       Top             =   600
  707.       Visible         =   0   'False
  708.       Width           =   285
  709.    End
  710.    Begin VB.Label Lab_BillId 
  711.       AutoSize        =   -1  'True
  712.       BackColor       =   &H0080C0FF&
  713.       Height          =   270
  714.       Left            =   7680
  715.       TabIndex        =   11
  716.       Top             =   600
  717.       Visible         =   0   'False
  718.       Width           =   2490
  719.    End
  720.    Begin VB.Label Lab_Title 
  721.       AutoSize        =   -1  'True
  722.       BackColor       =   &H80000018&
  723.       BackStyle       =   0  'Transparent
  724.       Caption         =   "单据标题自动调整"
  725.       BeginProperty Font 
  726.          Name            =   "宋体"
  727.          Size            =   15
  728.          Charset         =   134
  729.          Weight          =   700
  730.          Underline       =   0   'False
  731.          Italic          =   0   'False
  732.          Strikethrough   =   0   'False
  733.       EndProperty
  734.       ForeColor       =   &H00000000&
  735.       Height          =   300
  736.       Left            =   2640
  737.       TabIndex        =   9
  738.       Top             =   780
  739.       Width           =   2520
  740.    End
  741. End
  742. Attribute VB_Name = "FrmJcsz_MidCheckStand"
  743. Attribute VB_GlobalNameSpace = False
  744. Attribute VB_Creatable = False
  745. Attribute VB_PredeclaredId = True
  746. Attribute VB_Exposed = False
  747. '***********************************************************************************************************
  748. '*    模 块 名 称 :中控检验标准
  749. '*    功 能 描 述 :此功能模块主要完成单据录入、修改、删除、预览打印等。
  750. '*    程序员姓名  :张晶石
  751. '*    最后修改人  :
  752. '*    最后修改时间:2002/01/22
  753. '*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
  754. '*
  755. '*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
  756. '*                                    TextValiLock=True             TextValiLock=false
  757. '*
  758. '*    2.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) "1"-浏览 "2"-新增 "3"-修改
  759. '*
  760. '*    3.Lab_Djclzt 用此标签来标识单据处理状态(默认值为1) "1"-填制单据  "2"-查询单据列表  "3"-明细帐联查单据
  761. '*
  762. '*    4.原则:只要单据能够存盘(无论修改或新增)则其必须接受完整性及有效性规则检查
  763. '***********************************************************************************************************
  764.  
  765. '[以下为根据实际情况设置变量
  766. Dim Bln_BillChange As Boolean                   '标识单据是否发生改动
  767. Dim Rec_Query As New ADODB.Recordset            '单据组查询结果动态集(保存当前单据组ID)
  768. Public Str_QueryCondi As String                 '单据组查询条件(接收单据列表传递查询条件)
  769. Public bln_Help As Boolean
  770. Dim str_TempSql As String
  771. Dim rs_Temp As New ADODB.Recordset
  772. ']
  774. '以下为固定使用变量(单据)
  775. Dim BillCode As String                          '单据设计编码(索引号)
  776. Dim Var_Bill() As Variant                       '用来返回单据设计信息
  777. Dim ReportTitle As String                       '报表主标题
  778. Dim Tsxx As String                              '系统提示信息
  780. '以下为固定使用变量(网格)
  781. Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
  782. Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
  783. Dim GridCode As String                          '显示网格网格代码
  784. Dim GridInf() As Variant                        '整个网格设置信息
  785. Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
  786. Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
  787. Dim Sfxshjwg As Boolean                         '是否显示合计网格
  788. Dim Qslz As Long                                '网格隐藏(非操作显示)列数
  789. Dim Sjhgd As Double                             '网格数据行高度
  790. Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
  791. Dim GridStr()  As String                        '网格列信息(字符型)
  792. Dim GridInt() As Integer                        '网格列信息(整型)
  793. Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
  794. Dim Dqlrwgh As Long                             '当前录入数据网格行
  795. Dim Dqlrwgl As Long                             '当前录入数据网格列
  796. Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
  797. Dim Dqlkwgl As Long                             '刚刚离开网格列
  798. Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
  799. Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
  800. Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
  801. Dim Wbkbhlock As Boolean                        '文本框改变值锁
  802. Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
  803. Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
  804. Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
  805. Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
  806. Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
  807. Dim Shsfts As Boolean                           '删除记录行是否提示
  808. Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
  810. '以下为固定使用变量(文本框)
  811. Dim Textvar() As Variant                        '存储变体型文本框信息
  812. Dim Textboolean() As Boolean                    '存储布尔型文本框信息
  813. Dim Textint() As Integer                        '存储整型文本框信息
  814. Dim Textstr() As String                         '存储字符型文本框信息
  815. Dim Max_Text_Index As Integer                   '最大录入文本框索引值
  816. Dim TextGroupCode As String                     '文本框录入分组编码
  817. Dim TextValiLock As Boolean                     '文本框失去焦点是否进行有效性控制判断
  818. Dim TextValiJudgeLock() As Boolean              '文本框录入有效性判断控制锁
  819. Dim TextChangeLock As Boolean                   '文本框内容变换控制锁
  820.     
  821. Private Sub Form_KeyPress(KeyAscii As Integer)      '控 制 焦 点 转 移
  823.     Dim jdzygs As Integer
  824.     jdzygs = 7                                       '在单据录入中,此焦点转移控制值一定小于等于文本框个数,否则网格回车键将不支持.
  825.     Select Case KeyAscii
  826.     Case vbKeyReturn
  827.         If Kjjdzy(jdzygs) Then
  828.             KeyAscii = 0
  829.         End If
  830.     Case 39           '屏蔽字符"'"
  831.         KeyAscii = 0
  832.     End Select
  834. End Sub
  836. Private Sub Form_Load()                                                        '窗 体 装 入
  837.     
  838.     '初始化各种锁值(Fixed)
  839.     Changelock = False             '网格行列改变控制锁
  840.     Gdtlock = False                '滚动条滚动控制
  841.     Yxxpdlock = True               '字段有效性判断锁
  842.     Hyxxpdlock = True              '行有效性判断锁
  843.     Wbkbhlock = False              '文本框内容改变锁
  844.     
  845.     '调入单据信息(需要修改BillCode)
  846.     BillCode = "1503"
  847.     Call Sub_ReadBillInfo(BillCode, Me, Var_Bill())
  848.     Lab_Title = Var_Bill(2)
  849.     Lab_Title.Move (Me.Width - Lab_Title.Width) / 2, 800
  850.     
  851.     '报表编码
  852.     XtReportCode = Var_Bill(5)
  853.     Load Dyymctbl
  854.     
  855.     '以下为文本框处理程序(Fixed)
  856.     TextGroupCode = Var_Bill(3)
  857.     
  858.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
  859.     Call Wbkcsh
  860.     
  861.     '调入网格并记录一些网格信息(Fixed)
  862.     GridCode = Var_Bill(4)         '网格属性编码
  863.     Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  864.     
  865.     Qslz = GridInf(1)
  866.     Sjhgd = GridInf(2)
  867.     Fzxwghs = GridInf(4)
  868.     Sfblbzkd = GridInf(5)
  869.     Shsfts = GridInf(6)
  870.     Sfxshjwg = GridInf(7)
  871.     Szzls = WglrGrid.Cols - 1
  872.     Pmbcsjhs = Int((WglrGrid.Height - WglrGrid.FixedRows * WglrGrid.RowHeight(0)) / Sjhgd) - Fzxwghs - 1
  873.     
  874.     For Jsqte = WglrGrid.FixedRows To WglrGrid.Rows - 1
  875.         WglrGrid.RowHeight(Jsqte) = Sjhgd
  876.     Next Jsqte
  877.     
  878.     '初始化合计网格(Fixed)
  879.     Call Cshhjwg
  880.     
  881.     '单据变动置为False(Fixed)
  882.     Bln_BillChange = False
  883.     
  884.     '调入数据初始化模块(Fixed)
  885.     Lab_Djclzt.Caption = Xtcdcs
  886.     Call Sjcsh(Trim(Lab_Djclzt.Caption))
  887.     
  888.     '[<<以下自定义部分,初始化下拉文本框
  889.     Cmb_LineName.Move LrText(0).Left, LrText(0).Top, LrText(0).Width
  890.     Cmb_MName.Move LrText(1).Left, LrText(1).Top, LrText(1).Width
  891.     Cmb_SiteName.Move LrText(2).Left, LrText(2).Top, LrText(2).Width
  892.     LrText(0).Visible = False
  893.     Call InitCmb
  894.     '>>]
  895. End Sub
  897. Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
  898.     
  899.     '是否保存已修改单据
  900.      Dim YAnswer As Integer
  901.      If Lab_OperStatus.Caption = "2" Or Lab_OperStatus.Caption = "3" Then
  902.          Tsxx = "单据尚未保存,是否退出?"
  903.          YAnswer = Xtxxts(Tsxx, 2, 2)
  904.          If YAnswer <> 1 Then
  905.              Cancel = 1
  906.              Exit Sub
  907.          End If
  908.      End If
  909.     
  910.     
  911.     '卸载打印页面窗体
  912.     Unload Dyymctbl
  913.     
  914.     '判断单据是否发生变化,并返回相应标识
  915.     If Bln_BillChange Then
  916.         Xtfhcs = "1"
  917.     Else
  918.         Xtfhcs = "0"
  919.     End If
  920.     
  921. End Sub
  923. Private Sub Sjcsh(Str_Pzclzt As String)              '数据初始化模块(根据实际情况)
  924.     
  925.     Dim Sqlstr As String       '查询单据列表条件
  926.     
  927.     '[>>根据实际情况初始化
  928.     Select Case Str_Pzclzt
  929.     Case "1"   '填制单据
  930.         '调入用户查询结果动态集(默认显示用户当前操作业务日期的单据)
  931.         Sqlstr = "SELECT midstandmainid From QC_MidStandMain ORDER BY midstandmainid "
  932.         Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  933.         
  934.         '新增单据
  935.         Call Sub_AddBill
  936.     Case "2"   '查询单据(单据列表)
  937.         
  938.         '填充查询单据标识
  939.         Lab_BillId.Caption = XT_BillID
  940.         Str_QueryCondi = Xtcdcsfz
  941.         
  942.         Call Sub_ShowBill
  943.         Call Sub_OperStatus("10")
  944.         
  945.         '调入用户查询结果动态集
  946.         Sqlstr = "SELECT DISTINCT midstandmainid From qc_v_midstandsub a " & Str_QueryCondi & " ORDER BY midstandmainid"
  947.         Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  948.         Rec_Query.Find "midstandmainid=" & Val(Lab_BillId.Caption)
  949.     Case "3"   '明细帐联查单据
  950.         '设置工具条显示
  951.         With Tlb_Action
  952.             .Buttons("xz").Enabled = False             '新增
  953.             .Buttons("xg").Enabled = False             '修改
  954.             .Buttons("sc").Enabled = False             '删除
  955.             .Buttons("fgh0").Enabled = False           '分隔行
  956.             .Buttons("zh").Enabled = False             '增行
  957.             .Buttons("sh").Enabled = False             '删行
  958.             .Buttons("fgh1").Enabled = False           '分隔行
  959.             .Buttons("bc").Enabled = False             '保存
  960.             .Buttons("fq").Enabled = False             '放弃
  961.             .Buttons("shsh").Enabled = False           '审核
  962.             .Buttons("shqs").Enabled = False           '弃审
  963.             .Buttons("fgh2").Enabled = False           '分隔行
  964.             .Buttons("find").Enabled = False           '查询
  965.             .Buttons("first").Enabled = False          '首张
  966.             .Buttons("prev").Enabled = False           '上张
  967.             .Buttons("next").Enabled = False           '下张
  968.             .Buttons("last").Enabled = False           '末张
  969.             .Buttons("fgh5").Enabled = False           '分割行
  970.         End With
  971.         
  972.         Call Sub_ShowBill
  973.         
  974.         '设置操作状态为浏览
  975.         Lab_OperStatus.Caption = "1"
  976.         
  977.         '录入文本框
  978.         For Jsqte = Max_Text_Index To 0 Step -1
  979.             LrText(Jsqte).Enabled = False
  980.         Next Jsqte
  981.     End Select
  982.     
  983.     '<<]
  984.     
  985. End Sub
  987. Private Sub Sub_ShowBill()                                          '根据当前单据ID显示整张单据内容
  988.     
  989.     '过程默认参数为当前窗体中单据ID:Lab_BillID
  990.     Dim Sqlstr As String                           '临时使用字符串
  991.     Dim RecTemp As New ADODB.Recordset             '临时使用动态集
  992.     Dim Jsqte As Long                              '临时计数器
  993.     
  994.     '禁止网格刷新动作,为加快网格显示速度(Fixed)
  995.     WglrGrid.Redraw = False
  996.     
  997.     '本张单据查询字符串
  998.     Sqlstr = "select * from qc_v_midstandsub Where midstandmainid='" & Val(Lab_BillId.Caption) & "' Order By qc_v_midstandsub.midStandSubId"
  999.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1000.     
  1001.     With RecTemp
  1002.         WglrGrid.Rows = WglrGrid.FixedRows
  1003.         If .EOF Then
  1004.             WglrGrid.Redraw = True
  1005.             Exit Sub
  1006.         Else
  1007.             '[>>显示单据头
  1008.             TextChangeLock = True     '文本框加锁
  1009.             Cmb_LineName.Text = Trim(.Fields("LineName") & "")                          '生产线名称
  1010.             Cmb_LineCode.Text = Trim(.Fields("LineCode") & "")                          '生产线代码
  1011.             LrText(0).Text = Trim(.Fields("LineName") & "")                             '生产线名称
  1012.             '填充物料下拉框
  1013.             Cmb_MName_DropDown
  1014.             For Jsqte = 0 To Cmb_MName.ListCount - 1
  1015.                 If Cmb_MName.List(Jsqte) = Trim(.Fields("MName")) Then
  1016.                     Cmb_MName.Text = Cmb_MName.List(Jsqte)                              '物料名称
  1017.                     Cmb_MNumber.Text = Cmb_MNumber.List(Jsqte)                          '物料代码
  1018.                     Exit For
  1019.                 End If
  1020.             Next Jsqte
  1021.             LrText(1).Text = Trim(.Fields("MName") & "")                                '物料名称
  1022.             '填充取样点下拉框
  1023.             Cmb_SiteName_DropDown
  1024.             For Jsqte = 0 To Cmb_SiteName.ListCount - 1
  1025.                 If Cmb_SiteName.List(Jsqte) = Trim(.Fields("SiteName")) Then
  1026.                     Cmb_SiteName.Text = Cmb_SiteName.List(Jsqte)                        '取样点名称
  1027.                     Cmb_SiteCode.Text = Cmb_SiteCode.List(Jsqte)                        '取样点代码
  1028.                     Exit For
  1029.                 End If
  1030.             Next Jsqte
  1031.             LrText(2).Text = Trim(.Fields("SiteName") & "")                             '取样点名称
  1032.             
  1033.             '<<]
  1034.         End If
  1035.         
  1036.         Jsqte = WglrGrid.FixedRows
  1037.         Do While Not .EOF
  1038.             WglrGrid.AddItem ""
  1039.             '[>>显示单据分录
  1040.             WglrGrid.TextMatrix(Jsqte, 0) = "*"                                                            '数据有效行标识(必填)
  1041.             WglrGrid.TextMatrix(Jsqte, 1) = Trim(.Fields("itemcode") & "")                                 '检验项目代码
  1042.             WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("itemname") & "")     '检验项目名称
  1043.             WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("stand") & "")        '检验标准
  1044.             WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("unitname") & "")     '计量单位
  1045.             WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Remark") & "")       '备注
  1046.             
  1047.             WglrGrid.RowHeight(Jsqte) = Sjhgd
  1048.             .MoveNext
  1049.             Jsqte = Jsqte + 1
  1050.         Loop
  1051.     End With
  1052.     
  1053.     
  1054.     '调整网格(Fixed)
  1055.     Call Sub_AdjustGrid
  1056.     
  1057.     '将网格刷新解禁(Fixed)
  1058.     WglrGrid.Redraw = True
  1059.     
  1060. End Sub
  1062. Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
  1063.     
  1064.     '屏蔽文本框,下拉组合框有效性判断
  1065.     Valilock = True
  1066.     
  1067.     '屏蔽网格失去焦点产生的有效性判断
  1068.     Changelock = True
  1069.     
  1070.     Select Case Button.Key
  1071.     Case "yl"                                            '预 览
  1072.         If Fun_Drfrmyxxpd Then
  1073.             BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, False
  1074.         End If
  1075.     Case "dy"                                            '打 印
  1076.         If Fun_Drfrmyxxpd Then
  1077.             Dim yhAnswer As Integer      '打印提示
  1078.             
  1079.             '用户确认是否打印单据
  1080.             Tsxx = "请确认是否打印当前单据?"
  1081.             yhAnswer = Xtxxts(Tsxx, 2, 2)
  1082.             If yhAnswer = 2 Then
  1083.                 Exit Sub
  1084.             End If
  1085.             BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, True
  1086.         End If
  1087.     Case "xz"                                            '新 增
  1088.         Call Sub_AddBill
  1089.     Case "xg"                                            '修 改
  1090.         Call Sub_EditBill
  1091.     Case "sc"                                            '删 除
  1092.         Call Sub_DeleteBill
  1093.     Case "zh"                                            '增 行
  1094.         Call zjlrfl
  1095.     Case "sh"                                            '删 行
  1096.         Call Scdqfl
  1097.     Case "bc"                                            '保 存
  1098.         If Fun_Drfrmyxxpd Then
  1099.             Call Sub_SaveBill
  1100.         End If
  1101.     Case "fq"                                            '放 弃
  1102.         Call Sub_AbandonBill
  1103.     Case "find"                                          '查 询
  1104.         Call Drbmhelp(0, "Qc_MidCheckStand", "")
  1105.         If Xtfhcs <> "" Then
  1106.             Lab_BillId.Caption = Xtfhcs
  1107.             Call Sub_ShowBill
  1108.         End If
  1109.     Case "first"                                         '首 张
  1110.         Call Sub_First
  1111.     Case "prev"                                          '上 张
  1112.         Call Sub_Prev
  1113.     Case "next"                                          '下 张
  1114.         Call Sub_Next
  1115.     Case "last"                                          '末 张
  1116.         Call Sub_Last
  1117.     Case "bz"                                            '帮 助
  1118.         Call F1bz
  1119.     Case "fh"                                            '退 出
  1120.         Unload Me
  1121.     End Select
  1122.     
  1123.     '解 锁
  1124.     Valilock = False
  1125.     Changelock = False
  1126.     TextChangeLock = False
  1127.     
  1128. End Sub
  1130. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)     '支持热键操作
  1131.     
  1132.     Select Case KeyCode
  1133.     Case vbKeyF5          '增加单据
  1134.         If Tlb_Action.Buttons("xz").Enabled And Tlb_Action.Buttons("xz").Visible Then
  1135.             Call Sub_AddBill
  1136.         End If
  1137.     Case vbKeyF3          '修改单据
  1138.         If Tlb_Action.Buttons("xg").Enabled And Tlb_Action.Buttons("xg").Visible Then
  1139.             Call Sub_EditBill
  1140.         End If
  1141.     Case vbKeyF6          '保存单据
  1142.         If Tlb_Action.Buttons("bc").Enabled And Tlb_Action.Buttons("bc").Visible Then
  1143.             If Fun_Drfrmyxxpd Then Call Sub_SaveBill
  1144.         End If
  1145.     End Select
  1146.     
  1147. End Sub
  1149. Private Sub Sub_OperStatus(Str_Status As String)                 '工具条依据不同状态所进行的变化
  1150.     
  1151.     With Tlb_Action
  1152.         Select Case Str_Status
  1153.         Case "10"   '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
  1154.             '工具条
  1155.             .Buttons("dy").Enabled = True       '打印
  1156.             .Buttons("yl").Enabled = True       '预览
  1157.             .Buttons("xz").Enabled = True       '新增
  1158.             .Buttons("xg").Enabled = True       '修改
  1159.             .Buttons("sc").Enabled = True       '删除
  1160.             .Buttons("zh").Enabled = False      '增行
  1161.             .Buttons("sh").Enabled = False      '删行
  1162.             .Buttons("bc").Enabled = False      '保存
  1163.             .Buttons("fq").Enabled = False      '放弃
  1164.             .Buttons("find").Enabled = True     '查询
  1165.             .Buttons("first").Enabled = True    '首张
  1166.             .Buttons("prev").Enabled = True     '上张
  1167.             .Buttons("next").Enabled = True     '下张
  1168.             .Buttons("last").Enabled = True     '末张
  1169.             .Buttons("bz").Enabled = True       '帮助
  1170.             .Buttons("fh").Enabled = True       '退出
  1171.             
  1172.             '设置文本框浏览状态
  1173.             Call Sub_LrtextStatus(False)
  1174.         Case "20"   '新增单据(（录入）新增一张单据 、（列表）新增一张单据)
  1175.             '工具条
  1176.             .Buttons("dy").Enabled = False      '打印
  1177.             .Buttons("yl").Enabled = False      '预览
  1178.             .Buttons("xz").Enabled = False      '新增
  1179.             .Buttons("xg").Enabled = False      '修改
  1180.             .Buttons("sc").Enabled = False      '删除
  1181.             .Buttons("zh").Enabled = True       '增行
  1182.             .Buttons("sh").Enabled = True       '删行
  1183.             .Buttons("bc").Enabled = True       '保存
  1184.             .Buttons("fq").Enabled = True       '放弃
  1185.             .Buttons("find").Enabled = False    '查询
  1186.             .Buttons("first").Enabled = False   '首张
  1187.             .Buttons("prev").Enabled = False    '上张
  1188.             .Buttons("next").Enabled = False    '下张
  1189.             .Buttons("last").Enabled = False    '末张
  1190.             .Buttons("bz").Enabled = True       '帮助
  1191.             .Buttons("fh").Enabled = True       '退出
  1192.             
  1193.             '设置文本框录入状态
  1194.             Call Sub_LrtextStatus(True)
  1195.         Case "30"   '修改(（录入）调入修改功能、（列表）调入修改功能)
  1196.             '工具条
  1197.             .Buttons("dy").Enabled = False      '打印
  1198.             .Buttons("yl").Enabled = False      '预览
  1199.             .Buttons("xz").Enabled = False      '新增
  1200.             .Buttons("xg").Enabled = False      '修改
  1201.             .Buttons("sc").Enabled = False      '删除
  1202.             .Buttons("zh").Enabled = True       '增行
  1203.             .Buttons("sh").Enabled = True       '删行
  1204.             .Buttons("bc").Enabled = True       '保存
  1205.             .Buttons("fq").Enabled = True       '放弃
  1206.             .Buttons("find").Enabled = False    '查询
  1207.             .Buttons("first").Enabled = False   '首张
  1208.             .Buttons("prev").Enabled = False    '上张
  1209.             .Buttons("next").Enabled = False    '下张
  1210.             .Buttons("last").Enabled = False    '末张
  1211.             .Buttons("bz").Enabled = True       '帮助
  1212.             .Buttons("fh").Enabled = True       '退出
  1213.             
  1214.             '设置文本框录入状态
  1215.             Call Sub_LrtextStatus(False)
  1216.         End Select
  1217.     End With
  1218.     
  1219. End Sub
  1221. Private Sub Sub_LrtextStatus(TextEnabled As Boolean)                            '设置录入文本框状态
  1222.     
  1223.     '录入文本框状态设置
  1224.     If TextEnabled Then
  1225.         For Jsqte = Max_Text_Index To 0 Step -1
  1226.             '判断文本框是否可编辑
  1227.             If Textboolean(Jsqte, 5) Then
  1228.                 LrText(Jsqte).Enabled = True
  1229.             Else
  1230.                 LrText(Jsqte).Enabled = False
  1231.             End If
  1232.         Next Jsqte
  1233.         Cmb_LineName.Enabled = True
  1234.         Cmb_MName.Enabled = True
  1235.         Cmb_SiteName.Enabled = True
  1236.     Else
  1237.         For Jsqte = Max_Text_Index To 0 Step -1
  1238.             LrText(Jsqte).Enabled = False
  1239.         Next Jsqte
  1240.         Cmb_LineName.Enabled = False
  1241.         Cmb_SiteName.Enabled = False
  1242.         Cmb_MName.Enabled = False
  1243.     End If
  1244.     
  1245. End Sub
  1247. Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
  1248.     
  1249.     Dim xswbrr As String
  1250.     With WglrGrid
  1251.         Zdlrqnr = Trim(.Text)
  1252.         xswbrr = Trim(.Text)
  1253.         If GridBoolean(.Col, 3) Then   '列表框录入
  1254.             '填充列表框程序
  1255.             Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
  1256.         Else
  1257.             Wbkbhlock = True
  1258.             
  1259.             '====以下为用户自定义
  1260.             Ydtext.Text = xswbrr
  1261.             '====以上为用户自定义
  1262.             
  1263.             Wbkbhlock = False
  1264.             Ydtext.SelStart = Len(Ydtext.Text)
  1265.         End If
  1266.     End With
  1267.     
  1268. End Sub
  1270. Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
  1271.     
  1272.     '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
  1273.     
  1274.     Dim Str_JudgeText As String                 '临时有效性判断字段内容
  1275.     Dim Coljsq As Long                          '临时列计数器
  1276.     Dim RecTemp As New ADODB.Recordset          '临时使用动态集
  1277.     Dim Sqlstr As String                        '临时使用查询字符串
  1278.     
  1279.     With WglrGrid
  1280.         '非录入状态或非数据行则其有效性为合法
  1281.         If Yxxpdlock Or .Row < .FixedRows Then
  1282.             sjzdyxxpd = True
  1283.             Exit Function
  1284.         End If
  1285.         
  1286.         '取得当前要判断字段内容
  1287.         Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
  1288.         
  1289.         '根据不同字段进行相应的处理(依据其逻辑编号)
  1290.         Select Case GridStr(Dqpdwgl, 1)
  1291.             '[>>以下为自定义部分
  1292.             Case "001"                   '检验项目
  1293.                 If Not Trim(Str_JudgeText) = "" Then
  1294.                     '1.放置字段有效性判断
  1295.                     Sqlstr = "SELECT itemcode,itemname,unitname From qc_checkitem Where itemcode='" & Str_JudgeText & "' Or itemName='" & Str_JudgeText & "'"
  1296.                     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1297.                     If RecTemp.EOF Then
  1298.                         Tsxx = "此检验项目不存在!"
  1299.                         GoTo Lrcwcl
  1300.                     End If
  1301.                     
  1302.                     For i = .FixedRows To .Rows - 1
  1303.                        If Trim(.TextMatrix(i, 0)) = "*" Then
  1304.                            str_temp1 = Trim(.TextMatrix(i, Sydz("001", GridStr(), Szzls)))
  1305.                            For j = i + 1 To .Rows - 1
  1306.                                If Trim(.TextMatrix(j, 0)) = "*" Then
  1307.                                    str_temp2 = Trim(.TextMatrix(j, Sydz("001", GridStr(), Szzls)))
  1308.                                    If str_temp1 = str_temp2 Then
  1309.                                        Tsxx = "检验项目不能重复!"
  1310.                                        GoTo Lrcwcl
  1311.                                    End If
  1312.                                End If
  1313.                            Next j
  1314.                        End If
  1315.                     Next i
  1316.                   
  1317.                   '2.放置字段事后处理程序
  1318.                     .TextMatrix(Dqpdwgh, 1) = Trim(RecTemp.Fields("itemcode") & "")                                  '显示检验项目
  1319.                     .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("itemName") & "")      '显示检验项目名称
  1320.                     .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("unitname") & "")      '显示检验项目计量单位
  1321.                     
  1322.                 Else
  1323.                     '3.清空相关字段
  1324.                     .TextMatrix(Dqpdwgh, 0) = ""
  1325.                     .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = ""
  1326.                     .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = ""
  1327.                     .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = ""
  1328.                     .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = ""
  1329.                 End If
  1330.     '            '<<以上为自定义部分]
  1331.         End Select
  1332.         
  1333.         '字段录入正确后为零字段清空(Fixed)
  1334.         Call Qkwlzd(Dqpdwgh, Dqpdwgl)
  1335.         
  1336.         '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
  1337.         sjzdyxxpd = True
  1338.         Yxxpdlock = True
  1339.         Exit Function
  1340.     End With
  1341.     
  1342. Lrcwcl:    '录入错误处理
  1343.     With WglrGrid
  1344.         
  1345.         '给出错误提示信息
  1346.         Call Xtxxts(Tsxx, 0, 1)
  1347.         
  1348.         '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
  1349.         Changelock = True
  1350.         .Select Dqpdwgh, Dqpdwgl
  1351.         Changelock = False
  1352.         Call xswbk
  1353.         
  1354.         '函数返回False
  1355.         sjzdyxxpd = False
  1356.         Exit Function
  1357.     End With
  1358.     
  1359. End Function
  1361. Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                     '录入数据行有效性判断,同时进行行处理
  1362.     
  1363.     '函数参数:Yxxpdh 要进行有效性判断的网格数据行的行值
  1364.     
  1365.     Dim Lrywlz As Long                            '录入有误网格列值
  1366.     Dim RecTemp As New ADODB.Recordset            '临时使用动态集
  1367.     
  1368.     With WglrGrid
  1369.         '判断行为空(行中所有可编辑列数据均为空或为零)和无效数据行则清除当前行
  1370.         If .Rows <= .FixedRows Then Exit Function   ' 如果没有记录，则退出
  1371.         If .TextMatrix(Yxxpdh, 0) <> "*" Then
  1372.             Sjhzyxxpd = True
  1373.             Exit Function
  1374.         Else
  1375.             If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
  1376.                 '当要判断行处于网格末行时才允许删行,否则要进行有效性判断
  1377.                 If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
  1378.                     Changelock = True
  1379.                     .RemoveItem Yxxpdh
  1380.                     If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1381.                         .AddItem ""
  1382.                         .RowHeight(.Rows - 1) = Sjhgd
  1383.                     End If
  1384.                     Changelock = False
  1385.                     Sjhzyxxpd = True
  1386.                     Exit Function
  1387.                 End If
  1388.             End If
  1389.         End If
  1390.         
  1391.         '行没有发生变化则不进行有效性判断
  1392.         If Hyxxpdlock Then
  1393.             Sjhzyxxpd = True
  1394.             Exit Function
  1395.         End If
  1396.         
  1397.         '[>>以下为自定义部分
  1398.         
  1399.         '1.放置行有效性判断程序
  1400.         
  1401.         '1.1首先进行单个不能为空或不能为零判断(Fixed)
  1402.         For Jsqte = Qslz To .Cols - 1
  1403.             
  1404.             '字段不能为空
  1405.             If GridInt(Jsqte, 5) = 1 Then
  1406.                 If Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
  1407.                     Tsxx = GridStr(Jsqte, 2)
  1408.                     Lrywlz = Jsqte
  1409.                     GoTo Lrcwcl
  1410.                     Exit For
  1411.                 End If
  1412.             End If
  1413.             
  1414.             '字段不能为零
  1415.             If GridInt(Jsqte, 5) = 2 Then
  1416.                 If Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
  1417.                     Tsxx = GridStr(Jsqte, 2)
  1418.                     Lrywlz = Jsqte
  1419.                     GoTo Lrcwcl
  1420.                     Exit For
  1421.                 End If
  1422.             End If
  1423.         Next Jsqte
  1424.         
  1425.         '1.2进行其他有效性判断,编写格式同1.1
  1426.         
  1427.         '2.放置行处理程序(当数据行通过有效性判断)
  1428.         
  1429.         '以上为自定义部分<<]
  1430.     End With    'WglrGrid
  1431.     
  1432.     '如果此行通过行有效性判断则加锁,直至此行数据再次发生变化
  1433.     Sjhzyxxpd = True
  1434.     Hyxxpdlock = True
  1435.     Exit Function
  1436.     
  1437. Lrcwcl:      '录入错误处理
  1438.     With WglrGrid
  1439.         
  1440.         '给出错误提示信息
  1441.         Call Xtxxts(Tsxx, 0, 1)
  1442.         
  1443.         '返回网格错误位置 (ChangeLock避免再次引发RowColChange有效性判断), 装入录入载体
  1444.         Changelock = True
  1445.         .Select Yxxpdh, Lrywlz
  1446.         Changelock = False
  1447.         Call xswbk
  1448.         
  1449.         '函数返回False
  1450.         Sjhzyxxpd = False
  1451.         Exit Function
  1452.     End With
  1453.     
  1454. End Function
  1456. Private Sub Sub_AddBill()                                                '新增一张单据
  1457.     
  1458.     Dim RecTemp As New ADODB.Recordset            '临时使用动态集
  1459.     Dim Jsqte As Long                             '临时计数器
  1460.     
  1461.     '设置操作状态为新增(Fixed)
  1462.     Lab_OperStatus.Caption = "2"
  1463.     
  1464.     '设置工具条状态(Fixed)
  1465.     Call Sub_OperStatus("20")
  1466.     
  1467.     '清空VouchID(Fixed)
  1468.     Lab_BillId.Caption = ""
  1469.     
  1470.     '录入文本框清除内容
  1471.     For Jsqte = Max_Text_Index To 0 Step -1
  1472.         LrText(Jsqte).Tag = ""
  1473.         LrText(Jsqte).Text = ""
  1474.     Next Jsqte
  1475.     
  1476.     '重置网格(Fixed)
  1477.     With WglrGrid
  1478.         .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  1479.         For Jsqte = .FixedRows To .Rows - 1
  1480.             .RowHeight(Jsqte) = Sjhgd
  1481.         Next Jsqte
  1482.         WglrGrid.Clear 1
  1483.         Changelock = True
  1484.         .Select .FixedRows, Qslz
  1485.         Changelock = False
  1486.     End With
  1487.     
  1488.     '让第一个录入项得到焦点(Fixed)
  1489.     On Error Resume Next
  1490.     Cmb_SiteName.ListIndex = -1
  1491.     Cmb_SiteName.SetFocus
  1492.     
  1493. End Sub
  1495. Private Sub Sub_EditBill()                                                '修改一张单据
  1496.     
  1497.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  1498.     
  1499.     '非有效单据不予进行修改动作
  1500.     If Val(Lab_BillId.Caption) = 0 Then
  1501.         Exit Sub
  1502.     End If
  1503.     
  1504.     '设置操作状态为修改
  1505.     Lab_OperStatus.Caption = "3"
  1506.     
  1507.     '设置工具条状态
  1508.     Call Sub_OperStatus("30")
  1509.     
  1510. End Sub
  1512. Private Sub Sub_DeleteBill()                                               '删除当前单据
  1513.     Dim YAnswer As Integer               '确认是否删除当前单据
  1514.     Dim Jsqte As Long                    '临时使用计数器
  1515.     
  1516.     '非有效单据不予进行删除动作
  1517.     If Val(Lab_BillId.Caption) = 0 Then
  1518.         Exit Sub
  1519.     End If
  1520.     
  1521.     Tsxx = "请确认是否删除当前单据?"
  1522.     YAnswer = Xtxxts(Tsxx, 2, 2)
  1523.     
  1524.     If YAnswer = 1 Then
  1525.         
  1526.         '进行事务处理
  1527.         On Error GoTo Swcwcl
  1528.         Cw_DataEnvi.DataConnect.BeginTrans
  1529.         
  1530.         '1.删除单据所有内容
  1531.         Cw_DataEnvi.DataConnect.Execute ("Delete Qc_MidStandSub Where midstandmainid=" & Val(Lab_BillId.Caption))
  1532.         Cw_DataEnvi.DataConnect.Execute ("Delete QC_MidStandMain Where midstandmainid=" & Val(Lab_BillId.Caption))
  1533.         
  1534.         Cw_DataEnvi.DataConnect.CommitTrans
  1535.         
  1536.         '标识单据发生改动
  1537.         Bln_BillChange = True
  1538.         
  1539.         '单据ID置0
  1540.         Lab_BillId.Caption = 0
  1541.     Else
  1542.         Exit Sub
  1543.     End If
  1544.     
  1545.     '删除单据后重置状态
  1546.     
  1547.     '1.显示下一张单据
  1548.     Call Sub_Next
  1549.     
  1550.     '2.如果无下一张单据则搜索上一张单据
  1551.     If Val(Lab_BillId.Caption) = 0 Then
  1552.         Call Sub_Prev
  1553.     End If
  1554.     
  1555.     '3.如无单据则置单据为空状态
  1556.     If Val(Lab_BillId.Caption) = 0 Then
  1557.         '清除录入文本框
  1558.         For Jsqte = Max_Text_Index To 0 Step -1
  1559.             LrText(Jsqte).Tag = ""
  1560.             LrText(Jsqte).Text = ""
  1561.         Next Jsqte
  1562.         
  1563.         '重置网格(Fixed)
  1564.         With WglrGrid
  1565.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  1566.             For Jsqte = .FixedRows To .Rows - 1
  1567.                 .RowHeight(Jsqte) = Sjhgd
  1568.             Next Jsqte
  1569.             WglrGrid.Clear 1
  1570.             Changelock = True
  1571.             .Select .FixedRows, Qslz
  1572.             Changelock = False
  1573.         End With
  1574.         
  1575.         '设置操作状态为浏览
  1576.         Lab_OperStatus = "1"
  1577.         Call Sub_OperStatus("10")
  1578.     End If
  1579.     
  1580.     Rec_Query.Requery
  1581.     Rec_Query.Find "midstandmainid=" & Val(Lab_BillId.Caption)
  1582.     Exit Sub
  1583.     
  1584. Swcwcl:          '单据删除时出现错误
  1585.     Cw_DataEnvi.DataConnect.RollbackTrans
  1586.     If Err.Number = -2147217873 Then              '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
  1587.         Tsxx = "该检验标准已经被使用,不能删除!"
  1588.         Call Xtxxts(Tsxx, 0, 1)
  1589.         Exit Sub
  1590.     Else
  1591.         Tsxx = "单据删除过程中出现未知错误,程序自动恢复保存前状态!"
  1592.         Call Xtxxts(Tsxx, 0, 1)
  1593.         Exit Sub
  1594.     End If
  1595.     
  1596. End Sub
  1598. Private Sub Sub_AbandonBill()                                              '放弃对当前单据的操作
  1599.     
  1600.     Dim Jsqte As Long                    '临时使用计数器
  1601.     
  1602.     '先关闭录入载体(Fixed)
  1603.     Changelock = True
  1604.     Valilock = True
  1605.     Call Ycwbk
  1606.     Changelock = False
  1607.     Valilock = False
  1608.     
  1609.     '如果单据有效则重新显示当前单据,置单据为空状态
  1610.     Lab_OperStatus = "1"
  1611.     If Not Rec_Query.EOF Then
  1612.         Lab_BillId.Caption = Rec_Query.Fields("midstandmainid")
  1613.         Call Sub_ShowBill
  1614.     Else
  1615.         '单据ID置为0
  1616.         Lab_BillId.Caption = 0
  1617.         
  1618.         '清除录入文本框
  1619.         For Jsqte = Max_Text_Index To 0 Step -1
  1620.             LrText(Jsqte).Tag = ""
  1621.             LrText(Jsqte).Text = ""
  1622.         Next Jsqte
  1623.        
  1624.        '重置网格(Fixed)
  1625.         With WglrGrid
  1626.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  1627.             For Jsqte = .FixedRows To .Rows - 1
  1628.                 .RowHeight(Jsqte) = Sjhgd
  1629.             Next Jsqte
  1630.             
  1631.             WglrGrid.Clear 1
  1632.             Changelock = True
  1633.             .Select .FixedRows, Qslz
  1634.             Changelock = False
  1635.         End With
  1636.     End If
  1637.     
  1638.     '设置操作状态为浏览
  1639.     Lab_OperStatus = "1"
  1640.     Call Sub_OperStatus("10")
  1641. End Sub
  1643. Private Function Sub_SaveBill() As Boolean                                   '保 存 单 据
  1644.     
  1645.     Dim RecTemp As New ADODB.Recordset                    '临时使用动态集
  1646.     Dim Rec_VouchMain As New ADODB.Recordset              '单据主表动态集
  1647.     Dim Rec_VouchSub As New ADODB.Recordset               '单据子表动态集
  1648.     Dim Rowjsq As Long                                    '网格行计数器
  1649.     Dim Coljsq As Long                                    '网格列计数器
  1650.     Dim Jsqte As Integer                                  '临时计数器
  1651.     Dim Lng_RowCount As Long                              '有效数据行计数器
  1652.     Dim Lrywlz As Long                                    '录入有误列值
  1653.     
  1654.     Sub_SaveBill = False
  1655.     
  1656.     '一.============先对单据内容进行有效性判断==============='
  1657.     
  1658.     '先进行字段不能为空或不能为零有效性判断(Fixed)
  1659.     For Jsqte = 0 To Max_Text_Index
  1660.         If Textint(Jsqte, 8) = 1 Then     '字段不能为空
  1661.             If Len(Trim(LrText(Jsqte).Text)) = 0 Then
  1662.                 Tsxx = Textstr(Jsqte, 7) & "不能为空!"
  1663.                 Call Xtxxts(Tsxx, 0, 1)
  1664.                 LrText(Jsqte).SetFocus
  1665.                 Exit Function
  1666.             End If
  1667.         Else
  1668.             If Textint(Jsqte, 8) = 2 Then   '字段不能为零
  1669.                 If Val(Trim(LrText(Jsqte).Text)) = 0 Then
  1670.                     Tsxx = Textstr(Jsqte, 7) & "不能为零!"
  1671.                     Call Xtxxts(Tsxx, 0, 1)
  1672.                     LrText(Jsqte).SetFocus
  1673.                     Exit Function
  1674.                 End If
  1675.             End If
  1676.         End If
  1677.     Next Jsqte
  1678.     
  1679.     '对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
  1680.     For Jsqte = 0 To Max_Text_Index
  1681.         If Textint(Jsqte, 9) = 0 Or Textint(Jsqte, 9) = 2 Then
  1682.             If Not TextYxxpd(Jsqte) Then
  1683.                 Call TextShow(Jsqte)
  1684.                 Exit Function
  1685.             End If
  1686.         End If
  1687.     Next Jsqte
  1688.     
  1689.     '[>>
  1690.     
  1691.     '可在此区域写入其他对单据表头内容的有效性判断.
  1692.    If Cmb_LineName.Text = "" Then
  1693.        Tsxx = "生产线不能为空!"
  1694.        Call Xtxxts(Tsxx, 0, 1)
  1695.        Cmb_LineName.SetFocus
  1696.        Exit Function
  1697.     End If
  1698.    If Cmb_MName.Text = "" Then
  1699.        Tsxx = "中控物料名称不能为空!"
  1700.        Call Xtxxts(Tsxx, 0, 1)
  1701.        Cmb_MName.SetFocus
  1702.        Exit Function
  1703.     End If
  1704.    If Cmb_SiteName.Text = "" Then
  1705.        Tsxx = "取样点名称不能为空!"
  1706.        Call Xtxxts(Tsxx, 0, 1)
  1707.        Cmb_SiteName.SetFocus
  1708.        Exit Function
  1709.    End If
  1711.     
  1712.     '<<]
  1713.     
  1714.     '[>>下面将对所有有效数据行进行有效性判断
  1715.     
  1716.     Lng_RowCount = 0
  1717.     
  1718.     With WglrGrid
  1719.         For Rowjsq = .FixedRows To .Rows - 1
  1720.             '带*号者为有效数据行(Fixed)
  1721.             If .TextMatrix(Rowjsq, 0) <> "*" Then
  1722.                 Exit For
  1723.             Else
  1724.                 Lng_RowCount = Lng_RowCount + 1
  1725.             End If
  1726.             
  1727.             '1.首先进行为空或为零判断(Fixed)
  1728.             
  1729.             For Jsqte = Qslz To .Cols - 1
  1730.                 
  1731.                 '字段不能为空
  1732.                 If GridInt(Jsqte, 5) = 1 Then
  1733.                     If Len(Trim(.TextMatrix(Rowjsq, Jsqte))) = 0 Then
  1734.                         Tsxx = GridStr(Jsqte, 2)
  1735.                         Lrywlz = Jsqte
  1736.                         GoTo Lrcwcl
  1737.                         Exit For
  1738.                     End If
  1739.                 End If
  1740.                 
  1741.                 '字段不能为零
  1742.                 If GridInt(Jsqte, 5) = 2 Then
  1743.                     If Val(Trim(.TextMatrix(Rowjsq, Jsqte))) = 0 Then
  1744.                         Tsxx = GridStr(Jsqte, 2)
  1745.                         Lrywlz = Jsqte
  1746.                         GoTo Lrcwcl
  1747.                         Exit For
  1748.                     End If
  1749.                 End If
  1750.             Next Jsqte
  1751.             
  1752.             '2.判断检验项目是否存在(Define)
  1753.             Sqlstr = "SELECT itemcode From qc_checkitem Where itemCode='" & Trim(.TextMatrix(Rowjsq, 1)) & "'"
  1754.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1755.             If RecTemp.EOF Then
  1756.                 Tsxx = "此检验项目不存在!"
  1757.                 Lrywlz = Sydz("001", GridStr(), Szzls)
  1758.                 GoTo Lrcwcl
  1759.             End If
  1760.         Next Rowjsq
  1761.         
  1762.         '单据分录行数不能为零(Fixed)
  1763.         If Lng_RowCount = 0 Then
  1764.             Tsxx = "检验项目不能为空!"
  1765.             Call Xtxxts(Tsxx, 0, 1)
  1766.             Exit Function
  1767.         End If
  1768.         
  1769.         '[>>
  1770.         '此处可以定义整张单据不能通过有效性检查的理由
  1771.      For i = .FixedRows To .Rows - 1
  1772.         If Trim(.TextMatrix(i, 0)) = "*" Then
  1773.             str_temp1 = Trim(.TextMatrix(i, Sydz("001", GridStr(), Szzls)))
  1774.             For j = i + 1 To .Rows - 1
  1775.                 If Trim(.TextMatrix(j, 0)) = "*" Then
  1776.                     str_temp2 = Trim(.TextMatrix(j, Sydz("001", GridStr(), Szzls)))
  1777.                     If str_temp1 = str_temp2 Then
  1778.                         Call Xtxxts("检验项目不能重复!", 0, 1)
  1779.                         Exit Function
  1780.                     End If
  1781.                 End If
  1782.             Next j
  1783.         End If
  1784.     Next i
  1786.         '<<]
  1787.     End With  '网格
  1788.     
  1789.     
  1790.     '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
  1791.     
  1792.     '对存盘进行事务处理(Fixed)
  1793.     On Error GoTo Swcwcl
  1794.     Cw_DataEnvi.DataConnect.BeginTrans
  1795.     
  1796.     '判断单据状态以进行不同处理
  1797.     
  1798.     '1.先对单据主表进行处理
  1799.     If Trim(Lab_OperStatus) = "2" Then
  1800.         
  1801.         '新增单据
  1802.         
  1803.         '1.对于某些单据号自动生成的单据则可在此处自动生成
  1804.         LrText(0).Text = CreatBillCode(BillCode, True)
  1805.         
  1806.         '2.开始存盘
  1807.         
  1808.         '打开单据主表动态集
  1809.         If Rec_VouchMain.State = 1 Then Rec_VouchMain.Close
  1810.         Rec_VouchMain.Open "Select * From QC_MidStandMain Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1811.         
  1812.         With Rec_VouchMain
  1813.             .AddNew
  1814.             .Fields("midstandmainid") = CreatBillID(BillCode)
  1815.             .Fields("mnumber") = Trim(Cmb_MNumber.Text & "")
  1816.             .Fields("linecode") = Trim(Cmb_LineCode.Text & "")
  1817.             .Fields("sitecode") = Trim(Cmb_SiteCode.Text & "")
  1818.             .Update
  1819.             '系统读出单据ID写入Lab_BillID
  1820.             Lab_BillId.Caption = .Fields("midstandmainid")
  1821.         End With
  1822.     Else
  1823.         '修改单据
  1824.         
  1825.         '1.删除原单据子表中所有内容
  1826.         
  1827.         Cw_DataEnvi.DataConnect.Execute ("Delete Qc_MidStandSub Where midstandmainid=" & Val(Lab_BillId.Caption))
  1828.         
  1829.     End If
  1830.     
  1831.     '2.对单据子表进行处理
  1832.     
  1833.     '打开单据子表动态集
  1834.     If Rec_VouchSub.State = 1 Then Rec_VouchSub.Close
  1835.     Rec_VouchSub.Open "Select * From Qc_MidStandSub Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1836.     
  1837.     '将网格中有效数据行写入单据子表
  1838.     For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
  1839.         If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
  1840.             Exit For
  1841.         End If
  1842.         
  1843.         With Rec_VouchSub
  1844.             .AddNew
  1845.             .Fields("midStandSubId") = Rowjsq - WglrGrid.FixedRows + 1                            '单据记录顺序号
  1846.             .Fields("midstandmainid") = Val(Lab_BillId.Caption)                                   '单据ID
  1847.             .Fields("ItemCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 1))                            '检验项目
  1848.             .Fields("Stand") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)))   '检验标准
  1849.             .Fields("Remark") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))  '备注
  1850.             .Update
  1851.         End With
  1852.     Next Rowjsq
  1853.     Cw_DataEnvi.DataConnect.CommitTrans
  1854.     
  1855.     Sub_SaveBill = True
  1856.     Tsxx = "单据存盘完毕!"
  1857.     Call Xtxxts(Tsxx, 0, 4)
  1858.     
  1859.     '标识单据发生改动
  1860.     Bln_BillChange = True
  1861.     
  1862.     '设置单据改变后的状态
  1863.     Lab_OperStatus = "1"
  1864.     Call Sub_OperStatus("10")
  1865.     Rec_Query.Requery
  1866.     Rec_Query.Find "midstandmainid=" & Val(Lab_BillId.Caption)
  1867.     
  1868.     Exit Function
  1869.     
  1870. Swcwcl:       '数据存盘时出现错误
  1871.     Cw_DataEnvi.DataConnect.RollbackTrans
  1872.     With WglrGrid
  1873.         If Err.Number = -2147217887 Then
  1874.             Tsxx = "单据中第  " & Trim(Str(Rowjsq - .FixedRows + 1)) & " 条分录录入数据超出允许范围!"
  1875.             Call Xtxxts(Tsxx, 0, 1)
  1876.             Changelock = True
  1877.             .Select Rowjsq, Qslz
  1878.             WglrGrid.SetFocus
  1879.             Changelock = False
  1880.             Exit Function
  1881.         Else
  1882.             Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  1883.             Call Xtxxts(Tsxx, 0, 1)
  1884.             Exit Function
  1885.         End If
  1886.     End With
  1887.     
  1888. Lrcwcl:        '录入错误处理(存盘前逐行有效性判断)
  1889.     With WglrGrid
  1890.         Call Xtxxts("(第 " & Trim(Str(Rowjsq - .FixedRows + 1)) & " 条单据分录)-" & Tsxx, 0, 1)
  1891.         Changelock = True
  1892.         .Select Rowjsq, Lrywlz
  1893.         WglrGrid.SetFocus
  1894.         Changelock = False
  1895.         Exit Function
  1896.     End With
  1897.     
  1898. End Function
  1900. '选择首张,上张,下张,末张(此4个过程只需用您的单据ID字段名替换"midstandmainid"即可)
  1901. Private Sub Sub_First()             '首 张
  1902.     
  1903.     With Rec_Query
  1904.         If .RecordCount = 0 Then
  1905.             Exit Sub
  1906.         End If
  1907.         .MoveFirst
  1908.         Lab_BillId.Caption = .Fields("midstandmainid")
  1909.         Call Sub_ShowBill
  1910.     End With
  1911.     
  1912. End Sub
  1914. Private Sub Sub_Prev()             '上 张
  1915.     
  1916.     With Rec_Query
  1917.         If .RecordCount = 0 Then
  1918.             Exit Sub
  1919.         End If
  1920.         If Not .BOF Then
  1921.             .MovePrevious
  1922.         End If
  1923.         If Not .BOF Then
  1924.             Lab_BillId.Caption = .Fields("midstandmainid")
  1925.         Else
  1926.             .MoveNext
  1927.         End If
  1928.         Call Sub_ShowBill
  1929.     End With
  1930.     
  1931. End Sub
  1933. Private Sub Sub_Next()             '下 张
  1934.     With Rec_Query
  1935.         If .RecordCount = 0 Then
  1936.             Exit Sub
  1937.         End If
  1938.         If Not .EOF Then
  1939.             .MoveNext
  1940.         End If
  1941.         If Not .EOF Then
  1942.             Lab_BillId.Caption = .Fields("midstandmainid")
  1943.         Else
  1944.             .MovePrevious
  1945.         End If
  1946.         Call Sub_ShowBill
  1947.     End With
  1948.     
  1949. End Sub
  1951. Private Sub Sub_Last()              '末 张
  1952.     
  1953.     With Rec_Query
  1954.         If .RecordCount = 0 Then
  1955.             Exit Sub
  1956.         End If
  1957.         .MoveLast
  1958.         Lab_BillId.Caption = .Fields("midstandmainid")
  1959.         Call Sub_ShowBill
  1960.     End With
  1961.     
  1962. End Sub
  1964. '[>>===================以下为根据实际业务需要自定义过程区域=============================<<]
  1966. '*****************以下为下拉框设置*******************
  1967. Private Sub InitCmb()
  1968.     Dim Rec_Line As New ADODB.Recordset
  1969.     Cmb_LineCode.Clear
  1970.     Cmb_LineName.Clear
  1971.     Cmb_LineCode.AddItem " "
  1972.     Cmb_LineName.AddItem " "
  1973.     Set Rec_Line = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM QC_ProductLine Order By LineCode ")
  1974.     If Rec_Line.RecordCount < 1 Then
  1975.         Rec_Line.Close
  1976.         Exit Sub
  1977.     End If
  1978.     Do While Not Rec_Line.EOF
  1979.         Cmb_LineCode.AddItem Trim(Rec_Line.Fields("LineCode") & "")
  1980.         Cmb_LineName.AddItem Trim(Rec_Line.Fields("LineName") & "")
  1981.         Rec_Line.MoveNext
  1982.     Loop
  1983.     Cmb_LineCode.ListIndex = 0
  1984.     Cmb_LineName.ListIndex = 0
  1985.     '设置TabIndex
  1986.     Cmb_LineName.TabIndex = 0
  1987.     Cmb_MName.TabIndex = 1
  1988.     Cmb_SiteName.TabIndex = 2
  1989. End Sub
  1991. Private Sub Cmb_LineName_Click()
  1992.     If Cmb_LineCode.ListIndex <> Cmb_LineName.ListIndex Then
  1993.         WglrGrid.Clear 1
  1994.         Cmb_LineCode.Text = Cmb_LineCode.List(Cmb_LineName.ListIndex)
  1995.         Cmb_MName_DropDown
  1996.         Cmb_SiteName_DropDown
  1997.     End If
  1998. End Sub
  2000. '[<<=====================按回车转移焦点自动填充列表框=====================
  2001. Private Sub Cmb_LineName_LostFocus()
  2002.     If Cmb_MName.ListCount = 0 Then
  2003.         Cmb_MName_DropDown
  2004.     End If
  2005. End Sub
  2007. Private Sub Cmb_MName_LostFocus()
  2008.     If Cmb_SiteName.ListCount = 0 Then
  2009.         Cmb_SiteName_DropDown
  2010.     End If
  2011. End Sub
  2012. '>>]=====================填充结束==========================================
  2014. Private Sub Cmb_MName_Click()
  2015.     If Cmb_MNumber.ListIndex <> Cmb_MName.ListIndex Then
  2016.         WglrGrid.Clear 1
  2017.         
  2018.         Cmb_MNumber.Text = Cmb_MNumber.List(Cmb_MName.ListIndex)
  2019.         Cmb_SiteName_DropDown
  2020.     End If
  2021. End Sub
  2023. Private Sub Cmb_MName_DropDown()
  2024.     Cmb_MName.Clear
  2025.     Cmb_MNumber.Clear
  2026.     Dim Rs_MName As ADODB.Recordset
  2027.     Dim Str_MName As String
  2028.     Str_MName = "SELECT DISTINCT QC_SamplingSite.Mnumber,qc_midmaterial.mname FROM QC_SamplingSite LEFT JOIN qc_midmaterial ON QC_SamplingSite.Mnumber=qc_midmaterial.Mnumber WHERE QC_SamplingSite.linecode='" & Trim(Cmb_LineCode.Text & "") & "'"
  2029.     Set Rs_MName = Cw_DataEnvi.DataConnect.Execute(Str_MName)
  2030.     If Rs_MName.RecordCount < 1 Then
  2031.         Rs_MName.Close
  2032.         Exit Sub
  2033.     End If
  2034.     
  2035.     Do While Not Rs_MName.EOF
  2036.         Cmb_MName.AddItem Trim(Rs_MName!MName & "")
  2037.         Cmb_MNumber.AddItem Trim(Rs_MName!MNumber & "")
  2038.         Rs_MName.MoveNext
  2039.     Loop
  2040.     
  2041.     Rs_MName.Close
  2042.     Set Rs_MName = Nothing
  2043. End Sub
  2045. Private Sub Cmb_SiteName_Click()
  2046.     If Cmb_SiteName.ListIndex <> -1 And Trim(Lab_OperStatus) = "2" Then
  2047.        WglrGrid.Clear 1
  2048.         
  2049.        Cmb_SiteCode.Text = Cmb_SiteCode.List(Cmb_SiteName.ListIndex)
  2050.        str_TempSql = "select * from qc_midstandmain where mnumber='" & Trim(Cmb_MNumber.Text & "") & "' and linecode='" & _
  2051.        Trim(Cmb_LineCode.Text & "") & "' and sitecode='" & Trim(Cmb_SiteCode.Text & "") & "'"
  2052.        Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(str_TempSql)
  2053.     
  2054.         If rs_Temp.EOF Then
  2055.            Exit Sub
  2056.         Else
  2057.            Tsxx = "此取样点的检验标准已经建立!"
  2058.            Call Xtxxts(Tsxx, 0, 3)
  2059.            Cmb_SiteName.ListIndex = -1
  2060.            Cmb_SiteName.SetFocus
  2061.         End If
  2063.     End If
  2064. End Sub
  2066. Private Sub Cmb_SiteName_DropDown()
  2067.     Cmb_SiteName.Clear
  2068.     Cmb_SiteCode.Clear
  2069.     Dim Rec_Site As ADODB.Recordset
  2070.     Set Rec_Site = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM QC_SamplingSite WHERE mnumber='" & Trim(Cmb_MNumber.Text & "") & "'")
  2071.     If Rec_Site.RecordCount < 1 Then
  2072.         Rec_Site.Close
  2073.         Exit Sub
  2074.     End If
  2075.     
  2076.     Do While Not Rec_Site.EOF
  2077.         Cmb_SiteName.AddItem Trim(Rec_Site!SiteName & "")
  2078.         Cmb_SiteCode.AddItem Trim(Rec_Site!SiteCode & "")
  2079.         Rec_Site.MoveNext
  2080.     Loop
  2081.     
  2082.     Rec_Site.Close
  2083.     Set Rec_Site = Nothing
  2084. End Sub
  2085. '*****************以上为下拉框设置********************
  2086.     
  2088. '[>>===================以上为根据实际业务需要自定义过程区域=============================<<]
  2090. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
  2091. Private Sub Sub_AdjustGrid()
  2092.     
  2093.     '调 整 网 格
  2094.     With WglrGrid
  2095.         '加 1 保持一行录入行
  2096.         If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  2097.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  2098.             For Jsqte = .FixedRows To .Rows - 1
  2099.                 .RowHeight(Jsqte) = Sjhgd
  2100.             Next Jsqte
  2101.         End If
  2102.         
  2103.         '判断是否有辅助行和录入行,如没有则加行
  2104.         Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  2105.             .AddItem ""
  2106.             .RowHeight(.Rows - 1) = Sjhgd
  2107.         Loop
  2108.     
  2109.     End With
  2110.     
  2111. End Sub
  2113. Private Sub Lrzdbz()                                                      '录入字段帮助
  2114.     
  2115.     If Not Ydcommand.Visible Then
  2116.         Exit Sub
  2117.     End If
  2118.     
  2119.     With WglrGrid
  2120.         Valilock = True
  2121.         
  2122.         '处理通用部分
  2123.         Changelock = True        '调入另外窗体必须加锁
  2124.         Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
  2125.         Changelock = False
  2126.         
  2127.         If Len(Xtfhcs) <> 0 Then
  2128.             If GridInt(.Col, 7) = 0 Then
  2129.                 Ydtext.Text = Xtfhcs
  2130.             Else
  2131.                 Ydtext.Text = Xtfhcsfz
  2132.             End If
  2133.         End If
  2134.         
  2135.         Valilock = False
  2136.         If Ydtext.Visible Then
  2137.             Ydtext.SetFocus
  2138.         End If
  2139.     End With
  2140.     
  2141. End Sub
  2143. Private Sub Cshhjwg()                                                     '初始化合计网格(*对合计网格来说,录入网格为容器)
  2144.     
  2145.     With HjGrid
  2146.         
  2147.         '是否显示合计网格
  2148.         If Not Sfxshjwg Then
  2149.             .Visible = False
  2150.             Exit Sub
  2151.         Else
  2152.             .Visible = True
  2153.         End If
  2154.         
  2155.         '设置网格相关属性
  2156.         .Enabled = False
  2157.         .Appearance = flexFlat
  2158.         .BorderStyle = flexBorderNone
  2159.         .ScrollBars = flexScrollBarNone
  2160.         .Width = WglrGrid.Width
  2161.         .FixedRows = 0
  2162.         .Rows = 1
  2163.         .Cols = WglrGrid.Cols
  2164.         .LeftCol = WglrGrid.LeftCol
  2165.         .TextMatrix(0, Qslz) = "合  计"
  2166.         For Jsqte = 0 To WglrGrid.Cols - 1
  2167.             .ColHidden(Jsqte) = WglrGrid.ColHidden(Jsqte)
  2168.             .ColWidth(Jsqte) = WglrGrid.ColWidth(Jsqte)
  2169.             .ColAlignment(Jsqte) = WglrGrid.ColAlignment(Jsqte)
  2170.             .ColFormat(Jsqte) = WglrGrid.ColFormat(Jsqte)
  2171.         Next Jsqte
  2172.         .ColAlignment(Qslz) = flexAlignCenterTop
  2173.         For Jsqte = .FixedRows To .Rows - 1
  2174.             .RowHeight(Jsqte) = .Height / .Rows
  2175.         Next Jsqte
  2176.         
  2177.         '程序自动调整网格高度(自动设置为网格剩余高度+辅助项网格行数(默认为1)*数据行高度)、并设置其位置信息
  2178.         .Height = Fzxwghs * Sjhgd + ((WglrGrid.Height - WglrGrid.FixedRows * WglrGrid.RowHeight(0)) Mod Sjhgd)
  2179.         .RowHeight(0) = .Height
  2180.         .Move 0, WglrGrid.Height - .Height, WglrGrid.Width, .Height
  2181.     End With
  2182.     
  2183. End Sub
  2185. Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
  2186.     Call Cxxswbk
  2187. End Sub
  2189. Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  2190.     Fun_Drfrmyxxpd = True
  2191.     With WglrGrid
  2192.         
  2193.         '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  2194.         If Ydtext.Visible Or YdCombo.Visible Then
  2195.             Call Lrsjhx
  2196.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  2197.                 Fun_Drfrmyxxpd = False
  2198.                 Exit Function
  2199.             End If
  2200.         End If
  2201.         
  2202.         '进行行有效性判断
  2203.         If Not Sjhzyxxpd(.Row) Then
  2204.             Fun_Drfrmyxxpd = False
  2205.             Exit Function
  2206.         End If
  2207.         
  2208.     End With
  2209.     
  2210. End Function
  2212. Private Sub WglrGrid_AfterUserResize(ByVal Row As Long, ByVal Col As Long)       '调整列宽
  2213.     
  2214.     If HjGrid.Visible Then
  2215.         With HjGrid
  2216.             .ColWidth(Col) = WglrGrid.ColWidth(Col)
  2217.         End With
  2218.     End If
  2219.     
  2220. End Sub
  2222. Private Sub WglrGrid_EnterCell()                                                 '显示当前数据行相关信息
  2223.     
  2224.     With WglrGrid
  2225.         If .Row >= .FixedRows Then
  2226.             '[>>
  2227.             '此处可以填写显示与此网格行相关信息
  2228.             '<<]
  2229.         End If
  2230.     End With
  2231.     
  2232. End Sub
  2234. Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  2235.     
  2236.     '网格得到焦点,如果当前选择行为非数据行
  2237.     '则调整当前焦点至有效数据行
  2238.     
  2239.     With WglrGrid
  2240.         If .Row < .FixedRows And .Rows > .FixedRows Then
  2241.             Changelock = True
  2242.             .Select .FixedRows, .Col
  2243.             Changelock = False
  2244.         End If
  2245.         If .Col < Qslz Then
  2246.             Changelock = True
  2247.             .Select .Row, Qslz
  2248.             Changelock = False
  2249.         End If
  2250.     End With
  2251.     
  2252. End Sub
  2254. Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  2255.     
  2256.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  2257.     If Changelock Then
  2258.         Exit Sub
  2259.     End If
  2260.     
  2261.     '引发网格RowcolChange事件
  2262.     With WglrGrid
  2263.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  2264.             .Select 0, 0
  2265.         End If
  2266.     End With
  2267.     
  2268. End Sub
  2270. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
  2271.     
  2272.     If Gdtlock Then
  2273.         Exit Sub
  2274.     End If
  2275.     
  2276.     With WglrGrid
  2277.         If Ydtext.Visible Or YdCombo.Visible Then
  2278.             Gdtlock = True
  2279.             .TopRow = Dqtoprow
  2280.             .LeftCol = Dqleftcol
  2281.             Gdtlock = False
  2282.             Exit Sub
  2283.         End If
  2284.         HjGrid.LeftCol = .LeftCol
  2285.     End With
  2286.     
  2287. End Sub
  2289. Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  2290.     
  2291.     If Changelock Then
  2292.         Exit Sub
  2293.     End If
  2294.     
  2295.     '记录刚刚离开网格单元的行列值
  2296.     Dqlkwgh = WglrGrid.Row
  2297.     Dqlkwgl = WglrGrid.Col
  2298.     
  2299.     '判断是否需要录入数据回写
  2300.     If Not (Ydtext.Visible Or YdCombo.Visible) Then
  2301.         Exit Sub
  2302.     End If
  2303.     Call Lrsjhx
  2304.     
  2305. End Sub
  2307. Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
  2308.     Valilock = True       '屏蔽文本框失去焦点进行有效性判断
  2309.     With WglrGrid
  2310.         If Changelock Then
  2311.             Exit Sub
  2312.         End If
  2313.         If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  2314.             Exit Sub
  2315.         End If
  2316.         If .Row <> Dqlkwgh Then
  2317.             If Not Sjhzyxxpd(Dqlkwgh) Then
  2318.                 Exit Sub
  2319.             End If
  2320.         End If
  2321.     End With
  2322.     
  2323.     Call fhyxh
  2324.     Call Xldql
  2325.     
  2326. End Sub
  2328. Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
  2329.     
  2330.     With WglrGrid
  2331.         Call xswbk
  2332.     End With
  2333.     
  2334. End Sub
  2336. Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
  2337.     
  2338.     Valilock = True
  2339.     Ydtext.Visible = False
  2340.     YdCombo.Visible = False
  2341.     Ydcommand.Visible = False
  2342.     
  2343. End Sub
  2345. Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  2346.     With WglrGrid
  2347.         Select Case KeyCode
  2348.         Case vbKeyEscape                'ESC 键放弃录入
  2349.             Valilock = True
  2350.             .SetFocus
  2351.             Call Ycwbk
  2352.             Valilock = False
  2353.         Case vbKeyReturn                '回 车 键 =13
  2354.             KeyCode = 0
  2355.             .SetFocus
  2356.             Call Lrsjhx
  2357.             Rowjsq = .Row
  2358.             Coljsq = .Col + 1
  2359.             If Coljsq > .Cols - 1 Then
  2360.                 If Rowjsq < .Rows - 1 Then
  2361.                     Rowjsq = Rowjsq + 1
  2362.                 End If
  2363.                 Coljsq = Qslz
  2364.             End If
  2365.             Do While Rowjsq <= .Rows - 1
  2366.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2367.                     Coljsq = Coljsq + 1
  2368.                     If Coljsq > .Cols - 1 Then
  2369.                         Rowjsq = Rowjsq + 1
  2370.                         Coljsq = Qslz
  2371.                     End If
  2372.                 Else
  2373.                     Exit Do
  2374.                 End If
  2375.             Loop
  2376.             .Select Rowjsq, Coljsq
  2377.         Case vbKeyLeft                  '左 箭 头 =37
  2378.             If .Col - 1 = Qslz Then
  2379.                 If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  2380.                     GoTo jzzx
  2381.                 End If
  2382.             End If
  2383.             If .Col > Qslz Then
  2384.                 KeyCode = 0
  2385.                 .SetFocus
  2386.                 Call Lrsjhx
  2387.                 Coljsq = .Col - 1
  2388.                 Do While Coljsq > Qslz
  2389.                     If Coljsq - 1 = Qslz Then
  2390.                         If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  2391.                             GoTo jzzx
  2392.                         End If
  2393.                     End If
  2394.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2395.                         Coljsq = Coljsq - 1
  2396.                     Else
  2397.                         Exit Do
  2398.                     End If
  2399.                 Loop
  2400.                 .Select .Row, Coljsq
  2401.             End If
  2402.         Case vbKeyRight                 '右 箭 头 =39
  2403.             KeyCode = 0
  2404.             .SetFocus
  2405.             Call Lrsjhx
  2406.             Rowjsq = .Row
  2407.             Coljsq = .Col + 1
  2408.             If Coljsq > .Cols - 1 Then
  2409.                 If Rowjsq < .Rows - 1 Then
  2410.                     Rowjsq = Rowjsq + 1
  2411.                 End If
  2412.                 Coljsq = Qslz
  2413.             End If
  2414.             Do While Rowjsq <= .Rows - 1
  2415.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2416.                     Coljsq = Coljsq + 1
  2417.                     If Coljsq > .Cols - 1 Then
  2418.                         Rowjsq = Rowjsq + 1
  2419.                         Coljsq = Qslz
  2420.                     End If
  2421.                 Else
  2422.                     Exit Do
  2423.                 End If
  2424.             Loop
  2425.             .Select Rowjsq, Coljsq
  2426.         Case Else
  2427.         End Select
  2428.         
  2429. jzzx:
  2430.         
  2431.     End With
  2432.     
  2433. End Sub
  2435. Private Sub YdCombo_LostFocus()
  2436.     
  2437.     With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
  2438.         If Not Valilock Then                           '为TRUE
  2439.             Call Lrsjhx
  2440.             If Not Sjhzyxxpd(Dqlrwgh) Then
  2441.                 Exit Sub
  2442.             End If
  2443.         End If
  2444.     End With
  2445.     
  2446. End Sub
  2448. Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  2449.     Call Lrzdbz
  2450. End Sub
  2452. Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
  2453.     Dim Rowjsq As Long, Coljsq As Long
  2454.     With WglrGrid
  2455.         Select Case KeyCode
  2456.         Case vbKeyF2
  2457.             Call Lrzdbz
  2458.         Case vbKeyEscape                'ESC 键放弃录入
  2459.             Valilock = True
  2460.             Call Ycwbk
  2461.             .SetFocus
  2462.         Case vbKeyReturn                '回 车 键 =13
  2463.             KeyCode = 0
  2464.             .SetFocus
  2465.             Call Lrsjhx
  2466.             Rowjsq = .Row
  2467.             Coljsq = .Col + 1
  2468.             If Coljsq > .Cols - 1 Then
  2469.                 If Rowjsq < .Rows - 1 Then
  2470.                     Rowjsq = Rowjsq + 1
  2471.                 End If
  2472.                 Coljsq = Qslz
  2473.             End If
  2474.             Do While Rowjsq <= .Rows - 1
  2475.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2476.                     Coljsq = Coljsq + 1
  2477.                     If Coljsq > .Cols - 1 Then
  2478.                         Rowjsq = Rowjsq + 1
  2479.                         Coljsq = Qslz
  2480.                     End If
  2481.                 Else
  2482.                     Exit Do
  2483.                 End If
  2484.             Loop
  2485.             If Rowjsq <= .Rows - 1 Then
  2486.                 .Select Rowjsq, Coljsq
  2487.             End If
  2488.         Case vbKeyUp                    '上 箭 头 =38
  2489.             KeyCode = 0
  2490.             .SetFocus
  2491.             Call Lrsjhx
  2492.             If .Row > .FixedRows Then
  2493.                 .Row = .Row - 1
  2494.             End If
  2495.         Case vbKeyDown                  '下 箭 头 =40
  2496.             KeyCode = 0
  2497.             .SetFocus
  2498.             Call Lrsjhx
  2499.             If .Row < .Rows - 1 Then
  2500.                 .Row = .Row + 1
  2501.             End If
  2502.         Case vbKeyLeft                  '左 箭 头 =37
  2503.             If .Col - 1 = Qslz Then
  2504.                 If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  2505.                     GoTo jzzx
  2506.                 End If
  2507.             End If
  2508.             If Ydtext.SelStart = 0 And .Col > Qslz Then
  2509.                 KeyCode = 0
  2510.                 .SetFocus
  2511.                 Call Lrsjhx
  2512.                 Coljsq = .Col - 1
  2513.                 Do While Coljsq > Qslz
  2514.                     If Coljsq - 1 = Qslz Then
  2515.                         If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  2516.                             GoTo jzzx
  2517.                         End If
  2518.                     End If
  2519.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2520.                         Coljsq = Coljsq - 1
  2521.                     Else
  2522.                         Exit Do
  2523.                     End If
  2524.                 Loop
  2525.                 .Select .Row, Coljsq
  2526.             End If
  2527. jzzx:
  2528.         Case vbKeyRight                 '右 箭 头 =39
  2529.             wblong = Len(Ydtext.Text)
  2530.             If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
  2531.                 KeyCode = 0
  2532.                 .SetFocus
  2533.                 Call Lrsjhx
  2534.                 Rowjsq = .Row
  2535.                 Coljsq = .Col + 1
  2536.                 If Coljsq > .Cols - 1 Then
  2537.                     If Rowjsq < .Rows - 1 Then
  2538.                         Rowjsq = Rowjsq + 1
  2539.                     End If
  2540.                     Coljsq = Qslz
  2541.                 End If
  2542.                 Do While Rowjsq <= .Rows - 1
  2543.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2544.                         Coljsq = Coljsq + 1
  2545.                         If Coljsq > .Cols - 1 Then
  2546.                             Rowjsq = Rowjsq + 1
  2547.                             Coljsq = Qslz
  2548.                         End If
  2549.                     Else
  2550.                         Exit Do
  2551.                     End If
  2552.                 Loop
  2553.                 .Select Rowjsq, Coljsq
  2554.             End If
  2555.         Case Else
  2556.         End Select
  2557.     End With
  2558.     
  2559. End Sub
  2561. Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  2562.     
  2563.     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  2564.     If KeyAscii <> 0 Then
  2565.         Call Xyxhbz(Dqlrwgh)
  2566.     End If
  2567.     
  2568. End Sub
  2570. Private Sub ydtext_Change()                              '录入事中变化处理
  2571.     
  2572.     '防止程序改变但不进行处理
  2573.     
  2574.     If Wbkbhlock Then
  2575.         Exit Sub
  2576.     End If
  2577.     
  2578.     With WglrGrid
  2579.         '限制字段录入长度
  2580.         Wbkbhlock = True
  2581.         
  2582.         Call TextChangeLimit(Ydtext, GridInt(.Col, 1))  '去掉无效字符
  2583.         
  2584.         Select Case GridInt(.Col, 1)
  2585.         Case 8, 11   '金额型
  2586.             Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  2587.         Case 9, 12   '数量型
  2588.             Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  2589.         Case 10      '单价型
  2590.             Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  2591.         Case Else    '其他类型
  2592.             If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  2593.                 Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  2594.             End If
  2595.         End Select
  2596.         Wbkbhlock = False
  2597.     End With
  2598.     
  2599. End Sub
  2601. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  2602.     
  2603.     With WglrGrid
  2604.         If Not Valilock Then
  2605.             Call Lrsjhx
  2606.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  2607.                 Exit Sub
  2608.             End If
  2609.             If Not Sjhzyxxpd(Dqlrwgh) Then
  2610.                 Exit Sub
  2611.             End If
  2612.         End If
  2613.     End With
  2614.     
  2615. End Sub
  2617. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  2618.     
  2619.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  2620.     
  2621.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  2622.     If Not Fun_AllowInput Then
  2623.         Exit Sub
  2624.     End If
  2625.     
  2626.     '显示文本框前返回有效行列（解决滚动条问题）
  2627.     Call Xldqh
  2628.     Call Xldql
  2629.     
  2630.     '隐藏文本框,帮助按钮,列表组合框
  2631.     Call Ycwbk
  2632.     
  2633.     With WglrGrid
  2634.         Dqlrwgh = .Row
  2635.         Dqlrwgl = .Col
  2636.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  2637.             Exit Sub
  2638.         End If
  2639.         
  2640.         Wbkpy = 30
  2641.         Wbkpy1 = 15
  2642.         
  2643.         On Error Resume Next
  2644.         
  2645.         If GridBoolean(.Col, 3) Then
  2646.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  2647.             YdCombo.Top = .CellTop + .Top + Wbkpy
  2648.             YdCombo.Width = .CellWidth - Wbkpy1
  2649.             Call Wbkcl
  2650.             YdCombo.Visible = True
  2651.             YdCombo.SetFocus
  2652.             Ydcommand.Visible = False
  2653.             Ydtext.Visible = False
  2654.         Else
  2655.             If GridBoolean(.Col, 2) Then
  2656.                 Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  2657.                 Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  2658.                 Ydcommand.Visible = True
  2659.             Else
  2660.                 Ydcommand.Visible = False
  2661.             End If
  2662.             
  2663.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  2664.             Ydtext.Top = .CellTop + .Top + Wbkpy
  2665.             If Ydcommand.Visible Then
  2666.                 If Sfblbzkd Then
  2667.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  2668.                 Else
  2669.                     Ydtext.Width = .CellWidth - Wbkpy1
  2670.                 End If
  2671.             Else
  2672.                 Ydtext.Width = .CellWidth - Wbkpy1
  2673.             End If
  2674.             Ydtext.Height = .CellHeight - Wbkpy1
  2675.             
  2676.             If GridInt(.Col, 2) <> 0 Then
  2677.                 Ydtext.MaxLength = GridInt(.Col, 2)
  2678.             Else
  2679.                 Ydtext.MaxLength = 3000
  2680.             End If
  2681.             
  2682.             Call Wbkcl
  2683.             
  2684.             Ydtext.Visible = True
  2685.             Ydtext.SetFocus
  2686.         End If
  2687.         Dqtoprow = .TopRow
  2688.         Dqleftcol = .LeftCol
  2689.         
  2690.         '重置锁值
  2691.         Valilock = False
  2692.         Wbkbhlock = False
  2693.     End With
  2694.     
  2695. End Sub
  2697. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  2698.     
  2699.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  2700.     If Trim(Lab_OperStatus.Caption) = "1" Then
  2701.         Exit Function
  2702.     End If
  2703.     
  2704.     '[>>
  2705.     
  2706.     '此处可以填写禁止文本框激活使单据处于录入状态的理由
  2707.     
  2708.     '<<]
  2709.     
  2710.     Fun_AllowInput = True
  2711.     
  2712. End Function
  2714. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  2715.     
  2716.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  2717.     Wbkpy = 30
  2718.     Wbkpy1 = 15
  2719.     With WglrGrid
  2720.         If YdCombo.Visible Then
  2721.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  2722.             YdCombo.Top = .CellTop + .Top + Wbkpy
  2723.             YdCombo.Width = .CellWidth - Wbkpy1
  2724.         End If
  2725.         If Ydcommand.Visible Then
  2726.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  2727.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  2728.         End If
  2729.         If Ydtext.Visible Then
  2730.             If Ydcommand.Visible Then
  2731.                 If Sfblbzkd Then
  2732.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  2733.                 Else
  2734.                     Ydtext.Width = .CellWidth - Wbkpy1
  2735.                 End If
  2736.             Else
  2737.                 Ydtext.Width = .CellWidth - Wbkpy1
  2738.             End If
  2739.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  2740.             Ydtext.Top = .CellTop + .Top + Wbkpy
  2741.             Ydtext.Height = .CellHeight - Wbkpy1
  2742.         End If
  2743.     End With
  2744.     
  2745. End Sub
  2747. Private Sub Lrsjhx()                                                   '文本框录入数据回写
  2748.     
  2749.     With WglrGrid
  2750.         If YdCombo.Visible Then
  2751.             .Text = Trim(YdCombo.Text)
  2752.         End If
  2753.         If Ydtext.Visible Then
  2754.             .Text = Trim(Ydtext.Text)
  2755.         End If
  2756.         
  2757.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  2758.         If Zdlrqnr <> Trim(.Text) Then
  2759.             Yxxpdlock = False
  2760.             Hyxxpdlock = False
  2761.         End If
  2762.         
  2763.         '如果字段录入内容不为空则写数据行有效性标志
  2764.         If Len(Trim(.Text)) <> 0 Then
  2765.             Call Xyxhbz(.Row)
  2766.         End If
  2767.         
  2768.         '隐藏文本框,帮助按钮,列表组合框
  2769.         Call Ycwbk
  2770.     End With
  2771.     
  2772. End Sub
  2774. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行，删行快捷键
  2775.     
  2776.     '如果单据操作状态为浏览状态则不能显示录入载体
  2777.     If Trim(Lab_OperStatus.Caption) = "1" Then
  2778.         Exit Sub
  2779.     End If
  2780.     
  2781.     Select Case KeyCode
  2782.     Case vbKeyF2                   '按F2键参照
  2783.         Call xswbk
  2784.         Call Lrzdbz
  2785.     Case vbKeyDelete               '删行
  2786.         Call Scdqfl
  2787.     Case vbKeyInsert               '增行
  2788.         Call zjlrfl
  2789.     End Select
  2790.     
  2791. End Sub
  2793. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
  2794.     
  2795.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  2796.     If Not Fun_AllowInput Then
  2797.         Exit Sub
  2798.     End If
  2799.     
  2800.     With WglrGrid
  2801.         '屏 蔽 回 车 键
  2802.         If KeyAscii = vbKeyReturn Then
  2803.             KeyAscii = 0
  2804.             Rowjsq = .Row
  2805.             Coljsq = .Col + 1
  2806.             If Coljsq > .Cols - 1 Then
  2807.                 If Rowjsq < .Rows - 1 Then
  2808.                     Rowjsq = Rowjsq + 1
  2809.                 End If
  2810.                 Coljsq = Qslz
  2811.             End If
  2812.             Do While Rowjsq <= .Rows - 1
  2813.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2814.                     Coljsq = Coljsq + 1
  2815.                     If Coljsq > .Cols - 1 Then
  2816.                         Rowjsq = Rowjsq + 1
  2817.                         Coljsq = Qslz
  2818.                     End If
  2819.                 Else
  2820.                     Exit Do
  2821.                 End If
  2822.             Loop
  2823.             If Rowjsq <= .Rows - 1 Then
  2824.                 .Select Rowjsq, Coljsq
  2825.             End If
  2826.             Exit Sub
  2827.         End If
  2828.         
  2829.         '接受用户录入
  2830.         Select Case KeyAscii
  2831.         Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
  2832.             '显示录入载体
  2833.             Call xswbk
  2834.         Case Else
  2835.             '防止非编辑字段SendKeys()出现死循环
  2836.             If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  2837.                 Exit Sub
  2838.             End If
  2839.             '如果此字段为列表框录入则调入相应列表框
  2840.             If GridBoolean(.Col, 3) Then
  2841.                 '列表框录入
  2842.                 Call xswbk
  2843.             Else
  2844.                 Ydtext.Text = ""
  2845.                 '录入限制
  2846.                 Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  2847.                 If KeyAscii = 0 Then
  2848.                     Exit Sub
  2849.                 End If
  2850.                 '如果录入字符有效则写有效行数据标志
  2851.                 Call Xyxhbz(.Row)
  2852.                 Call xswbk
  2853.                 Ydtext.Text = ""
  2854.                 Valilock = True
  2855.                 SendKeys Chr(KeyAscii), True
  2856.                 DoEvents
  2857.                 Valilock = False
  2858.             End If
  2859.         End Select
  2860.     End With
  2861.     
  2862. End Sub
  2864. Private Sub zjlrfl()                                                    '增加录入分录
  2865.     
  2866.     With WglrGrid
  2867.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  2868.             If Not Fun_Drfrmyxxpd Then
  2869.                 Exit Sub
  2870.             End If
  2871.         Else
  2872.             Exit Sub
  2873.         End If
  2874.         If .Row < .FixedRows Then
  2875.             Exit Sub
  2876.         End If
  2877.         .AddItem "", .Row
  2878.         .RowHeight(.Row) = Sjhgd
  2879.         If .Row <> .Rows - 1 Then
  2880.             If .TextMatrix(.Row + 1, 0) = "*" Then
  2881.                 .TextMatrix(.Row, 0) = "*"
  2882.             Else
  2883.                 .RemoveItem .Rows - 1
  2884.             End If
  2885.         End If
  2886.         Call Xldqh
  2887.         Call Xldql
  2888.         Hyxxpdlock = False
  2889.     End With
  2890.     
  2891. End Sub
  2893. Private Sub Scdqfl()                                                    '删除当前分录
  2894.     Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean
  2895.     With WglrGrid
  2896.         Scqwghz = .Row
  2897.         Scqwglz = .Col
  2898.         If .TextMatrix(.Row, 0) = "*" Then
  2899.             '判断是否为录入状态
  2900.             If Ydtext.Visible Or YdCombo.Visible Then
  2901.                 Sflrzt = True
  2902.                 Validate = True
  2903.                 Call Lrsjhx
  2904.                 Validate = False
  2905.             End If
  2906.             Call Xldqh
  2907.             Changelock = True
  2908.             .Select .Row, 0
  2909.             Changelock = False
  2910.             If Shsfts Then
  2911.                 .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
  2912.                 Tsxx = "请确认是否删除当前记录?"
  2913.                 yhAnswer = Xtxxts(Tsxx, 2, 2)
  2914.                 If yhAnswer = 2 Then
  2915.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  2916.                     Changelock = True
  2917.                     .Select Scqwghz, Scqwglz
  2918.                     Changelock = False
  2919.                     
  2920.                     '如为录入状态,则恢复录入
  2921.                     If Sflrzt Then
  2922.                         Call xswbk
  2923.                     End If
  2924.                     Exit Sub
  2925.                 End If
  2926.             End If
  2927.             .RemoveItem .Row
  2928.             If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  2929.                 .AddItem ""
  2930.                 .RowHeight(.Rows - 1) = Sjhgd
  2931.             End If
  2932.             Changelock = True
  2933.             .Select .Row, Scqwglz
  2934.             Changelock = False
  2935.             
  2936.         End If
  2937.     End With
  2938.     
  2939. End Sub
  2941. Private Sub Sjhj(Hjwgl As Long)                                         '网格列数据合计
  2942.     
  2943.     Dim Hjjg As Double
  2944.     If Not GridBoolean(Hjwgl, 4) Then
  2945.         Exit Sub
  2946.     End If
  2947.     With WglrGrid
  2948.         Hjjg = 0
  2949.         For Jsqte = .FixedRows To .Rows - 1
  2950.             If .TextMatrix(Jsqte, 0) = "*" Then
  2951.                 Hjjg = Hjjg + Val(.TextMatrix(Jsqte, Hjwgl))
  2952.             End If
  2953.         Next Jsqte
  2954.         If GridBoolean(Hjwgl, 5) And Hjjg = 0 Then
  2955.             HjGrid.TextMatrix(0, Hjwgl) = ""
  2956.         Else
  2957.             HjGrid.TextMatrix(0, Hjwgl) = Hjjg
  2958.         End If
  2959.     End With
  2960.     
  2961. End Sub
  2963. Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  2964.     
  2965.     If Not GridBoolean(Sjl, 5) Then
  2966.         Exit Sub
  2967.     End If
  2968.     With WglrGrid
  2969.         If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
  2970.             .TextMatrix(sjh, Sjl) = ""
  2971.         End If
  2972.     End With
  2973.     
  2974. End Sub
  2976. Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  2977.     
  2978.     With WglrGrid
  2979.         If .Row >= .FixedRows Then
  2980.             If .TextMatrix(.Row, 0) <> "*" Then
  2981.                 For Rowjsq = .FixedRows To .Rows - 1
  2982.                     If .TextMatrix(Rowjsq, 0) <> "*" Then
  2983.                         Exit For
  2984.                     End If
  2985.                 Next Rowjsq
  2986.                 If Rowjsq <= .Rows - 1 Then
  2987.                     Changelock = True
  2988.                     .Select Rowjsq, .Col
  2989.                     Changelock = False
  2990.                 Else
  2991.                     Changelock = True
  2992.                     .Select .Rows - 1, .Col
  2993.                     Changelock = False
  2994.                 End If
  2995.             End If
  2996.             Call Xldqh
  2997.         End If
  2998.     End With
  2999.     
  3000. End Sub
  3002. Private Sub Xldqh()                                                      '显露当前行
  3003.     
  3004.     Dim Toprowte As Long
  3005.     With WglrGrid
  3006.         Toprowte = 0
  3007.         Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
  3008.             Toprowte = .TopRow
  3009.             .TopRow = .TopRow + 1
  3010.         Loop
  3011.         Toprowte = 0
  3012.         Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
  3013.             Toprowte = .TopRow
  3014.             If .TopRow > 1 Then
  3015.                 .TopRow = .TopRow - 1
  3016.             End If
  3017.         Loop
  3018.     End With
  3019.     
  3020. End Sub
  3022. Private Sub Xldql()                                                     '显露当前列
  3023.     
  3024.     Dim Leftcolte As Long
  3025.     With WglrGrid
  3026.         If .Col >= Qslz And .Col >= .FixedCols Then
  3027.             If .LeftCol > .Col Then
  3028.                 .LeftCol = .Col
  3029.             End If
  3030.             Leftcolte = 0
  3031.             Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
  3032.                 Leftcolte = .LeftCol
  3033.                 .LeftCol = .LeftCol + 1
  3034.             Loop
  3035.         End If
  3036.     End With
  3037.     
  3038. End Sub
  3040. Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
  3041.     
  3042.     With WglrGrid
  3043.         For Coljsq = Qslz To .Cols - 1
  3044.             If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
  3045.                 pdhwk = False
  3046.                 Exit Function
  3047.             End If
  3048.         Next Coljsq
  3049.         pdhwk = True
  3050.     End With
  3051.     
  3052. End Function
  3054. Private Sub Xyxhbz(sjh As Long)                                         '写行有效性标志,并判断是否增行
  3055.     
  3056.     With WglrGrid
  3057.         If .TextMatrix(sjh, 0) = "*" Then
  3058.             Exit Sub
  3059.         End If
  3060.         .TextMatrix(sjh, 0) = "*"
  3061.         If sjh >= .Rows - Fzxwghs - 1 Then
  3062.             .AddItem ""
  3063.             .RowHeight(.Rows - 1) = Sjhgd
  3064.         End If
  3065.     End With
  3066.     
  3067. End Sub
  3069. '*****************************以下为文本框录入处理程序(固定不变部分)*******************************'
  3071. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  3072.     
  3073.     '以下为依据实际情况自定义部分[
  3075.     '在此填写文本框录入事后处理程序
  3076.     ']以上为依据实际情况自定义部分
  3077.     
  3078. End Sub
  3080. Private Sub LrText_Change(Index As Integer)
  3081.     
  3082.     '屏蔽程序改变控制
  3083.     If TextChangeLock Then
  3084.         Exit Sub
  3085.     End If
  3086.     
  3087.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  3088.     
  3089.     '限制字段录入长度
  3090.     
  3091.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  3092.     
  3093.     Call TextChangeLimit(LrText(Index), Textint(Index, 1))  '去掉无效字符
  3094.     
  3095.     Select Case Textint(Index, 1)
  3096.     Case 8, 11       '金额型
  3097.         Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  3098.     Case 9, 12       '数量型
  3099.         Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  3100.     Case 10          '单价型
  3101.         Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  3102.     Case Else        '其他小数类型控制
  3103.         If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  3104.             Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  3105.         End If
  3106.     End Select
  3107.     
  3108.     TextChangeLock = False '解锁
  3109.     
  3110. End Sub
  3112. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  3113.     Call TextShow(Index)
  3114. End Sub
  3116. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  3117.     
  3118.     Select Case KeyCode
  3119.     Case vbKeyF2
  3120.         Call Text_Help(Index)
  3121.     End Select
  3122.     
  3123. End Sub
  3125. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  3126.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  3127. End Sub
  3129. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
  3130.     
  3131.     If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
  3132.         Call TextYxxpd(Index)
  3133.     End If
  3134.     
  3135. End Sub
  3137. Private Sub Ydcommand1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '点击按钮
  3138.   Me.bln_Help = True
  3139.     Call Text_Help(Ydcommand1.Tag)
  3140.   Me.bln_Help = False
  3141. End Sub
  3143. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  3144.     
  3145.     If Not Ydcommand1.Visible Then
  3146.         Exit Sub
  3147.     End If
  3148.     TextValiLock = True
  3149.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  3150.     If Len(Xtfhcs) <> 0 Then
  3151.         If Textint(Index, 3) = 1 Then
  3152.             LrText(Index).Text = Xtfhcsfz
  3153.             LrText(Index).Tag = Xtfhcs
  3154.         Else
  3155.             LrText(Index).Text = Xtfhcs
  3156.             LrText(Index).Tag = Xtfhcsfz
  3157.         End If
  3158.     End If
  3159.     TextValiLock = False
  3160.     LrText(Index).SetFocus
  3161.     
  3162. End Sub
  3164. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  3165.     
  3166.     '如果文本框有帮助,则显示帮助按钮
  3167.     If Textboolean(Index, 1) Then
  3168.         Ydcommand1.Visible = True
  3169.         Ydcommand1.Move LrText(Index).Left + LrText(Index).Width, LrText(Index).Top
  3170.         Ydcommand1.Tag = Index
  3171.     Else
  3172.         Ydcommand1.Tag = ""
  3173.         Ydcommand1.Visible = False
  3174.     End If
  3175.     
  3176.     '[>>
  3177.     '可在此处定义其他处理动作
  3178.     '<<]
  3179.     
  3180. End Sub
  3182. Private Sub Wbkcsh()                          '录入文本框初始化
  3183.     
  3184.     Dim Int_TabIndex As Integer         'Tab焦点计数器
  3185.     
  3186.     '单据录入中文本框焦点由0开始
  3187.     LrText(0).TabIndex = 0
  3188.     
  3189.     '最大录入文本框索引值
  3190.     Max_Text_Index = Textvar(1)
  3191.     
  3192.     ReDim TextValiJudgeLock(Max_Text_Index)
  3193.     For Jsqte = 0 To Max_Text_Index
  3194.         
  3195.         '判断此文本框录入索引号是否存在,如存在则对其进行初始化
  3196.         If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
  3197.             
  3198.             '自动装入录入文本框和其解释标签
  3199.             If Jsqte <> 0 Then
  3200.                 Load LrText(Jsqte)
  3201.                 Load TsLabel(Jsqte)
  3202.                 
  3203.                 '判断录入文本框是否显示
  3204.                 If Textboolean(Jsqte, 4) Then
  3205.                     LrText(Jsqte).Visible = True
  3206.                     TsLabel(Jsqte).Visible = True
  3207.                 Else
  3208.                    LrText(Jsqte).Visible = False
  3209.                    TsLabel(Jsqte).Visible = False
  3210.                End If
  3211.                 
  3212.                 '判断文本框是否可编辑
  3213.                 If Textboolean(Jsqte, 5) Then
  3214.                     LrText(Jsqte).Enabled = True
  3215.                 Else
  3216.                     LrText(Jsqte).Enabled = False
  3217.                 End If
  3218.             End If
  3219.             
  3220.             '初始化其内容
  3221.             TextChangeLock = True
  3222.             LrText(Jsqte).Text = ""
  3223.             LrText(Jsqte).Tag = ""
  3224.             If Textint(Jsqte, 5) <> 0 Then
  3225.                 LrText(Jsqte).MaxLength = Textint(Jsqte, 5)
  3226.             End If
  3227.             TextChangeLock = False
  3228.             
  3229.             '设置文本框位置及大小,并设置相应标签内容及其位置
  3230.             LrText(Jsqte).Move Textint(Jsqte, 13), Textint(Jsqte, 12), Textint(Jsqte, 11), Textint(Jsqte, 10)
  3231.             TsLabel(Jsqte).Caption = Textstr(Jsqte, 7) & ":"
  3232.             TsLabel(Jsqte).Move Textint(Jsqte, 13) - TsLabel(Jsqte).Width - 20, Textint(Jsqte, 12) + (Textint(Jsqte, 10) - TsLabel(Jsqte).Height) / 2 - 30
  3233.             
  3234.         End If
  3235.         
  3236.         '将文本框有效性判断进行加锁,在文本框内容发生变化时将锁打开
  3237.         TextValiJudgeLock(Jsqte) = True
  3238.         
  3239.     Next Jsqte
  3240.     
  3241.     '设置文本框焦点转移顺序(前提文本焦点从0至Max_Text_Index)
  3242.     For Int_TabIndex = 0 To Max_Text_Index
  3243.         For Jsqte = 0 To Max_Text_Index
  3244.             If Textint(Jsqte, 14) = Int_TabIndex Then
  3245.                 LrText(Jsqte).TabIndex = Int_TabIndex
  3246.             End If
  3247.         Next Jsqte
  3248.     Next Int_TabIndex
  3249.     
  3250. End Sub
  3252. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  3253.     
  3254.     Dim Sqlstr As String
  3255.     Dim Findrec As New ADODB.Recordset
  3256.     
  3257.     '按帮助不进行有效性判断
  3258.     
  3259.     If TextValiLock Then
  3260.         TextValiLock = False
  3261.         TextYxxpd = True
  3262.         Exit Function
  3263.     End If
  3264.     
  3265.     '文本框内容未曾改变不进行有效性判断
  3266.     
  3267.     If TextValiJudgeLock(Index) Then
  3268.         Ydcommand1.Visible = False
  3269.         TextYxxpd = True
  3270.         Exit Function
  3271.     End If
  3272.     
  3273.     '文本框内容为空认为有效,并清空其Tag值
  3274.     
  3275.     If Trim(LrText(Index)) = "" Then
  3276.         LrText(Index).Tag = ""
  3277.         Call Wbklrwbcl(Index)
  3278.         Ydcommand1.Visible = False
  3279.         TextValiJudgeLock(Index) = True
  3280.         TextYxxpd = True
  3281.         Exit Function
  3282.     End If
  3283.     
  3284.     '[>>
  3285.     
  3286.     '可在此加入不做有效性判断的理由(参照上面程序)
  3287.     
  3288.     '<<]
  3289.     
  3290.     Select Case Textint(Index, 4)
  3291.     Case 1      '编码型
  3292.         Sqlstr = Trim(Textstr(Index, 5))
  3293.         Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  3294.         Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  3295.         If Findrec.EOF Then
  3296.             Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  3297.             LrText(Index).SetFocus
  3298.             Exit Function
  3299.         Else
  3300.             Select Case Textint(Index, 3)
  3301.             Case 0
  3302.                 If Len(Trim(Textstr(Index, 2))) <> 0 Then
  3303.                     LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  3304.                 End If
  3305.                 If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  3306.                     LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  3307.                 End If
  3308.             Case 1
  3309.                 If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  3310.                     LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  3311.                 End If
  3312.                 If Len(Trim(Textstr(Index, 2))) <> 0 Then
  3313.                     LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  3314.                 End If
  3315.             End Select
  3316.         End If
  3317.     Case 2      '日期型
  3318.         If IsDate(LrText(Index).Text) Then
  3319.             LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  3320.             If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  3321.                 LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  3322.             End If
  3323.         Else
  3324.             Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  3325.             Call Xtxxts(Tsxx, 0, 1)
  3326.             LrText(Index).SetFocus
  3327.             Exit Function
  3328.         End If
  3329.     Case 3      '其他类型
  3330.     End Select
  3331.     
  3332.     '隐藏帮助按钮
  3333.     Ydcommand1.Visible = False
  3334.     
  3335.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  3336.     TextValiJudgeLock(Index) = True
  3337.     
  3338.     '调用文本框事后处理程序
  3339.     Call Wbklrwbcl(Index)
  3340.     
  3341.     '有效性判断通过则返回True
  3342.     TextYxxpd = True
  3343.     
  3344. End Function