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

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

企业管理

开发平台：

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