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

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

企业管理

开发平台：

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