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

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

企业管理

开发平台：

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