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

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

企业管理

开发平台：

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 Stock_PurPlan 
  5.    BackColor       =   &H00E9F4FA&
  6.    BorderStyle     =   3  'Fixed Dialog
  7.    Caption         =   "采购计划"
  8.    ClientHeight    =   5745
  9.    ClientLeft      =   45
  10.    ClientTop       =   330
  11.    ClientWidth     =   10860
  12.    Icon            =   "采购计划_采购计划维护.frx":0000
  13.    KeyPreview      =   -1  'True
  14.    LinkTopic       =   "Form1"
  15.    MaxButton       =   0   'False
  16.    MinButton       =   0   'False
  17.    ScaleHeight     =   5745
  18.    ScaleWidth      =   10860
  19.    ShowInTaskbar   =   0   'False
  20.    StartUpPosition =   2  '屏幕中心
  21.    Begin VB.ComboBox YdCombo 
  22.       Height          =   300
  23.       Left            =   9000
  24.       Style           =   2  'Dropdown List
  25.       TabIndex        =   4
  26.       Top             =   960
  27.       Visible         =   0   'False
  28.       Width           =   1155
  29.    End
  30.    Begin VB.CommandButton Ydcommand1 
  31.       Height          =   300
  32.       Left            =   10680
  33.       Picture         =   "采购计划_采购计划维护.frx":1042
  34.       Style           =   1  'Graphical
  35.       TabIndex        =   3
  36.       TabStop         =   0   'False
  37.       Top             =   600
  38.       Visible         =   0   'False
  39.       Width           =   300
  40.    End
  41.    Begin VB.TextBox Ydtext 
  42.       BackColor       =   &H80000018&
  43.       BorderStyle     =   0  'None
  44.       Height          =   330
  45.       Left            =   7710
  46.       MultiLine       =   -1  'True
  47.       TabIndex        =   2
  48.       Top             =   960
  49.       Visible         =   0   'False
  50.       Width           =   1185
  51.    End
  52.    Begin VB.CommandButton Ydcommand 
  53.       Height          =   300
  54.       Left            =   10680
  55.       Picture         =   "采购计划_采购计划维护.frx":13CC
  56.       Style           =   1  'Graphical
  57.       TabIndex        =   1
  58.       TabStop         =   0   'False
  59.       Top             =   990
  60.       Visible         =   0   'False
  61.       Width           =   300
  62.    End
  63.    Begin VB.TextBox LrText 
  64.       ForeColor       =   &H00000000&
  65.       Height          =   300
  66.       Index           =   0
  67.       Left            =   1020
  68.       TabIndex        =   0
  69.       Text            =   "0"
  70.       Top             =   1140
  71.       Width           =   1650
  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           =   10860
  408.       _ExtentX        =   19156
  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      =   29
  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.             Enabled         =   0   'False
  461.             Object.Visible         =   0   'False
  462.             Caption         =   "增行"
  463.             Key             =   "zh"
  464.             Object.ToolTipText     =   "插入一行或Insert"
  465.             ImageKey        =   "zh"
  466.          EndProperty
  467.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  468.             Enabled         =   0   'False
  469.             Object.Visible         =   0   'False
  470.             Caption         =   "删行"
  471.             Key             =   "sh"
  472.             Object.ToolTipText     =   "删除当前记录行或Delete"
  473.             ImageKey        =   "sh"
  474.          EndProperty
  475.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  476.             Enabled         =   0   'False
  477.             Object.Visible         =   0   'False
  478.             Key             =   "fgh2"
  479.             Style           =   3
  480.          EndProperty
  481.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  482.             Caption         =   "保存"
  483.             Key             =   "bc"
  484.             Object.ToolTipText     =   "保存单据或F6"
  485.             ImageKey        =   "bc"
  486.          EndProperty
  487.          BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  488.             Caption         =   "放弃"
  489.             Key             =   "fq"
  490.             Object.ToolTipText     =   "放弃此次操作"
  491.             ImageKey        =   "fq"
  492.          EndProperty
  493.          BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  494.             Key             =   "fgh3"
  495.             Style           =   3
  496.          EndProperty
  497.          BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  498.             Enabled         =   0   'False
  499.             Object.Visible         =   0   'False
  500.             Caption         =   "审核"
  501.             Key             =   "shsh"
  502.             ImageKey        =   "check"
  503.          EndProperty
  504.          BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  505.             Enabled         =   0   'False
  506.             Object.Visible         =   0   'False
  507.             Caption         =   "弃审"
  508.             Key             =   "shqs"
  509.             ImageKey        =   "qs"
  510.          EndProperty
  511.          BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  512.             Enabled         =   0   'False
  513.             Object.Visible         =   0   'False
  514.             Caption         =   "完成"
  515.             Key             =   "Finish"
  516.             ImageKey        =   "xsxm"
  517.          EndProperty
  518.          BeginProperty Button17 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  519.             Enabled         =   0   'False
  520.             Object.Visible         =   0   'False
  521.             Caption         =   "弃完"
  522.             Key             =   "AbandonFinish"
  523.             ImageKey        =   "fq"
  524.          EndProperty
  525.          BeginProperty Button18 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  526.             Enabled         =   0   'False
  527.             Object.Visible         =   0   'False
  528.             Caption         =   "废弃"
  529.             Key             =   "Cancel"
  530.          EndProperty
  531.          BeginProperty Button19 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  532.             Enabled         =   0   'False
  533.             Object.Visible         =   0   'False
  534.             Caption         =   "恢复"
  535.             Key             =   "Resume"
  536.          EndProperty
  537.          BeginProperty Button20 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  538.             Enabled         =   0   'False
  539.             Object.Visible         =   0   'False
  540.             Key             =   "fgh4"
  541.             Style           =   3
  542.          EndProperty
  543.          BeginProperty Button21 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  544.             Caption         =   "首张"
  545.             Key             =   "first"
  546.             ImageKey        =   "first"
  547.          EndProperty
  548.          BeginProperty Button22 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  549.             Caption         =   "上张"
  550.             Key             =   "prev"
  551.             ImageKey        =   "prev"
  552.          EndProperty
  553.          BeginProperty Button23 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  554.             Caption         =   "下张"
  555.             Key             =   "next"
  556.             ImageKey        =   "next"
  557.          EndProperty
  558.          BeginProperty Button24 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  559.             Caption         =   "末张"
  560.             Key             =   "last"
  561.             ImageKey        =   "last"
  562.          EndProperty
  563.          BeginProperty Button25 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  564.             Key             =   "fgh5"
  565.             Style           =   3
  566.          EndProperty
  567.          BeginProperty Button26 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  568.             Caption         =   "明细"
  569.             Key             =   "mx"
  570.             ImageKey        =   "pz"
  571.          EndProperty
  572.          BeginProperty Button27 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  573.             Style           =   3
  574.          EndProperty
  575.          BeginProperty Button28 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  576.             Caption         =   "帮助"
  577.             Key             =   "bz"
  578.             ImageKey        =   "bz"
  579.          EndProperty
  580.          BeginProperty Button29 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  581.             Caption         =   "退出"
  582.             Key             =   "fh"
  583.             ImageKey        =   "tc"
  584.          EndProperty
  585.       EndProperty
  586.       BorderStyle     =   1
  587.    End
  588.    Begin VB.Label TsLabel 
  589.       Alignment       =   1  'Right Justify
  590.       AutoSize        =   -1  'True
  591.       BackStyle       =   0  'Transparent
  592.       Caption         =   "单据号："
  593.       Height          =   180
  594.       Index           =   0
  595.       Left            =   240
  596.       TabIndex        =   13
  597.       Top             =   1200
  598.       Width           =   765
  599.    End
  600.    Begin VB.Label Lab_Checker 
  601.       Appearance      =   0  'Flat
  602.       BackColor       =   &H80000005&
  603.       BackStyle       =   0  'Transparent
  604.       ForeColor       =   &H00000000&
  605.       Height          =   225
  606.       Left            =   7170
  607.       TabIndex        =   12
  608.       Top             =   6360
  609.       Width           =   735
  610.    End
  611.    Begin VB.Label Lab_Bill 
  612.       Appearance      =   0  'Flat
  613.       BackColor       =   &H80000005&
  614.       BackStyle       =   0  'Transparent
  615.       ForeColor       =   &H00000000&
  616.       Height          =   225
  617.       Left            =   9030
  618.       TabIndex        =   11
  619.       Top             =   6330
  620.       Width           =   735
  621.    End
  622.    Begin VB.Label Lab_OperStatus 
  623.       BackColor       =   &H000080FF&
  624.       Caption         =   "1"
  625.       Height          =   345
  626.       Left            =   10290
  627.       TabIndex        =   10
  628.       Top             =   960
  629.       Visible         =   0   'False
  630.       Width           =   345
  631.    End
  632.    Begin VB.Label Lab_Djclzt 
  633.       BackColor       =   &H0000FFFF&
  634.       Caption         =   "1"
  635.       ForeColor       =   &H00808080&
  636.       Height          =   255
  637.       Left            =   10320
  638.       TabIndex        =   9
  639.       Top             =   600
  640.       Visible         =   0   'False
  641.       Width           =   285
  642.    End
  643.    Begin VB.Label Lab_BillId 
  644.       AutoSize        =   -1  'True
  645.       BackColor       =   &H0080C0FF&
  646.       Height          =   270
  647.       Left            =   7680
  648.       TabIndex        =   8
  649.       Top             =   600
  650.       Visible         =   0   'False
  651.       Width           =   2490
  652.    End
  653.    Begin VB.Label Lab_Title 
  654.       AutoSize        =   -1  'True
  655.       BackColor       =   &H80000018&
  656.       BackStyle       =   0  'Transparent
  657.       Caption         =   "单据标题自动调整"
  658.       BeginProperty Font 
  659.          Name            =   "宋体"
  660.          Size            =   15
  661.          Charset         =   134
  662.          Weight          =   700
  663.          Underline       =   0   'False
  664.          Italic          =   0   'False
  665.          Strikethrough   =   0   'False
  666.       EndProperty
  667.       ForeColor       =   &H00000000&
  668.       Height          =   300
  669.       Left            =   4440
  670.       TabIndex        =   7
  671.       Top             =   840
  672.       Width           =   2520
  673.    End
  674. End
  675. Attribute VB_Name = "Stock_PurPlan"
  676. Attribute VB_GlobalNameSpace = False
  677. Attribute VB_Creatable = False
  678. Attribute VB_PredeclaredId = True
  679. Attribute VB_Exposed = False
  680. '***********************************************************************************************************
  681. '*    模 块 名 称 :采购计划--采购计划维护
  682. '*    功 能 描 述 :采购计划维护
  683. '*    程序员姓名  :乔进
  684. '*    最后修改人  :乔进
  685. '*    最后修改时间:2001/12/04
  686. '*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
  687. '*
  688. '*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
  689. '*                                    TextValiLock=True             TextValiLock=false
  690. '*
  691. '*    2.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) "1"-浏览 "2"-新增 "3"-修改
  692. '*
  693. '*    3.Lab_Djclzt 用此标签来标识单据处理状态(默认值为1) "1"-填制单据  "2"-查询单据列表  "3"-明细帐联查单据
  694. '*
  695. '*    4.原则:只要单据能够存盘(无论修改或新增)则其必须接受完整性及有效性规则检查
  696. '***********************************************************************************************************
  697.  
  698. '[以下为根据实际情况设置变量
  699. Dim Bln_BillChange As Boolean                   '标识单据是否发生改动
  700. Dim Rec_Query As New ADODB.Recordset            '单据组查询结果动态集(保存当前单据组ID)
  701. Public Str_QueryCondi As String                 '单据组查询条件(接收单据列表传递查询条件)
  702. Dim RecTemp As New ADODB.Recordset
  703. Public ChildID As String
  704. Dim Str_RightEdit As String
  705. Dim Str_RightAudit As String
  706. ']
  708. '以下为固定使用变量(单据)
  709. Dim BillCode As String                          '单据设计编码(索引号)
  710. Dim Var_Bill() As Variant                       '用来返回单据设计信息
  711. Dim ReportTitle As String                       '报表主标题
  712. Dim Tsxx As String                              '系统提示信息
  714. '以下为固定使用变量(网格)
  715. Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
  716. Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
  717. Dim GridCode As String                          '显示网格网格代码
  718. Dim GridInf() As Variant                        '整个网格设置信息
  719. Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
  720. Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
  721. Dim Sfxshjwg As Boolean                         '是否显示合计网格
  722. Dim Qslz As Long                                '网格隐藏(非操作显示)列数
  723. Dim Sjhgd As Double                             '网格数据行高度
  724. Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
  725. Dim GridStr()  As String                        '网格列信息(字符型)
  726. Dim GridInt() As Integer                        '网格列信息(整型)
  727. Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
  728. Dim Dqlrwgh As Long                             '当前录入数据网格行
  729. Dim Dqlrwgl As Long                             '当前录入数据网格列
  730. Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
  731. Dim Dqlkwgl As Long                             '刚刚离开网格列
  732. Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
  733. Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
  734. Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
  735. Dim Wbkbhlock As Boolean                        '文本框改变值锁
  736. Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
  737. Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
  738. Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
  739. Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
  740. Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
  741. Dim Shsfts As Boolean                           '删除记录行是否提示
  742. Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
  744. '以下为固定使用变量(文本框)
  745. Dim Textvar() As Variant                        '存储变体型文本框信息
  746. Dim Textboolean() As Boolean                    '存储布尔型文本框信息
  747. Dim Textint() As Integer                        '存储整型文本框信息
  748. Dim Textstr() As String                         '存储字符型文本框信息
  749. Dim Max_Text_Index As Integer                   '最大录入文本框索引值
  750. Dim TextGroupCode As String                     '文本框录入分组编码
  751. Dim TextValiLock As Boolean                     '文本框失去焦点是否进行有效性控制判断
  752. Dim TextValiJudgeLock() As Boolean              '文本框录入有效性判断控制锁
  753. Dim TextChangeLock As Boolean                   '文本框内容变换控制锁
  754.     
  755.  
  756. Private Sub Form_KeyPress(KeyAscii As Integer)      '控 制 焦 点 转 移
  757.     
  758.     Dim jdzygs As Integer
  759.     jdzygs = Max_Text_Index                                     '在单据录入中,此焦点转移控制值一定小于等于文本框个数,否则网格回车键将不支持.
  760.     Select Case KeyAscii
  761.         Case vbKeyReturn
  762.             If Kjjdzy(jdzygs) Then
  763.                 KeyAscii = 0
  764.             End If
  765.         Case 39           '屏蔽字符"'"
  766.             KeyAscii = 0
  767.     End Select
  769. End Sub
  771. Private Sub Form_Load()                                                        '窗 体 装 入
  773.     '初始化各种锁值(Fixed)
  774.     Changelock = False             '网格行列改变控制锁
  775.     Gdtlock = False                '滚动条滚动控制
  776.     Yxxpdlock = True               '字段有效性判断锁
  777.     Hyxxpdlock = True              '行有效性判断锁
  778.     Wbkbhlock = False              '文本框内容改变锁
  779.     Screen.MousePointer = 11
  780.     '调入单据信息(需要修改BillCode)
  781.     BillCode = "2408"
  782.     Call Sub_ReadBillInfo(BillCode, Me, Var_Bill())
  783.     Lab_Title = Var_Bill(2)
  784.     Lab_Title.Move (Me.Width - Lab_Title.Width) / 2, 800
  785.     
  786.     '报表编码
  787.     XtReportCode = Var_Bill(5)
  788.     Load Dyymctbl
  789.   
  790.     '以下为文本框处理程序(Fixed)
  791.     TextGroupCode = Var_Bill(3)
  792.  
  793.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
  794.     Call Wbkcsh
  795.   
  796.     '调入网格并记录一些网格信息(Fixed)
  797.     GridCode = Var_Bill(4)         '网格属性编码
  798.     Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  799.       
  800.     Qslz = GridInf(1)
  801.     Sjhgd = GridInf(2)
  802.     Fzxwghs = GridInf(4)
  803.     Sfblbzkd = GridInf(5)
  804.     Shsfts = GridInf(6)
  805.     Sfxshjwg = GridInf(7)
  806.     Szzls = WglrGrid.Cols - 1
  807.     Pmbcsjhs = Int((WglrGrid.Height - WglrGrid.FixedRows * WglrGrid.RowHeight(0)) / Sjhgd) - Fzxwghs - 1
  808.       
  809.     For jsqte = WglrGrid.FixedRows To WglrGrid.Rows - 1
  810.         WglrGrid.RowHeight(jsqte) = Sjhgd
  811.     Next jsqte
  812.     
  813.     '初始化合计网格(Fixed)
  814.     Call Cshhjwg
  815.   
  816.     '单据变动置为False(Fixed)
  817.     Bln_BillChange = False
  818.     Lab_Djclzt.Caption = Xtcdcs
  819.     Call Sjcsh(Trim(Lab_Djclzt.Caption))
  820.     Screen.MousePointer = 0
  821.     
  822.     Str_RightEdit = "MRP_PurchaseList_Edit"
  823.     Str_RightAudit = "MRP_PurchaseList_Edit"
  824.     
  825.     Me.HelpContextID = 2416003
  826. End Sub
  828. Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
  829.     '是否保存已修改单据
  830.      Dim YAnswer As Integer
  831.      If Lab_OperStatus.Caption = "2" Or Lab_OperStatus.Caption = "3" Then
  832.          Tsxx = "单据尚未保存,是否退出?"
  833.          YAnswer = Xtxxts(Tsxx, 2, 2)
  834.          If YAnswer <> 1 Then
  835.              Cancel = 1
  836.              Exit Sub
  837.          End If
  838.      End If
  839.     '卸载打印页面窗体
  840.     Unload Dyymctbl
  841.  
  842.     '判断单据是否发生变化,并返回相应标识
  843.     If Bln_BillChange Then
  844.         Xtfhcs = "1"
  845.     Else
  846.         Xtfhcs = "0"
  847.     End If
  848.    
  849. End Sub
  851. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)                '网格格式调整(Fixed)
  852.   
  853.     Select Case Button.Key
  854.         Case "bcgs"                                          '保存表格格式
  855.             Call Bcwggs(WglrGrid, GridCode, GridStr())
  856.         Case "hfmrgs"                                        '恢复默认格式
  857.             Call Hfmrgs(WglrGrid, GridCode, GridStr())
  858.         Case "szxsxm"                                        '设置显示项目
  859.             Call Szxsxm(WglrGrid, GridCode)
  860.     End Select
  862. End Sub
  865. Private Sub Sjcsh(Str_Pzclzt As String)              '数据初始化模块(根据实际情况)
  866.     
  867.     Dim Sqlstr As String       '查询单据列表条件
  869.     '[>>根据实际情况初始化
  870.     Select Case Str_Pzclzt
  871.         Case "1"   '填制单据
  872.             '设置工具条显示
  873.             With Tlb_Action
  874.                  
  875.                 .Buttons("xz").Visible = True             '新增
  876.                 .Buttons("xg").Visible = True             '修改
  877.                 .Buttons("sc").Visible = True             '删除
  878.                 .Buttons("fgh0").Visible = False           '分隔行
  879.                 .Buttons("zh").Visible = True             '增行
  880.                 .Buttons("sh").Visible = True             '删行
  881.                 .Buttons("fgh1").Visible = True           '分隔行
  882.                 .Buttons("bc").Visible = True             '保存
  883.                 .Buttons("fq").Visible = True             '放弃
  884.                 .Buttons("shsh").Visible = False          '审核
  885.                 .Buttons("shqs").Visible = False          '弃审
  886.                 .Buttons("fgh4").Visible = False          '分隔行
  887.                 .Buttons("first").Visible = False         '首张
  888.                 .Buttons("prev").Visible = False          '上张
  889.                 .Buttons("next").Visible = False          '下张
  890.                 .Buttons("last").Visible = False          '末张
  891.                 .Buttons("fgh5").Visible = False          '分割行
  892.                 .Buttons("qsh").Visible = False           '全审
  893.                 .Buttons("qq").Visible = False            '全弃
  894.                 .Buttons("Finish").Visible = False           '完成
  895.                 .Buttons("AbandonFinish").Visible = False           '弃完
  896.                 .Buttons("Abandon").Visible = False           '废弃
  897.                 .Buttons("Resume").Visible = False           '恢复
  898.             End With
  899.  
  900.  
  901.             
  902.             '调入用户查询结果动态集
  903.             Sqlstr = "SELECT Distinct PurPlanMainID From CG_PurPlanMain Where PurPlanDate='" & Xtrq & "'  ORDER BY PurPlanMainID"
  904.             Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  905.       
  906.             '处理新增状态
  907.             Sub_OperStatus (10)
  908.             '新增单据
  909. '            Call Sub_AddBill
  910.         Case "2"   '查询单据(单据列表)
  911.             '设置工具条显示
  912.             With Tlb_Action
  913.                 .Buttons("xz").Visible = False             '新增
  914.                 .Buttons("xg").Visible = True             '修改
  915.  
  916.                 .Buttons("fgh0").Visible = True           '分隔行
  917.  
  918.                 .Buttons("bc").Visible = True             '保存
  919.                 .Buttons("fq").Visible = True             '放弃
  920.                 .Buttons("shsh").Visible = False           '审核
  921.                 .Buttons("shqs").Visible = False           '弃审
  922.                 .Buttons("fgh2").Visible = False           '分隔行
  923.                 .Buttons("fgh4").Visible = False           '分隔行
  924.                 .Buttons("first").Visible = True          '首张
  925.                 .Buttons("prev").Visible = True           '上张
  926.                 .Buttons("next").Visible = True           '下张
  927.                 .Buttons("last").Visible = True           '末张
  928.                 .Buttons("fgh5").Visible = True           '分割行
  929.  
  930.             End With
  931.             Lab_BillId.Caption = XT_BillID
  932.             Str_QueryCondi = Xtcdcsfz
  933.             Call Sub_ShowBill
  934.             Call Sub_OperStatus("10")
  935.       
  936.             '调入用户查询结果动态集
  937.                         
  938.             Sqlstr = "Select Distinct PurPlanMainID From CG_V_FullPlanBill a " & Str_QueryCondi & " Order by PurPlanMainID  "
  939.             Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  940.             Rec_Query.Find "PurPlanMainID=" & Val(Lab_BillId.Caption)
  941.         Case "3"   '审核
  942.             '设置工具条显示
  943.             With Tlb_Action
  944.                 .Buttons("xz").Visible = False             '新增
  945.                 .Buttons("xg").Visible = False             '修改
  946. '                .Buttons("sc").Visible = False             '删除
  947.                 .Buttons("fgh0").Visible = False           '分隔行
  948.                 .Buttons("zh").Visible = False             '增行
  949.                 .Buttons("sh").Visible = False             '删行
  950.                 .Buttons("fgh1").Visible = False           '分隔行
  951.                 .Buttons("bc").Visible = False             '保存
  952.                 .Buttons("fq").Visible = False             '放弃
  953.                 .Buttons("shsh").Visible = True            '审核
  954.                 .Buttons("shqs").Visible = True            '弃审
  955.                 .Buttons("fgh2").Visible = False           '分隔行
  956.                 .Buttons("fgh4").Visible = True            '分隔行
  957.                 .Buttons("first").Visible = True           '首张
  958.                 .Buttons("prev").Visible = True            '上张
  959.                 .Buttons("next").Visible = True            '下张
  960.                 .Buttons("last").Visible = True            '末张
  961.                 .Buttons("fgh5").Visible = True            '分割行
  963.             End With
  964.             Lab_BillId.Caption = XT_BillID
  965.             Str_QueryCondi = Xtcdcsfz
  966.             Call Sub_ShowBill
  967.             Call Sub_OperStatus("10")
  968.             '设置操作状态为浏览
  969.             Lab_OperStatus.Caption = "1"
  971.             '录入文本框
  972.             For jsqte = Max_Text_Index To 0 Step -1
  973.             LrText(jsqte).Enabled = False
  974.             
  975.             Sqlstr = "Select Distinct PurPlanMainID From CG_V_FullPlanBill a " & Str_QueryCondi & " Order by PurPlanMainID  "
  976.             Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  977.             Rec_Query.Find "PurPlanMainID=" & Val(Lab_BillId.Caption)
  978.             
  979.         Next jsqte
  980.     End Select
  981.   
  982.     '<<]
  983. End Sub
  985. Private Sub Sub_ShowBill()                                          '根据当前单据ID显示整张单据内容
  986.    
  987.     '过程默认参数为当前窗体中单据ID:Lab_BillID
  988.     Dim Sqlstr As String                           '临时使用字符串
  989.     Dim RecTemp As New ADODB.Recordset             '临时使用动态集
  990.     Dim jsqte As Long                              '临时计数器
  991.     Dim sChecker As String
  992.     Screen.MousePointer = 11
  993.     '禁止网格刷新动作,为加快网格显示速度(Fixed)
  994.     WglrGrid.Redraw = False
  995.     
  996.     '本张单据查询字符串
  997.     Sqlstr = "Select * From CG_V_FullPlanBill Where PurPlanMainID ='" & Trim(Lab_BillId.Caption) & "'  Order by PurPlanSubID"
  998.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  999.       
  1000.     With RecTemp
  1001.         WglrGrid.Rows = WglrGrid.FixedRows
  1002.         If .EOF Then
  1003.             For jsqte = 0 To Max_Text_Index
  1004.                 LrText(jsqte).Text = ""
  1005.                 LrText(ag).Text = ""
  1006.             Next jsqte
  1007.             WglrGrid.Clear 1
  1008.             Call Sub_AdjustGrid
  1009.             WglrGrid.Redraw = True
  1010.             Screen.MousePointer = 0
  1011.             Exit Sub
  1012.         Else
  1013.             '[>>显示单据头
  1014.             TextChangeLock = True     '文本框加锁
  1015.             LrText(0).Text = Trim(.Fields("kjYear") & "")
  1016.             LrText(1).Text = Trim(.Fields("Period") & "")
  1017.             LrText(2).Text = Trim(.Fields("PurPlanNum") & "")
  1018.             LrText(3).Text = Format(Trim(.Fields("PurPlanDate") & ""), "yyyy-mm-dd")
  1019.             LrText(4).Text = Trim(.Fields("DeptName") & "")
  1020.             LrText(5).Text = Trim(.Fields("PersonName") & "")
  1021.             LrText(6).Text = Trim(.Fields("SupplierName") & "")
  1022.             LrText(7).Text = Trim(.Fields("Remark") & "")
  1023.             LrText(8).Text = IIf(.Fields("ExigenceFlag") = 1, "紧急计划", "正常计划")
  1024.             LrText(9).Text = Trim(.Fields("Maker") & "")
  1025.             LrText(10).Text = Trim(.Fields("Checker") & "")
  1026.             Select Case .Fields("PurPlanStyle")
  1027.                 Case 0
  1028.                     LrText(11).Text = "未审核"
  1029.                 Case 1
  1030.                     LrText(11).Text = "审核"
  1031.                 Case 2
  1032.                     LrText(11).Text = "下达"
  1033.             End Select
  1034.             TextChangeLock = False    '文本框解锁
  1035.             '<<]
  1036.         End If
  1037.         jsqte = WglrGrid.FixedRows
  1038.         Do While Not .EOF
  1039.             WglrGrid.AddItem ""
  1040.             '[>>显示单据分录
  1041.             WglrGrid.TextMatrix(jsqte, 0) = "*"                                                                                             '数据有效行标识(必填)
  1042.             WglrGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("MNumber") & "")
  1043.             WglrGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("MName") & "")
  1044.             WglrGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("Model") & "")
  1045.             WglrGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(RecTemp.Fields("PrimaryUnitName") & "")
  1046.             WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(RecTemp.Fields("Quantity") & "")
  1047.             WglrGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Format(Trim(RecTemp.Fields("PlanArriveDate") & ""), "yyyy-mm-dd")
  1048.             WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Trim(RecTemp.Fields("SubRemark") & "")
  1049.             WglrGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = Trim(RecTemp.Fields("UnitID") & "")
  1051.             '<<]
  1052.                    
  1053.             WglrGrid.RowHeight(jsqte) = Sjhgd
  1054.             .MoveNext
  1055.             jsqte = jsqte + 1
  1056.         Loop
  1057.     End With
  1058.  
  1059.             
  1060.     '调整网格(Fixed)
  1061.     Call Sub_AdjustGrid
  1062.       
  1063.     '计算合计数据(Fixed)
  1064.     For jsqte = Qslz To WglrGrid.Cols - 1
  1065.         Call Sjhj(jsqte)
  1066.     Next jsqte
  1067.     
  1068.     '将网格刷新解禁(Fixed)
  1069.     WglrGrid.Redraw = True
  1070.        
  1071.     '设置审核弃审按钮状态
  1072.     Call Sub_CheckStatus
  1073.        
  1074.     Screen.MousePointer = 0
  1075. End Sub
  1077. Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
  1078.      
  1079.     '屏蔽文本框,下拉组合框有效性判断
  1080.     Valilock = True
  1081.      
  1082.     '屏蔽网格失去焦点产生的有效性判断
  1083.     Changelock = True
  1084.          
  1085.     Select Case Button.Key
  1086.         Case "yl"                                            '预 览
  1087.             If Fun_Drfrmyxxpd Then
  1088.                 BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, False
  1089.             End If
  1090.         Case "dy"                                            '打 印
  1091.             If Fun_Drfrmyxxpd Then
  1092.                 Dim yhAnswer As Integer      '打印提示
  1093.                 
  1094.                 '用户确认是否打印单据
  1095.                 Tsxx = "请确认是否打印当前单据?"
  1096.                 yhAnswer = Xtxxts(Tsxx, 2, 2)
  1097.                 If yhAnswer = 2 Then
  1098.                     Exit Sub
  1099.                 End If
  1100.                 BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, True
  1101.             End If
  1102. '        Case "xz"                                            '新 增
  1103. '            Call Sub_AddBill
  1104.         Case "xg"                                            '修 改
  1105.             Call Sub_EditBill
  1106.         Case "sc"                                            '删 除
  1107.             Call Sub_DeleteBill
  1108.         Case "zh"                                            '增 行
  1109.             Call zjlrfl
  1110.         Case "sh"                                            '删 行
  1111.             Call Scdqfl
  1112.         Case "bc"                                            '保 存
  1113.             If Fun_Drfrmyxxpd Then
  1114.                 Call Sub_SaveBill
  1115.             End If
  1116.         Case "fq"                                            '放 弃
  1117.             Call Sub_AbandonBill
  1118.         Case "shsh"                                          '审 核
  1119.             Call Sub_Checkbill
  1120.         Case "shqs"                                          '弃 审
  1121.             Call Sub_AbandonCheck
  1122.         Case "first"                                         '首 张
  1123.             Call Sub_First
  1124.         Case "prev"                                          '上 张
  1125.             Call Sub_Prev
  1126.         Case "next"                                          '下 张
  1127.             Call Sub_Next
  1128.         Case "last"                                          '末 张
  1129.             Call Sub_Last
  1130.         Case "bz"                                            '帮 助
  1131.             Call F1bz
  1132.         Case "fh"                                            '退 出
  1133.             If Fun_Drfrmyxxpd Then Unload Me
  1135.         Case "mx"
  1136.             Call WglrGrid_DblClick
  1137.         
  1138.     End Select
  1139.        
  1140.     '解 锁
  1141.     Valilock = False
  1142.     Changelock = False
  1143.     TextChangeLock = False
  1144.         
  1145. End Sub
  1147. '审核当前周期内所有有效单据
  1150. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)     '支持热键操作
  1151.     
  1152.     Select Case KeyCode
  1153. '        Case vbKeyF5          '增加单据
  1154. '            If Tlb_Action.Buttons("xz").Enabled And Tlb_Action.Buttons("xz").Visible Then
  1155. '                Call Sub_AddBill
  1156. '            End If
  1157.         Case vbKeyF3          '修改单据
  1158.             If Tlb_Action.Buttons("xg").Enabled And Tlb_Action.Buttons("xg").Visible Then
  1159.                 Call Sub_EditBill
  1160.             End If
  1161.         Case vbKeyF6          '保存单据
  1162.             If Tlb_Action.Buttons("bc").Enabled And Tlb_Action.Buttons("bc").Visible Then
  1163.                 If Fun_Drfrmyxxpd Then Call Sub_SaveBill
  1164.             End If
  1165.     End Select
  1167. End Sub
  1169. Private Sub Sub_OperStatus(Str_Status As String)                 '工具条依据不同状态所进行的变化
  1170.     
  1171.     With Tlb_Action
  1172.         Select Case Str_Status
  1173.             Case "10"   '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
  1174.                 '工具条
  1175.                 .Buttons("dy").Enabled = True       '打印
  1176.                 .Buttons("yl").Enabled = True       '预览
  1177.                 .Buttons("xz").Enabled = True       '新增
  1178.                 .Buttons("xg").Enabled = True       '修改
  1179.                 .Buttons("sc").Enabled = True       '删除
  1180.                 .Buttons("zh").Enabled = False      '增行
  1181.                 .Buttons("sh").Enabled = False      '删行
  1182.                 .Buttons("bc").Enabled = False      '保存
  1183.                 .Buttons("fq").Enabled = False      '放弃
  1184.                 .Buttons("first").Enabled = True    '首张
  1185.                 .Buttons("prev").Enabled = True     '上张
  1186.                 .Buttons("next").Enabled = True     '下张
  1187.                 .Buttons("last").Enabled = True     '末张
  1188.                 .Buttons("bz").Enabled = True       '帮助
  1189.                 .Buttons("fh").Enabled = True       '退出
  1191.         
  1192.                 '设置审核弃审按钮状态
  1193.                 Call Sub_CheckStatus
  1194.         
  1195.                 '设置文本框录入状态
  1196.                 Call Sub_LrtextStatus(False)
  1197.             Case "20"   '新增单据(（录入）新增一张单据 、（列表）新增一张单据)
  1198.                 '工具条
  1199.                 .Buttons("dy").Enabled = False      '打印
  1200.                 .Buttons("yl").Enabled = False      '预览
  1201.                 .Buttons("xz").Enabled = False      '新增
  1202.                 .Buttons("xg").Enabled = False      '修改
  1203.                 .Buttons("sc").Enabled = False      '删除
  1204.                 .Buttons("zh").Enabled = True       '增行
  1205.                 .Buttons("sh").Enabled = True       '删行
  1206.                 .Buttons("bc").Enabled = True       '保存
  1207.                 .Buttons("fq").Enabled = True       '放弃
  1208.                 .Buttons("shsh").Enabled = False    '审核
  1209.                 .Buttons("shqs").Enabled = False    '弃审
  1210.                 .Buttons("first").Enabled = False   '首张
  1211.                 .Buttons("prev").Enabled = False    '上张
  1212.                 .Buttons("next").Enabled = False    '下张
  1213.                 .Buttons("last").Enabled = False    '末张
  1214.                 .Buttons("bz").Enabled = True       '帮助
  1215.                 .Buttons("fh").Enabled = True       '退出
  1217.                 '设置文本框录入状态
  1218.                 Call Sub_LrtextStatus(True)
  1219.             Case "30"   '修改(（录入）调入修改功能、（列表）调入修改功能)
  1220.                 '工具条
  1221.                 .Buttons("dy").Enabled = False      '打印
  1222.                 .Buttons("yl").Enabled = False      '预览
  1223.                 .Buttons("xz").Enabled = False      '新增
  1224.                 .Buttons("xg").Enabled = False      '修改
  1225.                 .Buttons("sc").Enabled = False      '删除
  1226.                 .Buttons("zh").Enabled = True       '增行
  1227.                 .Buttons("sh").Enabled = True       '删行
  1228.                 .Buttons("bc").Enabled = True       '保存
  1229.                 .Buttons("fq").Enabled = True       '放弃
  1230.                 .Buttons("shsh").Enabled = False    '审核
  1231.                 .Buttons("shqs").Enabled = False    '弃审
  1232.                 .Buttons("first").Enabled = False   '首张
  1233.                 .Buttons("prev").Enabled = False    '上张
  1234.                 .Buttons("next").Enabled = False    '下张
  1235.                 .Buttons("last").Enabled = False    '末张
  1236.                 .Buttons("bz").Enabled = True       '帮助
  1237.                 .Buttons("fh").Enabled = True       '退出
  1239.                 '设置文本框录入状态
  1240.                 Call Sub_LrtextStatus(True)
  1242.         End Select
  1243.     End With
  1245. End Sub
  1247. Private Sub Sub_LrtextStatus(TextEnabled As Boolean)                            '设置录入文本框状态
  1249.     '录入文本框状态设置
  1250.     If TextEnabled Then
  1251.         For jsqte = Max_Text_Index To 0 Step -1
  1252.             '判断文本框是否可编辑
  1253.             If Textboolean(jsqte, 5) Then
  1254.                 LrText(jsqte).Enabled = True
  1255.             Else
  1256.                 LrText(jsqte).Enabled = False
  1257.             End If
  1258.         Next jsqte
  1259.     Else
  1260.         For jsqte = Max_Text_Index To 0 Step -1
  1261.             LrText(jsqte).Enabled = False
  1262.         Next jsqte
  1263.     End If
  1265. End Sub
  1267. Private Sub Sub_CheckStatus()                                       '设置审核弃审按钮状态(亦可设置其他动作按钮状态)
  1268.     Dim State As Integer
  1269.     Dim sChecker As String
  1270.     State = Fn_GetBillState(sChecker)
  1271.     
  1272.     Select Case State
  1273.         Case 0 '未审核
  1274.             Tlb_Action.Buttons("shsh").Enabled = True           '审核
  1275.             Tlb_Action.Buttons("shqs").Enabled = False          '弃审
  1276.         Case 1 '审核
  1277.             Tlb_Action.Buttons("shsh").Enabled = False          '审核
  1278.             Tlb_Action.Buttons("shqs").Enabled = True           '弃审
  1279.         Case 2 '生成
  1280.             Tlb_Action.Buttons("shsh").Enabled = False          '审核
  1281.             Tlb_Action.Buttons("shqs").Enabled = False          '弃审
  1282.     End Select
  1283. End Sub
  1284. 'Return Bill State
  1285. Private Function Fn_GetBillState(Checker As String) As Integer
  1286.     Dim Rect As New ADODB.Recordset, State As Integer
  1287.     
  1288.     Sqlstr = "Select PurPlanStyle From Cg_PurPlanMain Where PurPlanMainID ='" & Trim(Me.Lab_BillId) & "'"
  1289.     Set Rect = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1290.     State = 0
  1291.     If Not Rect.EOF Then
  1292.         Fn_GetBillState = Val(Rect.Fields("PurPlanStyle") & "")
  1293.     Else
  1294.         Fn_GetBillState = 0
  1295.     End If
  1297. End Function
  1300. Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
  1301.     
  1302.     Dim xswbrr As String
  1303.     With WglrGrid
  1304.         Zdlrqnr = Trim(.Text)
  1305.         xswbrr = Trim(.Text)
  1306.         If GridBoolean(.Col, 3) Then   '列表框录入
  1307.             '填充列表框程序
  1308.             Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
  1309.         Else
  1310.             Wbkbhlock = True
  1311.        
  1312.             '====以下为用户自定义
  1313.             Ydtext.Text = xswbrr
  1314.             '====以上为用户自定义
  1315.          
  1316.             Wbkbhlock = False
  1317.             Ydtext.SelStart = Len(Ydtext.Text)
  1318.         End If
  1319.     End With
  1321. End Sub
  1323. Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
  1324.  
  1325.     '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
  1327.     Dim Str_JudgeText As String                 '临时有效性判断字段内容
  1328.     Dim Coljsq As Long                          '临时列计数器
  1329.     Dim RecTemp As New ADODB.Recordset          '临时使用动态集
  1330.     Dim Sqlstr As String                        '临时使用查询字符串
  1332.     With WglrGrid
  1333.         '非录入状态或非数据行则其有效性为合法
  1334.         If Yxxpdlock Or .Row < .FixedRows Then
  1335.             sjzdyxxpd = True
  1336.             Exit Function
  1337.         End If
  1338.         
  1339.         '取得当前要判断字段内容
  1340.         Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
  1341.       
  1342.         '根据不同字段进行相应的处理(依据其逻辑编号)
  1343.         Select Case GridStr(Dqpdwgl, 1)
  1344.             '[>>以下为自定义部分
  1346.             Case "005"          '需求数量
  1347.                 '1.放置字段有效性判断
  1348.                 If Str_JudgeText <> "" Then
  1349.                     If Not IsNumeric(Str_JudgeText) Then
  1350.                         Tsxx = "非法数字录入!"
  1351.                         GoTo Lrcwcl
  1352.                     ElseIf Val(Str_JudgeText) <= 0 Then
  1353.                         Tsxx = "计划数量不能小于等于零!"
  1354.                         GoTo Lrcwcl
  1355.                         
  1356.                     End If
  1357.                 Else
  1358.                     If Len(Str_JudgeText) = 0 Then
  1359.                         Tsxx = "计划数量不能为空!"
  1360.                         GoTo Lrcwcl
  1361.                     End If
  1362.                 End If
  1363.             Case "006"
  1364.                 
  1365.                 If Str_JudgeText <> "" Then
  1366.                     If Not IsDate(Str_JudgeText) Then
  1367.                         Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  1368.                         GoTo Lrcwcl
  1369.                     End If
  1370.                 
  1371.                     If Format(CDate(Str_JudgeText), "yyyy-mm-dd") <= Format(Xtrq, "yyyy-mm-dd") Then
  1372.                         Tsxx = "计划到货日期必须大于当前系统日期!"
  1373.                         GoTo Lrcwcl
  1374.                     End If
  1375.                     WglrGrid.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = Format(CDate(Str_JudgeText), "yyyy-mm-dd")
  1376.                 End If
  1377.                 '2.放置字段事后处理程序
  1379.                 '2.放置字段事后处理程序
  1380.  
  1381.                 '<<以上为自定义部分]
  1382.         End Select
  1383.         
  1384.         '字段录入正确后为零字段清空(Fixed)
  1385.         Call Qkwlzd(Dqpdwgh, Dqpdwgl)
  1386.      
  1387.         '字段录入正确后进行数据合计(Fixed)
  1388.         For Coljsq = Qslz To .Cols - 1
  1389.             Call Sjhj(Coljsq)
  1390.         Next Coljsq
  1391.      
  1392.         '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
  1393.         sjzdyxxpd = True
  1394.         Yxxpdlock = True
  1395.         Exit Function
  1396.     End With
  1397.   
  1398. Lrcwcl:    '录入错误处理
  1399.     With WglrGrid
  1400.   
  1401.         '给出错误提示信息
  1402.         Call Xtxxts(Tsxx, 0, 1)
  1403.           
  1404.         '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
  1405.         Changelock = True
  1406.         .Select Dqpdwgh, Dqpdwgl
  1407.         Changelock = False
  1408.         Call xswbk
  1409.           
  1410.         '函数返回False
  1411.         sjzdyxxpd = False
  1412.         Exit Function
  1413.     End With
  1415. End Function
  1417. Private Sub Sub_JoinCount(Lng_CountRow As Long, Lng_CountCol As Long)       '当网格列值发生改变时,处理网格列之间的关联计算(可选)
  1418.   
  1419.   '过程参数:Lng_CountRow,Lng_CountCol 网格改变内容所处行列值
  1420.    
  1421.     With WglrGrid
  1422.         Select Case GridStr(Lng_CountCol, 1)         '判断网格列对应逻辑编号
  1423.                
  1424.             '[>>以下为自定义部分
  1425.             '<<以上为自定义部分]
  1426.         End Select
  1427.     End With
  1429. End Sub
  1431. Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                     '录入数据行有效性判断,同时进行行处理
  1432.  
  1433.     '函数参数:Yxxpdh 要进行有效性判断的网格数据行的行值
  1435.     Dim Lrywlz As Long                            '录入有误网格列值
  1436.     Dim RecTemp As New ADODB.Recordset            '临时使用动态集
  1437.     
  1438.     With WglrGrid
  1439.         '判断行为空(行中所有可编辑列数据均为空或为零)和无效数据行则清除当前行
  1440.         If .Rows <= .FixedRows Then Exit Function   ' 如果没有记录，则退出
  1441.         If .TextMatrix(Yxxpdh, 0) <> "*" Then
  1442.             Sjhzyxxpd = True
  1443.             Exit Function
  1444.         End If
  1445.   
  1446.         '行没有发生变化则不进行有效性判断
  1447.         If Hyxxpdlock Then
  1448.             Sjhzyxxpd = True
  1449.             Exit Function
  1450.         End If
  1451.   
  1452.         '[>>以下为自定义部分
  1453.     
  1454.         '1.放置行有效性判断程序
  1455.            
  1456.         '1.1首先进行单个不能为空或不能为零判断(Fixed)
  1457.         For jsqte = Qslz To .Cols - 1
  1458.             
  1459.             '字段不能为空
  1460.             If GridInt(jsqte, 5) = 1 Then
  1461.                 If Len(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
  1462.                     Tsxx = GridStr(jsqte, 2)
  1463.                     Lrywlz = jsqte
  1464.                     GoTo Lrcwcl
  1465.                     Exit For
  1466.                 End If
  1467.             End If
  1468.             
  1469.             '字段不能为零
  1470.             If GridInt(jsqte, 5) = 2 Then
  1471.                 If Val(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
  1472.                     Tsxx = GridStr(jsqte, 2)
  1473.                     Lrywlz = jsqte
  1474.                     GoTo Lrcwcl
  1475.                     Exit For
  1476.                 End If
  1477.             End If
  1478.         Next jsqte
  1479.         
  1480.         '1.2进行其他有效性判断,编写格式同1.1
  1483.         '2.放置行处理程序(当数据行通过有效性判断)
  1484.         
  1485.         '以上为自定义部分<<]
  1486.     End With    'WglrGrid
  1488.     '如果此行通过行有效性判断则加锁,直至此行数据再次发生变化
  1489.     Sjhzyxxpd = True
  1490.     Hyxxpdlock = True
  1491.     Exit Function
  1493. Lrcwcl:      '录入错误处理
  1494.     With WglrGrid
  1495.   
  1496.         '给出错误提示信息
  1497.         Call Xtxxts(Tsxx, 0, 1)
  1498.       
  1499.         '返回网格错误位置 (ChangeLock避免再次引发RowColChange有效性判断), 装入录入载体
  1500.         Changelock = True
  1501.         .Select Yxxpdh, Lrywlz
  1502.         Changelock = False
  1503.         Call xswbk
  1504.     
  1505.         '函数返回False
  1506.         Sjhzyxxpd = False
  1507.         Exit Function
  1508.     End With
  1510. End Function
  1511.  
  1512. Private Sub Sub_EditBill()                                                '修改一张单据
  1513.    
  1514.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  1515.    
  1516.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1517.        Exit Sub
  1518.     End If
  1519.    
  1520.     '非有效单据不予进行修改动作
  1521.     If Val(Lab_BillId.Caption) = 0 Then
  1522.         Exit Sub
  1523.     End If
  1524.    
  1525.     '判断当前单据是否允许修改
  1526.     If Not Fun_AllowEdit Then
  1527.         Exit Sub
  1528.     End If
  1529.    
  1530.     '设置操作状态为修改
  1531.     Lab_OperStatus.Caption = "3"
  1532.    
  1533.     '设置工具条状态
  1534.     Call Sub_OperStatus("30")
  1535.     
  1536.     '设置可以修改的文本框
  1537.     For jsqte = 0 To Max_Text_Index
  1538.         LrText(jsqte).Enabled = False
  1539.     Next jsqte
  1540.     LrText(7).Enabled = True
  1541.     LrText(7).SetFocus
  1542.  
  1543.    
  1544. End Sub
  1546. Private Sub Sub_DeleteBill()                                               '删除当前单据
  1547.  
  1548. End Sub
  1550. Private Sub Sub_AbandonBill()                                              '放弃对当前单据的操作
  1551.  
  1552.     Dim jsqte As Long                    '临时使用计数器
  1553.   
  1554.     '先关闭录入载体(Fixed)
  1555.     Changelock = True
  1556.     Valilock = True
  1557.     Call Ycwbk
  1558.     Changelock = False
  1559.     Valilock = False
  1561.     '如果单据有效则重新显示当前单据,置单据为空状态
  1562.     If Not Rec_Query.EOF Then
  1563.         Ydcommand1.Visible = False
  1564.         Lab_BillId.Caption = Rec_Query.Fields("PurPlanMainID")
  1565.         Call Sub_ShowBill
  1566.     Else
  1567.         Ydcommand1.Visible = False
  1568.         '单据ID置为0
  1569.         Lab_BillId.Caption = 0
  1570.      
  1571.         '清除录入文本框
  1572.         For jsqte = Max_Text_Index To 0 Step -1
  1573.             LrText(jsqte).Tag = ""
  1574.             LrText(jsqte).Text = ""
  1575.         Next jsqte
  1577.         '重置网格(Fixed)
  1578.         With WglrGrid
  1579.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  1580.             For jsqte = .FixedRows To .Rows - 1
  1581.                 .RowHeight(jsqte) = Sjhgd
  1582.             Next jsqte
  1584.             WglrGrid.Clear 1
  1585.             Changelock = True
  1586.             .Select .FixedRows, Qslz
  1587.             Changelock = False
  1588.         End With
  1590.         '计算合计数据(清零)(Fixed)
  1591.         For jsqte = Qslz To WglrGrid.Cols - 1
  1592.             Call Sjhj(jsqte)
  1593.         Next jsqte
  1594.     End If
  1595.     
  1596.     '设置操作状态为浏览
  1597.     Lab_OperStatus = "1"
  1598.     Call Sub_OperStatus("10")
  1600. End Sub
  1602. Private Function Sub_SaveBill() As Boolean                                   '保 存 单 据
  1603.   
  1604.     Dim RecTemp As New ADODB.Recordset                    '临时使用动态集
  1605.     Dim Rec_VouchMain As New ADODB.Recordset              '单据主表动态集
  1606.     Dim Rec_VouchSub As New ADODB.Recordset               '单据子表动态集
  1607.     Dim Rowjsq As Long                                    '网格行计数器
  1608.     Dim Coljsq As Long                                    '网格列计数器
  1609.     Dim jsqte As Integer                                  '临时计数器
  1610.     Dim Lng_RowCount As Long                              '有效数据行计数器
  1611.     Dim Lrywlz As Long                                    '录入有误列值
  1612.     Dim sTemp As String
  1613.     
  1614.     Sub_SaveBill = False
  1615.   
  1616.     '一.============先对单据内容进行有效性判断==============='
  1618.     
  1619.     '先进行字段不能为空或不能为零有效性判断(Fixed)
  1620.     For jsqte = 0 To Max_Text_Index
  1621.         If Textint(jsqte, 8) = 1 Then     '字段不能为空
  1622.             If Len(Trim(LrText(jsqte).Text)) = 0 Then
  1623.                 Tsxx = Textstr(jsqte, 7) & "不能为空!"
  1624.                 Call Xtxxts(Tsxx, 0, 1)
  1625.                 LrText(jsqte).SetFocus
  1626.                 Exit Function
  1627.             End If
  1628.         Else
  1629.             If Textint(jsqte, 8) = 2 Then   '字段不能为零
  1630.                 If Val(Trim(LrText(jsqte).Text)) = 0 Then
  1631.                     Tsxx = Textstr(jsqte, 7) & "不能为零!"
  1632.                     Call Xtxxts(Tsxx, 0, 1)
  1633.                     LrText(jsqte).SetFocus
  1634.                     Exit Function
  1635.                 End If
  1636.             End If
  1637.         End If
  1638.     Next jsqte
  1639.     
  1640.     '对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
  1641.     For jsqte = 0 To Max_Text_Index
  1642.         If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
  1643.             If Not TextYxxpd(jsqte) Then
  1644.                 Call TextShow(jsqte)
  1645.                 Exit Function
  1646.             End If
  1647.         End If
  1648.     Next jsqte
  1649.   
  1650.     '[>>
  1651.     '可在此区域写入其他对单据表头内容的有效性判断.
  1653.     '<<]
  1654.   
  1655.     '[>>下面将对所有有效数据行进行有效性判断
  1656.   
  1657.     Lng_RowCount = 0
  1658.   
  1659.     With WglrGrid
  1660.         For Rowjsq = .FixedRows To .Rows - 1
  1661.             '带*号者为有效数据行(Fixed)
  1662.             If .TextMatrix(Rowjsq, 0) <> "*" Then
  1663.                 Exit For
  1664.             Else
  1665.                 Lng_RowCount = Lng_RowCount + 1
  1666.             End If
  1667.             '1.首先进行为空或为零判断(Fixed)
  1668.             For jsqte = Qslz To .Cols - 1
  1669.                 '字段不能为空
  1670.                 If GridInt(jsqte, 5) = 1 Then
  1671.                     If Len(Trim(.TextMatrix(Rowjsq, jsqte))) = 0 Then
  1672.                         Tsxx = GridStr(jsqte, 2)
  1673.                         Lrywlz = jsqte
  1674.                         GoTo Lrcwcl
  1675.                         Exit For
  1676.                     End If
  1677.                 End If
  1678.                 
  1679.                 '字段不能为零
  1680.                 If GridInt(jsqte, 5) = 2 Then
  1681.                     If Val(Trim(.TextMatrix(Rowjsq, jsqte))) = 0 Then
  1682.                         Tsxx = GridStr(jsqte, 2)
  1683.                         Lrywlz = jsqte
  1684.                         GoTo Lrcwcl
  1685.                         Exit For
  1686.                     End If
  1687.                 End If
  1688.             Next jsqte
  1689.            
  1690.             '2
  1691.             '判断采购计划数量合法性
  1692.             sTemp = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) & "")
  1693.             If Not IsNumeric(sTemp) Then
  1694.                 Tsxx = "非法数字录入!"
  1695.                 GoTo Lrcwcl
  1696.             ElseIf Val(sTemp) <= 0 Then
  1697.                 Tsxx = "计划数量不能小于等于零!"
  1698.                 GoTo Lrcwcl
  1699.             End If
  1700.  
  1701.             sTemp = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) & "")
  1702.             If sTemp <> "" Then
  1703.                 If Not IsDate(sTemp) Then
  1704.                     Tsxx = "非法公历日期!(格式:" + Format(Xtrq, "yyyy-mm-dd") + ")"
  1705.                     GoTo Lrcwcl
  1706.                 End If
  1707.             
  1708.                 If Format(CDate(sTemp), "yyyy-mm-dd") <= Format(Xtrq, "yyyy-mm-dd") Then
  1709.                     Tsxx = "计划到货日期必须大于当前系统日期!"
  1710.                     GoTo Lrcwcl
  1711.                 End If
  1712.             End If
  1713.         Next Rowjsq
  1714.      
  1715.         '单据分录行数不能为零(Fixed)
  1716.         If Lng_RowCount = 0 Then
  1717.             Tsxx = "单据分录行数不能为零!"
  1718.             Call Xtxxts(Tsxx, 0, 1)
  1719.             Exit Function
  1720.         End If
  1721.         
  1722.         '[>>
  1723.         '此处可以定义整张单据不能通过有效性检查的理由
  1724.         '<<]
  1725.     End With  '网格
  1726.    
  1727.    
  1728.     '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
  1729.    
  1730.     '对存盘进行事务处理(Fixed)
  1731.     On Error GoTo Swcwcl
  1732.     Cw_DataEnvi.DataConnect.BeginTrans
  1733.     
  1734.     '判断单据状态以进行不同处理
  1735.     
  1736.     '1.先对单据主表进行处理
  1737.     If Trim(Lab_OperStatus) = "3" Then
  1738.         '修改单据
  1739.        
  1740.         '1.删除原单据子表中所有内容
  1741.         Sqlstr = "Delete Cg_PurPlanSub Where PurPlanMainID ='" & Val(Lab_BillId.Caption) & "'"
  1742.         Cw_DataEnvi.DataConnect.Execute (Sqlstr)
  1743.         
  1744.         Sqlstr = "Update Cg_PurPlanMain Set Remark='" & Trim(LrText(7)) & "' ,  Maker='" & Trim(Xtczy) & "' ,PurPlanDate='" & Format(Trim(Xtrq), "yyyy-mm-dd") & "' Where PurPlanMainID='" & Val(Lab_BillId.Caption) & "'"
  1745.         Cw_DataEnvi.DataConnect.Execute (Sqlstr)
  1747.     End If
  1748.          
  1749.     '2.对单据子表进行处理
  1750.          
  1751.     '打开单据子表动态集
  1752.     If Rec_VouchSub.State = 1 Then Rec_VouchSub.Close
  1753.     Sqlstr = "Select * From Cg_PurPlanSub Where 1=2"
  1754.     Rec_VouchSub.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1755.      
  1756.     '将网格中有效数据行写入单据子表
  1757.     For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
  1758.         If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
  1759.             Exit For
  1760.         End If
  1761.         
  1762.         With Rec_VouchSub
  1763.             .AddNew
  1764.             .Fields("PurPlanSubID") = Rowjsq - WglrGrid.FixedRows + 1                                                   '自表ID
  1765.             .Fields("PurPlanmainID") = Val(Lab_BillId.Caption)                                                          '主表ID
  1766.             .Fields("MNumber") = WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))                               '物料编码
  1767.             .Fields("Quantity") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) & "")                '需求数量
  1768.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) & "")) <> 0 Then
  1769.                 .Fields("PlanArriveDate") = Format(WglrGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)), "yyyy-mm-dd")      '需求日期
  1770.             End If
  1771.             .Fields("Remark") = WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls))                                '备注
  1772.             .Fields("UnitID") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)))                               'TotalID
  1773.             .Update
  1774.         End With
  1775.     Next Rowjsq
  1776.     Cw_DataEnvi.DataConnect.CommitTrans
  1777.     
  1778.     Sub_SaveBill = True
  1779.     Tsxx = "单据存盘完毕!  "
  1780.     Call Xtxxts(Tsxx, 0, 4)
  1781.     
  1782.     '标识单据发生改动
  1783.     Bln_BillChange = True
  1784.     
  1785.     '设置单据改变后的状态
  1786.     Lab_OperStatus = "1"
  1787.     Call Sub_OperStatus("10")
  1788.     Rec_Query.Requery
  1789.     Rec_Query.Find "PurPlanMainID=" & Val(Lab_BillId.Caption)
  1790.     
  1791.     Exit Function
  1793. Swcwcl:       '数据存盘时出现错误
  1794.     Cw_DataEnvi.DataConnect.RollbackTrans
  1795.     With WglrGrid
  1796.         If Err.Number = -2147217887 Then
  1797.             Tsxx = "单据中第  " & Trim(Str(Rowjsq - .FixedRows + 1)) & " 条分录录入数据超出允许范围!"
  1798.             Call Xtxxts(Tsxx, 0, 1)
  1799.             Changelock = True
  1800.             .Select Rowjsq, Qslz
  1801.             WglrGrid.SetFocus
  1802.             Changelock = False
  1803.             Exit Function
  1804.         Else
  1805.             Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  1806.             Call Xtxxts(Tsxx, 0, 1)
  1807.             Exit Function
  1808.         End If
  1809.     End With
  1811. Lrcwcl:        '录入错误处理(存盘前逐行有效性判断)
  1812.     With WglrGrid
  1813.         Call Xtxxts("(第 " & Trim(Str(Rowjsq - .FixedRows + 1)) & " 条单据分录)-" & Tsxx, 0, 1)
  1814.         Changelock = True
  1815.         .Select Rowjsq, Lrywlz
  1816.         WglrGrid.SetFocus
  1817.         Changelock = False
  1818.         Exit Function
  1819.     End With
  1821. End Function
  1823. Private Sub Sub_First()             '首 张
  1824.     
  1825.     With Rec_Query
  1826.         If .RecordCount = 0 Then
  1827.             Exit Sub
  1828.         End If
  1829.         .MoveFirst
  1830.         Lab_BillId.Caption = .Fields("PurPlanMainID")
  1831.         Call Sub_ShowBill
  1832.     End With
  1834. End Sub
  1836. Private Sub Sub_Prev()             '上 张
  1837.     
  1838.     With Rec_Query
  1839.         If .RecordCount = 0 Then
  1840.             Exit Sub
  1841.         End If
  1842.         If Not .BOF Then
  1843.             .MovePrevious
  1844.         End If
  1845.         If Not .BOF Then
  1846.             Lab_BillId.Caption = .Fields("PurPlanMainID")
  1847.         Else
  1848.             .MoveNext
  1849.         End If
  1850.         Call Sub_ShowBill
  1851.     End With
  1853. End Sub
  1855. Private Sub Sub_Next()             '下 张
  1856.     With Rec_Query
  1857.         If .RecordCount = 0 Then
  1858.             Exit Sub
  1859.         End If
  1860.         If Not .EOF Then
  1861.             .MoveNext
  1862.         End If
  1863.         If Not .EOF Then
  1864.             Lab_BillId.Caption = .Fields("PurPlanMainID")
  1865.         Else
  1866.             .MovePrevious
  1867.         End If
  1868.         Call Sub_ShowBill
  1869.     End With
  1871. End Sub
  1873. Private Sub Sub_Last()              '末 张
  1874.     
  1875.     With Rec_Query
  1876.         If .RecordCount = 0 Then
  1877.             Exit Sub
  1878.         End If
  1879.         .MoveLast
  1880.         Lab_BillId.Caption = .Fields("PurPlanMainID")
  1881.         Call Sub_ShowBill
  1882.     End With
  1884. End Sub
  1885.     
  1886. '[>>===================以下为根据实际业务需要自定义过程区域=============================<<]
  1888. '审核,弃审
  1889. Private Sub Sub_Checkbill()             '审 核
  1890.     Dim sChecker As String
  1891.     
  1892.     If Not Security_Log(Str_RightAudit, Xtczybm, 1, True) Then
  1893.        Exit Sub
  1894.     End If
  1895.     
  1896.     '[>>
  1897.     '此处可以写入禁止单据审核的理由
  1898.     If Not Fun_AllowEdit Then Exit Sub
  1899.     
  1900.     Sqlstr = "Select * From Cg_PurPlanMain Where PurPlanMainID ='" & Trim(Me.Lab_BillId) & "'   "
  1901.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1902.     If RecTemp.EOF Then
  1903.         Tsxx = "没有找到当前单据,可能已被其他用户删除"
  1904.         Call Xtxxts(Tsxx, 0, 1)
  1905.         Exit Sub
  1906.     End If
  1907.     If RecTemp!PurPlanStyle <> 0 Then
  1908.         Tsxx = "当前单据已经审核或下达,不能再次审核!"
  1909.         Call Xtxxts(Tsxx, 0, 1)
  1910.         Exit Sub
  1911.     End If
  1913.     '<< ]
  1914.     
  1915.     '将单据写入审核标识
  1916.     Sqlstr = "Update Cg_PurPlanMain Set PurPlanStyle='1' Where PurPlanMainID='" & Val(Lab_BillId.Caption) & "' "
  1917.     Cw_DataEnvi.DataConnect.Execute (Sqlstr)
  1918.     
  1919.     '修改当前单据状态
  1920.     LrText(11).Text = "审核"
  1921.  
  1922.     
  1923.     
  1924.     '设置审核弃审按钮状态
  1925.     Call Sub_CheckStatus
  1926.     
  1927.     '标识单据发生变化
  1928.     Bln_BillChange = True
  1930. End Sub
  1932. Private Sub Sub_AbandonCheck()          '弃 审
  1933.     Dim sChecker As String
  1934.     '[>>
  1935.     '此处可以写入禁止单据弃审的理由
  1936.     
  1937.     If Not Security_Log(Str_RightAudit, Xtczybm, 1, True) Then
  1938.        Exit Sub
  1939.     End If
  1940.     
  1941.     Sqlstr = "Select *  From Cg_PurPlanMain Where PurPlanMainID ='" & Trim(Me.Lab_BillId) & "'   "
  1942.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1943.     If RecTemp.EOF Then
  1944.         Tsxx = "没有找到当前单据,可能已被其他用户删除!"
  1945.         Call Xtxxts(Tsxx, 0, 1)
  1946.         Exit Sub
  1947.     End If
  1948.     '<<]
  1949.     If RecTemp!PurPlanStyle <> 1 Then
  1950.         Tsxx = "当前单据不是审核状态,不能放弃审核"
  1951.         Call Xtxxts(Tsxx, 0, 1)
  1952.         Exit Sub
  1953.     End If
  1954.     '将单据清除审核标识
  1955.     Sqlstr = "Update Cg_PurPlanMain Set PurPlanStyle=0  Where PurPlanMainID='" & Val(Lab_BillId.Caption) & "' "
  1956.     Cw_DataEnvi.DataConnect.Execute (Sqlstr)
  1957.     
  1958.     '清空单据审核人
  1959.     LrText(11).Text = "未审核"
  1960.  
  1961.     '设置审核弃审按钮状态
  1962.     Call Sub_CheckStatus
  1963.     
  1964.     '标识单据发生变化
  1965.     Bln_BillChange = True
  1966.   
  1967. End Sub
  1969. Private Function Fun_AllowEdit() As Boolean                      '判断当前单据是否允许编辑或删除
  1970.   
  1971.     Dim Rect As New ADODB.Recordset     '临时使用动态集
  1972.     Fun_AllowEdit = False
  1973.     
  1974.     Sqlstr = "Select PurPlanStyle From Cg_PurPlanMain Where PurPlanMainID='" & Trim(Me.Lab_BillId & "") & "'"
  1975.     Set Rect = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1976.     If Rect.EOF Then
  1977.         Tsxx = "没有找到当前计划，可能已被其他用户删除!"
  1978.         Call Xtxxts(Tsxx, 0, 1)
  1979.         Fun_AllowEdit = False
  1980.         Exit Function
  1981.     Else
  1982.         If Rect!PurPlanStyle <> 0 Then
  1983.             Tsxx = "当前计划已经审核或下达,不能修改或删除!"
  1984.             Call Xtxxts(Tsxx, 0, 1)
  1985.             Fun_AllowEdit = False
  1986.             Exit Function
  1987.         End If
  1988.     End If
  1989.     Fun_AllowEdit = True
  1990. End Function
  1991. '[>>===================以上为根据实际业务需要自定义过程区域=============================<<]
  1993. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
  1994. Private Sub Sub_AdjustGrid()
  1995.   
  1996.     '调 整 网 格
  1997.     With WglrGrid
  1998.         '加 1 保持一行录入行
  1999.         If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  2000.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  2001.             For jsqte = .FixedRows To .Rows - 1
  2002.                 .RowHeight(jsqte) = Sjhgd
  2003.             Next jsqte
  2004.         Else
  2005.             '判断是否有辅助行和录入行,如没有则加行
  2006.             Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  2007.                 .AddItem ""
  2008.                 .RowHeight(.Rows - 1) = Sjhgd
  2009.             Loop
  2010.         End If
  2011.     End With
  2013. End Sub
  2015. Private Sub Lrzdbz()                                                      '录入字段帮助
  2016.     
  2017.     If Not Ydcommand.Visible Then
  2018.         Exit Sub
  2019.     End If
  2020.    
  2021.     With WglrGrid
  2022.         Valilock = True
  2023.     
  2024.         '处理通用部分
  2025.         Changelock = True        '调入另外窗体必须加锁
  2026.         Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
  2027.         Changelock = False
  2028.         
  2029.         If Len(Xtfhcs) <> 0 Then
  2030.             If GridInt(.Col, 7) = 0 Then
  2031.                 Ydtext.Text = Xtfhcs
  2032.             Else
  2033.                 Ydtext.Text = Xtfhcsfz
  2034.             End If
  2035.         End If
  2036.         
  2037.         Valilock = False
  2038.         If Ydtext.Visible Then
  2039.             Ydtext.SetFocus
  2040.         End If
  2041.     End With
  2043. End Sub
  2045. Private Sub Cshhjwg()                                                     '初始化合计网格(*对合计网格来说,录入网格为容器)
  2046.     
  2047.     With HjGrid
  2048.     
  2049.        '是否显示合计网格
  2050.        If Not Sfxshjwg Then
  2051.            .Visible = False
  2052.            Exit Sub
  2053.        Else
  2054.            .Visible = True
  2055.        End If
  2056.       
  2057.        '设置网格相关属性
  2058.        .Enabled = False
  2059.        .Appearance = flexFlat
  2060.        .BorderStyle = flexBorderNone
  2061.        .ScrollBars = flexScrollBarNone
  2062.        .Width = WglrGrid.Width
  2063.        .FixedRows = 0
  2064.        .Rows = 1
  2065.        .Cols = WglrGrid.Cols
  2066.        .LeftCol = WglrGrid.LeftCol
  2067.        .TextMatrix(0, Qslz) = "合  计"
  2068.        For jsqte = 0 To WglrGrid.Cols - 1
  2069.            .ColHidden(jsqte) = WglrGrid.ColHidden(jsqte)
  2070.            .ColWidth(jsqte) = WglrGrid.ColWidth(jsqte)
  2071.            .ColAlignment(jsqte) = WglrGrid.ColAlignment(jsqte)
  2072.            .ColFormat(jsqte) = WglrGrid.ColFormat(jsqte)
  2073.        Next jsqte
  2074.        .ColAlignment(Qslz) = flexAlignCenterTop
  2075.        For jsqte = .FixedRows To .Rows - 1
  2076.            .RowHeight(jsqte) = .Height / .Rows
  2077.        Next jsqte
  2078.        
  2079.       '程序自动调整网格高度(自动设置为网格剩余高度+辅助项网格行数(默认为1)*数据行高度)、并设置其位置信息
  2080.        .Height = Fzxwghs * Sjhgd + ((WglrGrid.Height - WglrGrid.FixedRows * WglrGrid.RowHeight(0)) Mod Sjhgd)
  2081.        .RowHeight(0) = .Height
  2082.        .Move 0, WglrGrid.Height - .Height, WglrGrid.Width, .Height
  2083.     End With
  2085. End Sub
  2087. Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
  2088.    Call Cxxswbk
  2089. End Sub
  2091. Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  2092.     Fun_Drfrmyxxpd = True
  2093.     With WglrGrid
  2094.    
  2095.         '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  2096.         If Ydtext.Visible Or YdCombo.Visible Then
  2097.             Call Lrsjhx
  2098.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  2099.                 Fun_Drfrmyxxpd = False
  2100.                 Exit Function
  2101.             End If
  2102.         End If
  2103.    
  2104.         '进行行有效性判断
  2105.         If Not Sjhzyxxpd(.Row) Then
  2106.             Fun_Drfrmyxxpd = False
  2107.             Exit Function
  2108.         End If
  2109.     End With
  2111. End Function
  2113. Private Sub WglrGrid_AfterUserResize(ByVal Row As Long, ByVal Col As Long)       '调整列宽
  2115.     If HjGrid.Visible Then
  2116.         With HjGrid
  2117.             .ColWidth(Col) = WglrGrid.ColWidth(Col)
  2118.         End With
  2119.     End If
  2121. End Sub
  2123. Private Sub WglrGrid_EnterCell()                                                 '显示当前数据行相关信息
  2124.     
  2125.     With WglrGrid
  2126.         If .Row >= .FixedRows Then
  2127.             '[>>
  2128.             '此处可以填写显示与此网格行相关信息
  2129.             '<<]
  2130.         End If
  2131.     End With
  2133. End Sub
  2135. Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  2137.     '网格得到焦点,如果当前选择行为非数据行
  2138.     '则调整当前焦点至有效数据行
  2140.     With WglrGrid
  2141.         If .Row < .FixedRows And .Rows > .FixedRows Then
  2142.             Changelock = True
  2143.             .Select .FixedRows, .Col
  2144.             Changelock = False
  2145.         End If
  2146.         If .Col < Qslz Then
  2147.             Changelock = True
  2148.             .Select .Row, Qslz
  2149.             Changelock = False
  2150.         End If
  2151.     End With
  2153. End Sub
  2155. Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  2157.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  2158.     If Changelock Then
  2159.         Exit Sub
  2160.     End If
  2162.     '引发网格RowcolChange事件
  2163.     With WglrGrid
  2164.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  2165.             .Select 0, 0
  2166.         End If
  2167.     End With
  2169. End Sub
  2171. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
  2173.     If Gdtlock Then
  2174.         Exit Sub
  2175.     End If
  2176.  
  2177.     With WglrGrid
  2178.         If Ydtext.Visible Or YdCombo.Visible Then
  2179.             Gdtlock = True
  2180.             .TopRow = Dqtoprow
  2181.             .LeftCol = Dqleftcol
  2182.             Gdtlock = False
  2183.             Exit Sub
  2184.         End If
  2185.         HjGrid.LeftCol = .LeftCol
  2186.     End With
  2188. End Sub
  2190. Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  2191.     
  2192.     If Changelock Then
  2193.         Exit Sub
  2194.     End If
  2196.     '记录刚刚离开网格单元的行列值
  2197.     Dqlkwgh = WglrGrid.Row
  2198.     Dqlkwgl = WglrGrid.Col
  2200.     '判断是否需要录入数据回写
  2201.     If Not (Ydtext.Visible Or YdCombo.Visible) Then
  2202.         Exit Sub
  2203.     End If
  2204.     Call Lrsjhx
  2206. End Sub
  2208. Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
  2209.     Valilock = True       '屏蔽文本框失去焦点进行有效性判断
  2210.     If Trim(Lab_OperStatus) = "1" Then Exit Sub
  2211.     With WglrGrid
  2212.         If Changelock Then
  2213.             Exit Sub
  2214.         End If
  2215.         If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  2216.             Exit Sub
  2217.         End If
  2218.         If .Row <> Dqlkwgh Then
  2219.             If Not Sjhzyxxpd(Dqlkwgh) Then
  2220.                 Exit Sub
  2221.             End If
  2222.         End If
  2223.     End With
  2224.    
  2225.     Call fhyxh
  2226.     Call Xldql
  2227.    
  2228. End Sub
  2230. Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
  2231. If Trim(Lab_OperStatus) <> "3" Then
  2232.     If Trim(WglrGrid.TextMatrix(WglrGrid.Row, Sydz("000", GridStr(), Szzls))) <> "*" Then Exit Sub
  2233.     ChildID = WglrGrid.Row
  2234.     Stock_PurPlanDetail.Show 1
  2235. Else
  2236.     If Trim(WglrGrid.TextMatrix(WglrGrid.Row, Sydz("000", GridStr(), Szzls))) <> "*" Then
  2237.         Exit Sub
  2238.     Else
  2239.         If WglrGrid.Col < Sydz("005", GridStr, Szzls) Then
  2240.             ChildID = WglrGrid.Row
  2241.             Stock_PurPlanDetail.Show 1
  2242.         Else
  2243.             With WglrGrid
  2244.                 Call xswbk
  2245.             End With
  2246.         End If
  2247.     End If
  2248. End If
  2249.  
  2252. End Sub
  2254. Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
  2255.     
  2256.     Valilock = True
  2257.     Ydtext.Visible = False
  2258.     YdCombo.Visible = False
  2259.     Ydcommand.Visible = False
  2261. End Sub
  2263. Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  2264.     With WglrGrid
  2265.         Select Case KeyCode
  2266.             Case vbKeyEscape                'ESC 键放弃录入
  2267.                 Valilock = True
  2268.                 .SetFocus
  2269.                 Call Ycwbk
  2270.                 Valilock = False
  2271.             Case vbKeyReturn                '回 车 键 =13
  2272.                 KeyCode = 0
  2273.                 .SetFocus
  2274.                 Call Lrsjhx
  2275.                 Rowjsq = .Row
  2276.                 Coljsq = .Col + 1
  2277.                 If Coljsq > .Cols - 1 Then
  2278.                     If Rowjsq < .Rows - 1 Then
  2279.                         Rowjsq = Rowjsq + 1
  2280.                     End If
  2281.                     Coljsq = Qslz
  2282.                 End If
  2283.                 Do While Rowjsq <= .Rows - 1
  2284.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2285.                         Coljsq = Coljsq + 1
  2286.                         If Coljsq > .Cols - 1 Then
  2287.                             Rowjsq = Rowjsq + 1
  2288.                             Coljsq = Qslz
  2289.                         End If
  2290.                     Else
  2291.                         Exit Do
  2292.                     End If
  2293.                 Loop
  2294.                 .Select Rowjsq, Coljsq
  2295.             Case vbKeyLeft                  '左 箭 头 =37
  2296.                 If .Col - 1 = Qslz Then
  2297.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  2298.                         GoTo jzzx
  2299.                     End If
  2300.                 End If
  2301.                 If .Col > Qslz Then
  2302.                     KeyCode = 0
  2303.                     .SetFocus
  2304.                     Call Lrsjhx
  2305.                     Coljsq = .Col - 1
  2306.                     Do While Coljsq > Qslz
  2307.                         If Coljsq - 1 = Qslz Then
  2308.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  2309.                                 GoTo jzzx
  2310.                             End If
  2311.                         End If
  2312.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2313.                             Coljsq = Coljsq - 1
  2314.                         Else
  2315.                             Exit Do
  2316.                         End If
  2317.                     Loop
  2318.                     .Select .Row, Coljsq
  2319.                 End If
  2320.             Case vbKeyRight                 '右 箭 头 =39
  2321.                 KeyCode = 0
  2322.                 .SetFocus
  2323.                 Call Lrsjhx
  2324.                 Rowjsq = .Row
  2325.                 Coljsq = .Col + 1
  2326.                 If Coljsq > .Cols - 1 Then
  2327.                     If Rowjsq < .Rows - 1 Then
  2328.                         Rowjsq = Rowjsq + 1
  2329.                     End If
  2330.                     Coljsq = Qslz
  2331.                 End If
  2332.                 Do While Rowjsq <= .Rows - 1
  2333.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2334.                         Coljsq = Coljsq + 1
  2335.                         If Coljsq > .Cols - 1 Then
  2336.                             Rowjsq = Rowjsq + 1
  2337.                             Coljsq = Qslz
  2338.                         End If
  2339.                     Else
  2340.                         Exit Do
  2341.                     End If
  2342.                 Loop
  2343.                 .Select Rowjsq, Coljsq
  2344.         Case Else
  2345.    End Select
  2346.    
  2347. jzzx:
  2348.    
  2349.     End With
  2351. End Sub
  2353. Private Sub YdCombo_LostFocus()
  2354.   
  2355.     With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
  2356.         If Not Valilock Then                           '为TRUE
  2357.             Call Lrsjhx
  2358.             If Not Sjhzyxxpd(Dqlrwgh) Then
  2359.                 Exit Sub
  2360.             End If
  2361.         End If
  2362.     End With
  2364. End Sub
  2366. Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  2367.     Call Lrzdbz
  2368. End Sub
  2370. Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
  2371.     Dim Rowjsq As Long, Coljsq As Long
  2372.     With WglrGrid
  2373.         Select Case KeyCode
  2374.             Case vbKeyF2
  2375.                 Call Lrzdbz
  2376.             Case vbKeyEscape                'ESC 键放弃录入
  2377.                 Valilock = True
  2378.                 Call Ycwbk
  2379.                 .SetFocus
  2380.             Case vbKeyReturn                '回 车 键 =13
  2381.                 KeyCode = 0
  2382.                 .SetFocus
  2383.                 Call Lrsjhx
  2384.                 Rowjsq = .Row
  2385.                 Coljsq = .Col + 1
  2386.                 If Coljsq > .Cols - 1 Then
  2387.                     If Rowjsq < .Rows - 1 Then
  2388.                         Rowjsq = Rowjsq + 1
  2389.                     End If
  2390.                     Coljsq = Qslz
  2391.                 End If
  2392.                 Do While Rowjsq <= .Rows - 1
  2393.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2394.                         Coljsq = Coljsq + 1
  2395.                         If Coljsq > .Cols - 1 Then
  2396.                             Rowjsq = Rowjsq + 1
  2397.                             Coljsq = Qslz
  2398.                         End If
  2399.                     Else
  2400.                         Exit Do
  2401.                     End If
  2402.                 Loop
  2403.                 If Rowjsq <= .Rows - 1 Then
  2404.                     .Select Rowjsq, Coljsq
  2405.                 End If
  2406.             Case vbKeyUp                    '上 箭 头 =38
  2407.                 KeyCode = 0
  2408.                 .SetFocus
  2409.                 Call Lrsjhx
  2410.                 If .Row > .FixedRows Then
  2411.                     .Row = .Row - 1
  2412.                 End If
  2413.             Case vbKeyDown                  '下 箭 头 =40
  2414.                 KeyCode = 0
  2415.                 .SetFocus
  2416.                 Call Lrsjhx
  2417.                 If .Row < .Rows - 1 Then
  2418.                     .Row = .Row + 1
  2419.                 End If
  2420.             Case vbKeyLeft                  '左 箭 头 =37
  2421.                 If .Col - 1 = Qslz Then
  2422.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  2423.                         GoTo jzzx
  2424.                     End If
  2425.                 End If
  2426.                 If Ydtext.SelStart = 0 And .Col > Qslz Then
  2427.                     KeyCode = 0
  2428.                     .SetFocus
  2429.                     Call Lrsjhx
  2430.                     Coljsq = .Col - 1
  2431.                     Do While Coljsq > Qslz
  2432.                         If Coljsq - 1 = Qslz Then
  2433.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  2434.                                 GoTo jzzx
  2435.                             End If
  2436.                         End If
  2437.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2438.                             Coljsq = Coljsq - 1
  2439.                         Else
  2440.                             Exit Do
  2441.                         End If
  2442.                     Loop
  2443.                     .Select .Row, Coljsq
  2444.                 End If
  2445. jzzx:
  2446.             Case vbKeyRight                 '右 箭 头 =39
  2447.                 wblong = Len(Ydtext.Text)
  2448.                 If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
  2449.                     KeyCode = 0
  2450.                     .SetFocus
  2451.                     Call Lrsjhx
  2452.                     Rowjsq = .Row
  2453.                     Coljsq = .Col + 1
  2454.                     If Coljsq > .Cols - 1 Then
  2455.                         If Rowjsq < .Rows - 1 Then
  2456.                             Rowjsq = Rowjsq + 1
  2457.                         End If
  2458.                         Coljsq = Qslz
  2459.                     End If
  2460.                     Do While Rowjsq <= .Rows - 1
  2461.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2462.                             Coljsq = Coljsq + 1
  2463.                             If Coljsq > .Cols - 1 Then
  2464.                                 Rowjsq = Rowjsq + 1
  2465.                                 Coljsq = Qslz
  2466.                             End If
  2467.                         Else
  2468.                             Exit Do
  2469.                         End If
  2470.                     Loop
  2471.                     .Select Rowjsq, Coljsq
  2472.                 End If
  2473.             Case Else
  2474.         End Select
  2475.     End With
  2477. End Sub
  2479. Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  2480.     
  2481.     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  2482.     If KeyAscii <> 0 Then
  2483.         Call Xyxhbz(Dqlrwgh)
  2484.     End If
  2486. End Sub
  2488. Private Sub ydtext_Change()                              '录入事中变化处理
  2490.     '防止程序改变但不进行处理
  2492.     If Wbkbhlock Then
  2493.         Exit Sub
  2494.     End If
  2496.     With WglrGrid
  2497.         '限制字段录入长度
  2498.         Wbkbhlock = True
  2499.         Call TextChangeLimit(Ydtext, GridInt(.Col, 1))  '去掉无效字符
  2500.         Select Case GridInt(.Col, 1)
  2501.             Case 8, 11   '金额型
  2502.                 Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  2503.             Case 9, 12   '数量型
  2504.                 Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  2505.             Case 10      '单价型
  2506.                 Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  2507.             Case Else    '其他类型
  2508.                 If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  2509.                     Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  2510.                 End If
  2511.         End Select
  2512.         Wbkbhlock = False
  2513.     End With
  2515. End Sub
  2518. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  2519.     If Trim(Lab_OperStatus) = "1" Then Exit Sub
  2520.     With WglrGrid
  2521.         If Not Valilock Then
  2522.             Call Lrsjhx
  2523.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  2524.                 Exit Sub
  2525.             End If
  2526.             If Not Sjhzyxxpd(Dqlrwgh) Then
  2527.                 Exit Sub
  2528.             End If
  2529.         End If
  2530.     End With
  2532. End Sub
  2534. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  2535.     
  2536.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  2537.   
  2538.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  2539.     If Not Fun_AllowInput Then
  2540.         Exit Sub
  2541.     End If
  2542.   
  2543.     '显示文本框前返回有效行列（解决滚动条问题）
  2544.     Call Xldqh
  2545.     Call Xldql
  2546.   
  2547.     '隐藏文本框,帮助按钮,列表组合框
  2548.     Call Ycwbk
  2549.   
  2550.     With WglrGrid
  2551.         Dqlrwgh = .Row
  2552.         Dqlrwgl = .Col
  2553.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  2554.             Exit Sub
  2555.         End If
  2556.      
  2557.         Wbkpy = 30
  2558.         Wbkpy1 = 15
  2559.         On Error Resume Next
  2560.         If GridBoolean(.Col, 3) Then
  2561.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  2562.             YdCombo.Top = .CellTop + .Top + Wbkpy
  2563.             YdCombo.Width = .CellWidth - Wbkpy1
  2564.             Call Wbkcl
  2565.             YdCombo.Visible = True
  2566.             YdCombo.SetFocus
  2567.             Ydcommand.Visible = False
  2568.             Ydtext.Visible = False
  2569.         Else
  2570.             If GridBoolean(.Col, 2) Then
  2571.                 Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  2572.                 Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  2573.                 Ydcommand.Visible = True
  2574.             Else
  2575.                 Ydcommand.Visible = False
  2576.             End If
  2577.              
  2578.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  2579.             Ydtext.Top = .CellTop + .Top + Wbkpy
  2580.             If Ydcommand.Visible Then
  2581.                 If Sfblbzkd Then
  2582.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  2583.                 Else
  2584.                     Ydtext.Width = .CellWidth - Wbkpy1
  2585.                 End If
  2586.             Else
  2587.                 Ydtext.Width = .CellWidth - Wbkpy1
  2588.             End If
  2589.             Ydtext.Height = .CellHeight - Wbkpy1
  2590.         
  2591.             If GridInt(.Col, 2) <> 0 Then
  2592.                 Ydtext.MaxLength = GridInt(.Col, 2)
  2593.             Else
  2594.                 Ydtext.MaxLength = 3000
  2595.             End If
  2596.       
  2597.             Call Wbkcl
  2598.       
  2599.             Ydtext.Visible = True
  2600.             Ydtext.SetFocus
  2601.         End If
  2602.         Dqtoprow = .TopRow
  2603.         Dqleftcol = .LeftCol
  2604.         
  2605.         '重置锁值
  2606.         Valilock = False
  2607.         Wbkbhlock = False
  2608.     End With
  2610. End Sub
  2612. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  2613.    
  2614.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  2615.     If Trim(Lab_OperStatus.Caption) = "1" Then
  2616.         Exit Function
  2617.     End If
  2618.    
  2619.     '[>>
  2620.     
  2621.     '此处可以填写禁止文本框激活使单据处于录入状态的理由
  2622.    
  2623.     '<<]
  2624.    
  2625.     Fun_AllowInput = True
  2627. End Function
  2629. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  2630.                    
  2631.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  2632.     Wbkpy = 30
  2633.     Wbkpy1 = 15
  2634.     With WglrGrid
  2635.         If YdCombo.Visible Then
  2636.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  2637.             YdCombo.Top = .CellTop + .Top + Wbkpy
  2638.             YdCombo.Width = .CellWidth - Wbkpy1
  2639.         End If
  2640.         If Ydcommand.Visible Then
  2641.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  2642.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  2643.         End If
  2644.         If Ydtext.Visible Then
  2645.             If Ydcommand.Visible Then
  2646.                 If Sfblbzkd Then
  2647.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  2648.                 Else
  2649.                     Ydtext.Width = .CellWidth - Wbkpy1
  2650.                 End If
  2651.             Else
  2652.                 Ydtext.Width = .CellWidth - Wbkpy1
  2653.             End If
  2654.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  2655.             Ydtext.Top = .CellTop + .Top + Wbkpy
  2656.             Ydtext.Height = .CellHeight - Wbkpy1
  2657.         End If
  2658.     End With
  2660. End Sub
  2662. Private Sub Lrsjhx()                                                   '文本框录入数据回写
  2663.     
  2664.     With WglrGrid
  2665.         If YdCombo.Visible Then
  2666.             .Text = Trim(YdCombo.Text)
  2667.         End If
  2668.         If Ydtext.Visible Then
  2669.             .Text = Trim(Ydtext.Text)
  2670.         End If
  2671.         
  2672.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  2673.         If Zdlrqnr <> Trim(.Text) Then
  2674.             Yxxpdlock = False
  2675.             Hyxxpdlock = False
  2676.         End If
  2677.     
  2678.         '如果字段录入内容不为空则写数据行有效性标志
  2679.         If Len(Trim(.Text)) <> 0 Then
  2680.             Call Xyxhbz(.Row)
  2681.         End If
  2682.     
  2683.         '隐藏文本框,帮助按钮,列表组合框
  2684.         Call Ycwbk
  2685.     End With
  2687. End Sub
  2689. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行，删行快捷键
  2690.   
  2691.     '如果单据操作状态为浏览状态则不能显示录入载体
  2692.     If Trim(Lab_OperStatus.Caption) = "1" Then
  2693.         Exit Sub
  2694.     End If
  2696.     Select Case KeyCode
  2697.         Case vbKeyF2                   '按F2键参照
  2698.             Call xswbk
  2699.             Call Lrzdbz
  2701.     End Select
  2703. End Sub
  2705. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
  2707.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  2708.     If Not Fun_AllowInput Then
  2709.         Exit Sub
  2710.     End If
  2711.   
  2712.     With WglrGrid
  2713.         '屏 蔽 回 车 键
  2714.         If KeyAscii = vbKeyReturn Then
  2715.             KeyAscii = 0
  2716.             Rowjsq = .Row
  2717.             Coljsq = .Col + 1
  2718.             If Coljsq > .Cols - 1 Then
  2719.                 If Rowjsq < .Rows - 1 Then
  2720.                     Rowjsq = Rowjsq + 1
  2721.                 End If
  2722.                 Coljsq = Qslz
  2723.             End If
  2724.             Do While Rowjsq <= .Rows - 1
  2725.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  2726.                     Coljsq = Coljsq + 1
  2727.                     If Coljsq > .Cols - 1 Then
  2728.                         Rowjsq = Rowjsq + 1
  2729.                         Coljsq = Qslz
  2730.                     End If
  2731.                 Else
  2732.                     Exit Do
  2733.                 End If
  2734.             Loop
  2735.             If Rowjsq <= .Rows - 1 Then
  2736.                 .Select Rowjsq, Coljsq
  2737.             End If
  2738.             Exit Sub
  2739.         End If
  2740.         
  2741.         If Trim(WglrGrid.TextMatrix(WglrGrid.Row, Sydz("000", GridStr(), Szzls))) <> "*" Then Exit Sub
  2742.         
  2743.         '接受用户录入
  2744.         Select Case KeyAscii
  2745.             Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
  2746.                 '显示录入载体
  2747.                 Call xswbk
  2748.             Case Else
  2749.                 '防止非编辑字段SendKeys()出现死循环
  2750.                 If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  2751.                     Exit Sub
  2752.                 End If
  2753.                 '如果此字段为列表框录入则调入相应列表框
  2754.                 If GridBoolean(.Col, 3) Then
  2755.                     '列表框录入
  2756.                     Call xswbk
  2757.                 Else
  2758.                     Ydtext.Text = ""
  2759.                     '录入限制
  2760.                     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  2761.                     If KeyAscii = 0 Then
  2762.                         Exit Sub
  2763.                     End If
  2764.                     '如果录入字符有效则写有效行数据标志
  2765.                     Call Xyxhbz(.Row)
  2766.                     Call xswbk
  2767.                     Ydtext.Text = ""
  2768.                     Valilock = True
  2769.                     SendKeys Chr(KeyAscii), True
  2770.                     DoEvents
  2771.                     Valilock = False
  2772.                 End If
  2773.         End Select
  2774.     End With
  2776. End Sub
  2778. Private Sub zjlrfl()                                                    '增加录入分录
  2779.     
  2780.     With WglrGrid
  2781.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  2782.             If Not Fun_Drfrmyxxpd Then
  2783.                 Exit Sub
  2784.             End If
  2785.         Else
  2786.             Exit Sub
  2787.         End If
  2788.         If .Row < .FixedRows Then
  2789.             Exit Sub
  2790.         End If
  2791.         .AddItem "", .Row
  2792.         .RowHeight(.Row) = Sjhgd
  2793.         If .Row <> .Rows - 1 Then
  2794.             If .TextMatrix(.Row + 1, 0) = "*" Then
  2795.                 .TextMatrix(.Row, 0) = "*"
  2796.             Else
  2797.                 .RemoveItem .Rows - 1
  2798.             End If
  2799.         End If
  2800.         Call Xldqh
  2801.         Call Xldql
  2802.         Hyxxpdlock = False
  2803.     End With
  2805. End Sub
  2807. Private Sub Scdqfl()                                                    '删除当前分录
  2808.     Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean
  2809.     With WglrGrid
  2810.         Scqwghz = .Row
  2811.         Scqwglz = .Col
  2812.         If .TextMatrix(.Row, 0) = "*" Then
  2813.             '判断是否为录入状态
  2814.             If Ydtext.Visible Or YdCombo.Visible Then
  2815.                 Sflrzt = True
  2816.                 Validate = True
  2817.                 Call Lrsjhx
  2818.                 Validate = False
  2819.             End If
  2820.             Call Xldqh
  2821.             Changelock = True
  2822.             .Select .Row, 0
  2823.             Changelock = False
  2824.             If Shsfts Then
  2825.                 .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
  2826.                 Tsxx = "请确认是否删除当前记录?"
  2827.                 yhAnswer = Xtxxts(Tsxx, 2, 2)
  2828.                 If yhAnswer = 2 Then
  2829.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  2830.                     Changelock = True
  2831.                     .Select Scqwghz, Scqwglz
  2832.                     Changelock = False
  2833.                     
  2834.                     '如为录入状态,则恢复录入
  2835.                     If Sflrzt Then
  2836.                         Call xswbk
  2837.                     End If
  2838.                     Exit Sub
  2839.                 End If
  2840.             End If
  2841.             .RemoveItem .Row
  2842.             If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  2843.                 .AddItem ""
  2844.                 .RowHeight(.Rows - 1) = Sjhgd
  2845.             End If
  2846.             Changelock = True
  2847.             .Select .Row, Scqwglz
  2848.             Changelock = False
  2849.    
  2850.             '重新计算合计数据
  2851.             For Hjlzte = Qslz To .Cols - 1
  2852.                 Call Sjhj(Hjlzte)
  2853.             Next Hjlzte
  2854.         End If
  2855.     End With
  2857. End Sub
  2859. Private Sub Sjhj(Hjwgl As Long)                                         '网格列数据合计
  2860.     
  2861.     Dim Hjjg As Double
  2862.     If Not (GridBoolean(Hjwgl, 4) And HjGrid.Visible) Then
  2863.         Exit Sub
  2864.     End If
  2865.     With WglrGrid
  2866.         Hjjg = 0
  2867.         For jsqte = .FixedRows To .Rows - 1
  2868.             If .TextMatrix(jsqte, 0) = "*" Then
  2869.                 Hjjg = Hjjg + Val(.TextMatrix(jsqte, Hjwgl))
  2870.             End If
  2871.         Next jsqte
  2872.         If GridBoolean(Hjwgl, 5) And Hjjg = 0 Then
  2873.             HjGrid.TextMatrix(0, Hjwgl) = ""
  2874.         Else
  2875.             HjGrid.TextMatrix(0, Hjwgl) = Hjjg
  2876.         End If
  2877.     End With
  2879. End Sub
  2881. Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  2882.     
  2883.     If Not GridBoolean(Sjl, 5) Then
  2884.         Exit Sub
  2885.     End If
  2886.     With WglrGrid
  2887.         If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
  2888.             .TextMatrix(sjh, Sjl) = ""
  2889.         End If
  2890.     End With
  2892. End Sub
  2894. Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  2895.     
  2896.     With WglrGrid
  2897.         If .Row >= .FixedRows Then
  2898.             If .TextMatrix(.Row, 0) <> "*" Then
  2899.                 For Rowjsq = .FixedRows To .Rows - 1
  2900.                     If .TextMatrix(Rowjsq, 0) <> "*" Then
  2901.                         Exit For
  2902.                     End If
  2903.                 Next Rowjsq
  2904.                 If Rowjsq <= .Rows - 1 Then
  2905.                     Changelock = True
  2906.                     .Select Rowjsq, .Col
  2907.                     Changelock = False
  2908.                 Else
  2909.                     Changelock = True
  2910.                     .Select .Rows - 1, .Col
  2911.                     Changelock = False
  2912.                 End If
  2913.             End If
  2914.             Call Xldqh
  2915.         End If
  2916.   End With
  2917.   
  2918. End Sub
  2920. Private Sub Xldqh()                                                      '显露当前行
  2921.   
  2922.     Dim Toprowte As Long
  2923.     With WglrGrid
  2924.         Toprowte = 0
  2925.         Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
  2926.             Toprowte = .TopRow
  2927.             .TopRow = .TopRow + 1
  2928.         Loop
  2929.         Toprowte = 0
  2930.         Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
  2931.             Toprowte = .TopRow
  2932.             If .TopRow > 1 Then
  2933.                 .TopRow = .TopRow - 1
  2934.             End If
  2935.         Loop
  2936.     End With
  2938. End Sub
  2940. Private Sub Xldql()                                                     '显露当前列
  2941.     
  2942.     Dim Leftcolte As Long
  2943.     With WglrGrid
  2944.         If .Col >= Qslz And .Col >= .FixedCols Then
  2945.             If .LeftCol > .Col Then
  2946.                 .LeftCol = .Col
  2947.             End If
  2948.             Leftcolte = 0
  2949.             Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
  2950.                 Leftcolte = .LeftCol
  2951.                 .LeftCol = .LeftCol + 1
  2952.             Loop
  2953.         End If
  2954.     End With
  2956. End Sub
  2958. Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
  2959.     
  2960.     With WglrGrid
  2961.         For Coljsq = Qslz To .Cols - 1
  2962.             If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
  2963.                 pdhwk = False
  2964.                 Exit Function
  2965.             End If
  2966.         Next Coljsq
  2967.         pdhwk = True
  2968.     End With
  2970. End Function
  2972. Private Sub Xyxhbz(sjh As Long)                                         '写行有效性标志,并判断是否增行
  2973.     
  2974.     With WglrGrid
  2975.         If .TextMatrix(sjh, 0) = "*" Then
  2976.             Exit Sub
  2977.         End If
  2978.         .TextMatrix(sjh, 0) = "*"
  2979.         If sjh >= .Rows - Fzxwghs - 1 Then
  2980.             .AddItem ""
  2981.             .RowHeight(.Rows - 1) = Sjhgd
  2982.         End If
  2983.     End With
  2985. End Sub
  2987. '*****************************以下为文本框录入处理程序(固定不变部分)*******************************'
  2989. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  2991.     Dim Rect As New ADODB.Recordset
  2992.     '以下为依据实际情况自定义部分[
  2993.     
  2994.     '在此填写文本框录入事后处理程序
  2995.     Select Case Index
  2996.         Case 1                                  '产品物料编码
  2997.             Sqlstr = "Select * From Gy_Material Where MNumber='" & Trim(LrText(1)) & "'"
  2998.             Set Rect = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  2999.             If Not Rect.EOF Then
  3000.                 LrText(2).Text = Trim(Rect.Fields("MName") & "")
  3001.                 LrText(3).Text = Trim(Rect.Fields("Model") & "")
  3002.                 LrText(4).Text = Trim(Rect.Fields("PrimaryUnitName") & "")
  3003.             Else
  3004.                 LrText(2).Text = ""
  3005.                 LrText(3).Text = ""
  3006.                 LrText(4).Text = ""
  3007.             End If
  3008.             
  3009.     End Select
  3010.     ']以上为依据实际情况自定义部分
  3012. End Sub
  3014. Private Sub LrText_Change(Index As Integer)
  3016.     '屏蔽程序改变控制
  3017.     If TextChangeLock Then
  3018.         Exit Sub
  3019.     End If
  3020.    
  3021.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  3022.         
  3023.     '限制字段录入长度
  3024.           
  3025.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  3026.      Call TextChangeLimit(LrText(Index), Textint(Index, 1))  '去掉无效字符
  3027.         Select Case Textint(Index, 1)
  3028.             Case 8, 11       '金额型
  3029.                 Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  3030.             Case 9, 12       '数量型
  3031.                 Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  3032.             Case 10          '单价型
  3033.                 Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  3034.             Case Else        '其他小数类型控制
  3035.                 If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  3036.                     Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  3037.                 End If
  3038.         End Select
  3039.         
  3040.         TextChangeLock = False '解锁
  3041.      
  3042. End Sub
  3044. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  3045.     Call TextShow(Index)
  3046. End Sub
  3048. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  3049.     
  3050.     Select Case KeyCode
  3051.         Case vbKeyF2
  3052.             Call Text_Help(Index)
  3053.     End Select
  3055. End Sub
  3057. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  3058.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  3059. End Sub
  3061. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
  3062.     
  3063.     If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
  3064.         Call TextYxxpd(Index)
  3065.     End If
  3067. End Sub
  3069. Private Sub Ydcommand1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '点击按钮
  3070.     Call Text_Help(Ydcommand1.Tag)
  3071. End Sub
  3073. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  3074.     
  3075.     If Not Ydcommand1.Visible Then
  3076.         Exit Sub
  3077.     End If
  3078.     If LrText(Index).Enabled = False Then Exit Sub
  3079.     If LrText(Index).Locked = True Then Exit Sub
  3080.     TextValiLock = True
  3081.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  3082.     If Len(Xtfhcs) <> 0 Then
  3083.         If Textint(Index, 3) = 1 Then
  3084.             LrText(Index).Text = Xtfhcsfz
  3085.             LrText(Index).Tag = Xtfhcs
  3086.         Else
  3087.             LrText(Index).Text = Xtfhcs
  3088.             LrText(Index).Tag = Xtfhcsfz
  3089.         End If
  3090.     End If
  3091.     TextValiLock = False
  3092.     LrText(Index).SetFocus
  3094. End Sub
  3096. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  3098.     '如果文本框有帮助,则显示帮助按钮
  3099.     If LrText(Index).Enabled = False Or LrText(Index).Locked = True Then Exit Sub
  3100.     If Textboolean(Index, 1) Then
  3101.         Ydcommand1.Visible = True
  3102.         Ydcommand1.Move LrText(Index).Left + LrText(Index).Width, LrText(Index).Top
  3103.         Ydcommand1.Tag = Index
  3104.     Else
  3105.         Ydcommand1.Tag = ""
  3106.         Ydcommand1.Visible = False
  3107.     End If
  3108.     
  3109.     '[>>
  3110.     '可在此处定义其他处理动作
  3111.     '<<]
  3113. End Sub
  3115. Private Sub Wbkcsh()                          '录入文本框初始化
  3116.     Dim Int_TabIndex As Integer         'Tab焦点计数器
  3117.     '单据录入中文本框焦点由0开始
  3118.     LrText(0).TabIndex = 0
  3119.   
  3120.     '最大录入文本框索引值
  3121.     Max_Text_Index = Textvar(1)
  3122.   
  3123.     ReDim TextValiJudgeLock(Max_Text_Index)
  3124.     For jsqte = 0 To Max_Text_Index
  3125.         
  3126.         '判断此文本框录入索引号是否存在,如存在则对其进行初始化
  3127.         If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  3128.         
  3129.             '自动装入录入文本框和其解释标签
  3130.             If jsqte <> 0 Then
  3131.                 Load LrText(jsqte)
  3132.                 Load TsLabel(jsqte)
  3133.            
  3134.                 '判断录入文本框是否显示
  3135.                 If Textboolean(jsqte, 4) Then
  3136.                     LrText(jsqte).Visible = True
  3137.                     TsLabel(jsqte).Visible = True
  3138.                 Else
  3139.                     LrText(jsqte).Visible = False
  3140.                     TsLabel(jsqte).Visible = False
  3141.                 End If
  3142.             
  3143.                 '设置文本框焦点顺序值
  3144.                 LrText(jsqte).TabIndex = Textint(jsqte, 14)
  3145.            
  3146.                 '判断文本框是否可编辑
  3147.                 If Textboolean(jsqte, 5) Then
  3148.                     LrText(jsqte).Enabled = True
  3149.                 Else
  3150.                     LrText(jsqte).Enabled = False
  3151.                 End If
  3152.             End If
  3153.            
  3154.            '初始化其内容
  3155.             TextChangeLock = True
  3156.             LrText(jsqte).Text = ""
  3157.             LrText(jsqte).Tag = ""
  3158.             If Textint(jsqte, 5) <> 0 Then
  3159.                 LrText(jsqte).MaxLength = Textint(jsqte, 5)
  3160.             End If
  3161.             TextChangeLock = False
  3162.         
  3163.             '设置文本框位置及大小,并设置相应标签内容及其位置
  3164.             LrText(jsqte).Move Textint(jsqte, 13), Textint(jsqte, 12), Textint(jsqte, 11), Textint(jsqte, 10)
  3165.             TsLabel(jsqte).Caption = Textstr(jsqte, 7) & ":"
  3166.             TsLabel(jsqte).Move Textint(jsqte, 13) - TsLabel(jsqte).Width - 20, Textint(jsqte, 12) + (Textint(jsqte, 10) - TsLabel(jsqte).Height) / 2 - 30
  3167.             
  3168.         End If
  3169.      
  3170.         '将文本框有效性判断进行加锁,在文本框内容发生变化时将锁打开
  3171.         TextValiJudgeLock(jsqte) = True
  3172.       
  3173.     Next jsqte
  3174.     '设置文本框焦点转移顺序(前提文本焦点从0至Max_Text_Index)
  3175.     For Int_TabIndex = 0 To Max_Text_Index
  3176.         For jsqte = 0 To Max_Text_Index
  3177.             If Textint(jsqte, 14) = Int_TabIndex Then
  3178.                LrText(jsqte).TabIndex = Int_TabIndex
  3179.             End If
  3180.         Next jsqte
  3181.     Next Int_TabIndex
  3182. End Sub
  3184. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  3185.   
  3186.     Dim Sqlstr As String
  3187.     Dim Findrec As New ADODB.Recordset
  3188.   
  3189.     '按帮助不进行有效性判断
  3190.   
  3191.     If TextValiLock Then
  3192.         TextValiLock = False
  3193.         TextYxxpd = True
  3194.         Exit Function
  3195.     End If
  3196.   
  3197.     '文本框内容未曾改变不进行有效性判断
  3198.   
  3199.     If TextValiJudgeLock(Index) Then
  3200.         Ydcommand1.Visible = False
  3201.         TextYxxpd = True
  3202.         Exit Function
  3203.     End If
  3204.   
  3205.     '文本框内容为空认为有效,并清空其Tag值
  3206.   
  3207.     If Trim(LrText(Index)) = "" Then
  3208.         LrText(Index).Tag = ""
  3209.         Call Wbklrwbcl(Index)
  3210.         Ydcommand1.Visible = False
  3211.         TextValiJudgeLock(Index) = True
  3212.         TextYxxpd = True
  3213.         Exit Function
  3214.     End If
  3215.    
  3216.     '[>>
  3217.       
  3218.     '可在此加入不做有效性判断的理由(参照上面程序)
  3219.       
  3220.     '<<]
  3221.   
  3222.     Select Case Textint(Index, 4)
  3223.         Case 1      '编码型
  3224.             Sqlstr = Trim(Textstr(Index, 5))
  3225.             Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  3226.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  3227.             If Findrec.EOF Then
  3228.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  3229.                 LrText(Index).SetFocus
  3230.                 Exit Function
  3231.             Else
  3232.                 Select Case Textint(Index, 3)
  3233.                     Case 0
  3234.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  3235.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  3236.                         End If
  3237.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  3238.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  3239.                         End If
  3240.                     Case 1
  3241.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  3242.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  3243.                         End If
  3244.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  3245.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  3246.                         End If
  3247.                 End Select
  3248.             End If
  3249.         Case 2      '日期型
  3250.             If IsDate(LrText(Index).Text) Then
  3251.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  3252.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  3253.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  3254.                 End If
  3255.             Else
  3256.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  3257.                 Call Xtxxts(Tsxx, 0, 1)
  3258.                 LrText(Index).SetFocus
  3259.                 Exit Function
  3260.             End If
  3261.         Case 3      '其他类型
  3262.     End Select
  3263.     
  3264.     '隐藏帮助按钮
  3265.     Ydcommand1.Visible = False
  3266.    
  3267.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  3268.     TextValiJudgeLock(Index) = True
  3270.     '调用文本框事后处理程序
  3271.     Call Wbklrwbcl(Index)
  3272.    
  3273.     '有效性判断通过则返回True
  3274.     TextYxxpd = True
  3275. End Function