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

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

企业管理

开发平台：

Visual Basic

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