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

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

企业管理

开发平台：

Visual Basic

-：源码内容
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Begin VB.Form Tr_ShipDeliver 
  4.    BackColor       =   &H00E9F4FA&
  5.    BorderStyle     =   3  'Fixed Dialog
  6.    Caption         =   "水运提货单"
  7.    ClientHeight    =   6315
  8.    ClientLeft      =   45
  9.    ClientTop       =   330
  10.    ClientWidth     =   10590
  11.    Icon            =   "水运管理_送货单.frx":0000
  12.    KeyPreview      =   -1  'True
  13.    LinkTopic       =   "Form2"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   6315
  17.    ScaleWidth      =   10590
  18.    ShowInTaskbar   =   0   'False
  19.    StartUpPosition =   1  '所有者中心
  20.    Begin VB.TextBox LrText 
  21.       ForeColor       =   &H00000000&
  22.       Height          =   300
  23.       Index           =   0
  24.       Left            =   1020
  25.       TabIndex        =   0
  26.       Text            =   "0"
  27.       Top             =   1500
  28.       Width           =   1650
  29.    End
  30.    Begin VB.CommandButton Ydcommand 
  31.       Height          =   300
  32.       Left            =   10680
  33.       Picture         =   "水运管理_送货单.frx":1042
  34.       Style           =   1  'Graphical
  35.       TabIndex        =   4
  36.       Top             =   990
  37.       Visible         =   0   'False
  38.       Width           =   300
  39.    End
  40.    Begin VB.TextBox Ydtext 
  41.       BackColor       =   &H80000018&
  42.       BorderStyle     =   0  'None
  43.       Height          =   330
  44.       Left            =   7710
  45.       MultiLine       =   -1  'True
  46.       TabIndex        =   3
  47.       Top             =   960
  48.       Visible         =   0   'False
  49.       Width           =   1185
  50.    End
  51.    Begin VB.Timer Timer1 
  52.       Interval        =   1
  53.       Left            =   9690
  54.       Top             =   150
  55.    End
  56.    Begin VB.CommandButton Ydcommand1 
  57.       Height          =   300
  58.       Left            =   10680
  59.       Picture         =   "水运管理_送货单.frx":13CC
  60.       Style           =   1  'Graphical
  61.       TabIndex        =   2
  62.       Top             =   600
  63.       Visible         =   0   'False
  64.       Width           =   300
  65.    End
  66.    Begin VB.ComboBox YdCombo 
  67.       Height          =   300
  68.       Left            =   9000
  69.       Style           =   2  'Dropdown List
  70.       TabIndex        =   1
  71.       Top             =   960
  72.       Visible         =   0   'False
  73.       Width           =   1155
  74.    End
  75.    Begin MSComctlLib.Toolbar Tlb_Action 
  76.       Align           =   1  'Align Top
  77.       Height          =   570
  78.       Left            =   0
  79.       TabIndex        =   5
  80.       Top             =   0
  81.       Width           =   10590
  82.       _ExtentX        =   18680
  83.       _ExtentY        =   1005
  84.       ButtonWidth     =   820
  85.       ButtonHeight    =   953
  86.       AllowCustomize  =   0   'False
  87.       Wrappable       =   0   'False
  88.       Appearance      =   1
  89.       Style           =   1
  90.       ImageList       =   "ImageList1"
  91.       _Version        =   393216
  92.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  93.          NumButtons      =   20
  94.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  95.             Caption         =   "打印"
  96.             Key             =   "dy"
  97.             Object.ToolTipText     =   "打印当前单据或Ctrl+P"
  98.             ImageKey        =   "dy"
  99.          EndProperty
  100.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  101.             Caption         =   "预览"
  102.             Key             =   "yl"
  103.             ImageKey        =   "yl"
  104.          EndProperty
  105.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  106.             Key             =   "fgh0"
  107.             Style           =   3
  108.          EndProperty
  109.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  110.             Caption         =   "新增"
  111.             Key             =   "xz"
  112.             Object.ToolTipText     =   "新增加一张单据或F5"
  113.             ImageKey        =   "xz"
  114.          EndProperty
  115.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  116.             Caption         =   "修改"
  117.             Key             =   "xg"
  118.             Object.ToolTipText     =   "修改当前单据或F3"
  119.             ImageKey        =   "xg"
  120.          EndProperty
  121.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  122.             Caption         =   "删除"
  123.             Key             =   "sc"
  124.             Object.ToolTipText     =   "删除当前单据"
  125.             ImageKey        =   "sc"
  126.          EndProperty
  127.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  128.             Key             =   "fgh1"
  129.             Style           =   3
  130.          EndProperty
  131.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  132.             Caption         =   "保存"
  133.             Key             =   "bc"
  134.             Object.ToolTipText     =   "保存单据或F6"
  135.             ImageKey        =   "bc"
  136.          EndProperty
  137.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  138.             Caption         =   "放弃"
  139.             Key             =   "fq"
  140.             Object.ToolTipText     =   "放弃此次操作"
  141.             ImageKey        =   "fq"
  142.          EndProperty
  143.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  144.             Key             =   "fgh3"
  145.             Style           =   3
  146.          EndProperty
  147.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  148.             Caption         =   "审核"
  149.             Key             =   "shsh"
  150.             ImageKey        =   "check"
  151.          EndProperty
  152.          BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  153.             Caption         =   "弃审"
  154.             Key             =   "shqs"
  155.             ImageKey        =   "qs"
  156.          EndProperty
  157.          BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  158.             Key             =   "fgh4"
  159.             Style           =   3
  160.          EndProperty
  161.          BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  162.             Caption         =   "首张"
  163.             Key             =   "first"
  164.             ImageKey        =   "first"
  165.          EndProperty
  166.          BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  167.             Caption         =   "上张"
  168.             Key             =   "prev"
  169.             ImageKey        =   "prev"
  170.          EndProperty
  171.          BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  172.             Caption         =   "下张"
  173.             Key             =   "next"
  174.             ImageKey        =   "next"
  175.          EndProperty
  176.          BeginProperty Button17 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  177.             Caption         =   "末张"
  178.             Key             =   "last"
  179.             ImageKey        =   "last"
  180.          EndProperty
  181.          BeginProperty Button18 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  182.             Key             =   "fgh5"
  183.             Style           =   3
  184.          EndProperty
  185.          BeginProperty Button19 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  186.             Caption         =   "帮助"
  187.             Key             =   "bz"
  188.             ImageKey        =   "bz"
  189.          EndProperty
  190.          BeginProperty Button20 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  191.             Caption         =   "退出"
  192.             Key             =   "fh"
  193.             ImageKey        =   "tc"
  194.          EndProperty
  195.       EndProperty
  196.       BorderStyle     =   1
  197.    End
  198.    Begin MSComctlLib.ImageList ImageList1 
  199.       Left            =   10410
  200.       Top             =   1350
  201.       _ExtentX        =   1005
  202.       _ExtentY        =   1005
  203.       BackColor       =   -2147483643
  204.       ImageWidth      =   16
  205.       ImageHeight     =   16
  206.       MaskColor       =   12632256
  207.       _Version        =   393216
  208.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  209.          NumListImages   =   37
  210.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  211.             Picture         =   "水运管理_送货单.frx":1756
  212.             Key             =   "sz"
  213.          EndProperty
  214.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  215.             Picture         =   "水运管理_送货单.frx":1AF0
  216.             Key             =   "dy"
  217.          EndProperty
  218.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  219.             Picture         =   "水运管理_送货单.frx":1E8A
  220.             Key             =   "yl"
  221.          EndProperty
  222.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  223.             Picture         =   "水运管理_送货单.frx":2224
  224.             Key             =   "xg"
  225.          EndProperty
  226.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  227.             Picture         =   "水运管理_送货单.frx":25BE
  228.             Key             =   "zh"
  229.          EndProperty
  230.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  231.             Picture         =   "水运管理_送货单.frx":2958
  232.             Key             =   "sh"
  233.          EndProperty
  234.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  235.             Picture         =   "水运管理_送货单.frx":2CF2
  236.             Key             =   "bc"
  237.          EndProperty
  238.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  239.             Picture         =   "水运管理_送货单.frx":308C
  240.             Key             =   "fq"
  241.          EndProperty
  242.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  243.             Picture         =   "水运管理_送货单.frx":3426
  244.             Key             =   "bz"
  245.          EndProperty
  246.          BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  247.             Picture         =   "水运管理_送货单.frx":37C0
  248.             Key             =   "tc"
  249.          EndProperty
  250.          BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  251.             Picture         =   "水运管理_送货单.frx":3B5A
  252.             Key             =   "bcgs"
  253.          EndProperty
  254.          BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  255.             Picture         =   "水运管理_送货单.frx":3EF4
  256.             Key             =   "mrlk"
  257.          EndProperty
  258.          BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  259.             Picture         =   "水运管理_送货单.frx":428E
  260.             Key             =   "xsxm"
  261.          EndProperty
  262.          BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  263.             Picture         =   "水运管理_送货单.frx":4628
  264.             Key             =   "first"
  265.          EndProperty
  266.          BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  267.             Picture         =   "水运管理_送货单.frx":49C2
  268.             Key             =   "prev"
  269.          EndProperty
  270.          BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  271.             Picture         =   "水运管理_送货单.frx":4D5C
  272.             Key             =   "next"
  273.          EndProperty
  274.          BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  275.             Picture         =   "水运管理_送货单.frx":50F6
  276.             Key             =   "last"
  277.          EndProperty
  278.          BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  279.             Picture         =   "水运管理_送货单.frx":5490
  280.             Key             =   "xx"
  281.          EndProperty
  282.          BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  283.             Picture         =   "水运管理_送货单.frx":582A
  284.             Key             =   "define"
  285.          EndProperty
  286.          BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  287.             Picture         =   "水运管理_送货单.frx":5BC4
  288.             Key             =   "exec"
  289.          EndProperty
  290.          BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  291.             Picture         =   "水运管理_送货单.frx":5F5E
  292.             Key             =   "xz"
  293.          EndProperty
  294.          BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  295.             Picture         =   "水运管理_送货单.frx":62F8
  296.             Key             =   "sc"
  297.          EndProperty
  298.          BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  299.             Picture         =   "水运管理_送货单.frx":6692
  300.             Key             =   "sx"
  301.          EndProperty
  302.          BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  303.             Picture         =   "水运管理_送货单.frx":6A2C
  304.             Key             =   "cx"
  305.          EndProperty
  306.          BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  307.             Picture         =   "水运管理_送货单.frx":6DC6
  308.             Key             =   "zd"
  309.          EndProperty
  310.          BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  311.             Picture         =   "水运管理_送货单.frx":7160
  312.             Key             =   "dz"
  313.          EndProperty
  314.          BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  315.             Picture         =   "水运管理_送货单.frx":74FA
  316.             Key             =   "ph"
  317.          EndProperty
  318.          BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  319.             Picture         =   "水运管理_送货单.frx":7894
  320.             Key             =   "fz"
  321.          EndProperty
  322.          BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  323.             Picture         =   "水运管理_送货单.frx":7C2E
  324.             Key             =   "dw"
  325.          EndProperty
  326.          BeginProperty ListImage30 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  327.             Picture         =   "水运管理_送货单.frx":7FC8
  328.             Key             =   "hf"
  329.          EndProperty
  330.          BeginProperty ListImage31 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  331.             Picture         =   "水运管理_送货单.frx":8362
  332.             Key             =   "pz"
  333.          EndProperty
  334.          BeginProperty ListImage32 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  335.             Picture         =   "水运管理_送货单.frx":86FC
  336.             Key             =   "check"
  337.          EndProperty
  338.          BeginProperty ListImage33 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  339.             Picture         =   "水运管理_送货单.frx":8A96
  340.             Key             =   "qs"
  341.          EndProperty
  342.          BeginProperty ListImage34 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  343.             Picture         =   "水运管理_送货单.frx":8E30
  344.             Key             =   "fullcheck"
  345.          EndProperty
  346.          BeginProperty ListImage35 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  347.             Picture         =   "水运管理_送货单.frx":91CA
  348.             Key             =   "qq"
  349.          EndProperty
  350.          BeginProperty ListImage36 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  351.             Picture         =   "水运管理_送货单.frx":9564
  352.             Key             =   "bcw"
  353.          EndProperty
  354.          BeginProperty ListImage37 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  355.             Picture         =   "水运管理_送货单.frx":98FE
  356.             Key             =   "ye"
  357.          EndProperty
  358.       EndProperty
  359.    End
  360.    Begin VB.Label Lab_Title 
  361.       AutoSize        =   -1  'True
  362.       BackColor       =   &H80000018&
  363.       BackStyle       =   0  'Transparent
  364.       Caption         =   "单据标题自动调整"
  365.       BeginProperty Font 
  366.          Name            =   "宋体"
  367.          Size            =   15
  368.          Charset         =   134
  369.          Weight          =   700
  370.          Underline       =   0   'False
  371.          Italic          =   0   'False
  372.          Strikethrough   =   0   'False
  373.       EndProperty
  374.       ForeColor       =   &H00000000&
  375.       Height          =   300
  376.       Left            =   4440
  377.       TabIndex        =   12
  378.       Top             =   840
  379.       Width           =   2520
  380.    End
  381.    Begin VB.Label Lab_BillId 
  382.       AutoSize        =   -1  'True
  383.       BackColor       =   &H0080C0FF&
  384.       Height          =   270
  385.       Left            =   7680
  386.       TabIndex        =   11
  387.       Top             =   600
  388.       Visible         =   0   'False
  389.       Width           =   2490
  390.    End
  391.    Begin VB.Label Lab_Djclzt 
  392.       BackColor       =   &H0000FFFF&
  393.       Caption         =   "1"
  394.       ForeColor       =   &H00808080&
  395.       Height          =   255
  396.       Left            =   10320
  397.       TabIndex        =   10
  398.       Top             =   600
  399.       Visible         =   0   'False
  400.       Width           =   285
  401.    End
  402.    Begin VB.Label Lab_OperStatus 
  403.       BackColor       =   &H000080FF&
  404.       Caption         =   "1"
  405.       Height          =   345
  406.       Left            =   10290
  407.       TabIndex        =   9
  408.       Top             =   960
  409.       Visible         =   0   'False
  410.       Width           =   345
  411.    End
  412.    Begin VB.Label Lab_Bill 
  413.       Appearance      =   0  'Flat
  414.       BackColor       =   &H80000005&
  415.       BackStyle       =   0  'Transparent
  416.       ForeColor       =   &H00000000&
  417.       Height          =   225
  418.       Left            =   9030
  419.       TabIndex        =   8
  420.       Top             =   6330
  421.       Width           =   735
  422.    End
  423.    Begin VB.Label Lab_Checker 
  424.       Appearance      =   0  'Flat
  425.       BackColor       =   &H80000005&
  426.       BackStyle       =   0  'Transparent
  427.       ForeColor       =   &H00000000&
  428.       Height          =   225
  429.       Left            =   7170
  430.       TabIndex        =   7
  431.       Top             =   6360
  432.       Width           =   735
  433.    End
  434.    Begin VB.Label TsLabel 
  435.       Alignment       =   1  'Right Justify
  436.       AutoSize        =   -1  'True
  437.       BackStyle       =   0  'Transparent
  438.       Caption         =   "单据号："
  439.       Height          =   180
  440.       Index           =   0
  441.       Left            =   240
  442.       TabIndex        =   6
  443.       Top             =   1560
  444.       Width           =   765
  445.    End
  446. End
  447. Attribute VB_Name = "Tr_ShipDeliver"
  448. Attribute VB_GlobalNameSpace = False
  449. Attribute VB_Creatable = False
  450. Attribute VB_PredeclaredId = True
  451. Attribute VB_Exposed = False
  452. '***********************************************************************************************************
  453. '*    模 块 名 称 :水运送货单
  454. '*    功 能 描 述 :
  455. '*    程序员姓名  :徐强
  456. '*    最后修改人  :徐强
  457. '*    最后修改时间:2001/12/6
  458. '*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
  459. '***********************************************************************************************************
  460.  
  461. '[以下为根据实际情况设置变量
  462. Dim Bln_BillChange As Boolean                   '标识单据是否发生改动
  463. Dim Rec_Query As New ADODB.Recordset            '单据组查询结果动态集(保存当前单据组ID)
  464. Public Str_QueryCondi As String                 '单据组查询条件(接收单据列表传递查询条件)
  465. Dim Str_RightEdit As String                     '单据编辑(新增、修改、删除)权限索引
  466. Dim Str_RightCheck As String                    '单据审核(审核、弃审)权限索引
  467. ']
  469. '以下为固定使用变量(单据)
  470. Dim BillCode As String                          '单据设计编码(索引号)
  471. Dim Var_Bill() As Variant                       '用来返回单据设计信息
  472. Dim ReportTitle As String                       '报表主标题
  473. Dim Tsxx As String                              '系统提示信息
  474. Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
  476. '以下为固定使用变量(文本框)
  477. Dim Textvar() As Variant                        '存储变体型文本框信息
  478. Dim Textboolean() As Boolean                    '存储布尔型文本框信息
  479. Dim Textint() As Integer                        '存储整型文本框信息
  480. Dim Textstr() As String                         '存储字符型文本框信息
  481. Dim Max_Text_Index As Integer                   '最大录入文本框索引值
  482. Dim TextGroupCode As String                     '文本框录入分组编码
  483. Dim TextValiLock As Boolean                     '文本框失去焦点是否进行有效性控制判断
  484. Dim TextValiJudgeLock() As Boolean              '文本框录入有效性判断控制锁
  485. Dim TextChangeLock As Boolean                   '文本框内容变换控制锁
  486.     
  487. Private Sub Form_KeyPress(KeyAscii As Integer)      '控 制 焦 点 转 移
  488.     
  489.     Dim jdzygs As Integer
  490.     jdzygs = 30                                      '在单据录入中,此焦点转移控制值一定小于等于文本框个数,否则网格回车键将不支持.
  491.     Select Case KeyAscii
  492.         Case vbKeyReturn
  493.             If Kjjdzy(jdzygs) Then
  494.                 KeyAscii = 0
  495.             End If
  496.         Case 39           '屏蔽字符"'"
  497.             KeyAscii = 0
  498.     End Select
  500. End Sub
  502. Private Sub Form_Load()                                                        '窗 体 装 入
  504.     '初始化各种锁值(Fixed)
  505.     Changelock = False             '网格行列改变控制锁
  506.     Gdtlock = False                '滚动条滚动控制
  507.     Yxxpdlock = True               '字段有效性判断锁
  508.     Hyxxpdlock = True              '行有效性判断锁
  509.     Wbkbhlock = False              '文本框内容改变锁
  510.     
  511.     '单据权限索引设置
  512.     Str_RightEdit = "tr_shipdeliver_edit"
  513.     Str_RightCheck = "tr_shipdeliver_check"
  514.     
  515.     '调入单据信息(需要修改BillCode)
  516.     BillCode = "1608"
  517.     Call Sub_ReadBillInfo(BillCode, Me, Var_Bill())
  518.     Lab_Title = Var_Bill(2)
  519.     Lab_Title.Move (Me.Width - Lab_Title.Width) / 2, 800
  520.     
  521.     '报表编码
  522.     XtReportCode = Var_Bill(5)
  523.     Load Dyymctbl
  524.   
  525.     '以下为文本框处理程序(Fixed)
  526.     TextGroupCode = Var_Bill(3)
  527.  
  528.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
  529.     Call Wbkcsh
  530.     '单据变动置为False(Fixed)
  531.     Bln_BillChange = False
  532.     
  533.     '调入数据初始化模块(Fixed)
  534.     Lab_Djclzt.Caption = Xtcdcs
  535.     Call Sjcsh(Trim(Lab_Djclzt.Caption))
  536.    
  537. End Sub
  539. Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
  540.     
  541.     '是否保存已修改单据
  542.     Dim YAnswer As Integer
  543.     If Lab_OperStatus.Caption = "2" Or Lab_OperStatus.Caption = "3" Then
  544.         Tsxx = "单据尚未保存,是否退出?"
  545.         YAnswer = Xtxxts(Tsxx, 2, 2)
  546.         If YAnswer <> 1 Then
  547.             Cancel = 1
  548.             Exit Sub
  549.         End If
  550.     End If
  551.     
  552.     '卸载打印页面窗体
  553.     Unload Dyymctbl
  554.  
  555.     '判断单据是否发生变化,并返回相应标识
  556.     If Bln_BillChange Then
  557.         Xtfhcs = "1"
  558.     Else
  559.         Xtfhcs = "0"
  560.     End If
  561.    
  562. End Sub
  564. Private Sub Sjcsh(Str_Pzclzt As String)              '数据初始化模块(根据实际情况)
  565.     
  566.     Dim Sqlstr As String       '查询单据列表条件
  568.     '[>>根据实际情况初始化
  569.     Select Case Str_Pzclzt
  570.         Case "1"   '填制单据
  571.             '调入用户查询结果动态集(默认显示用户当前操作业务日期的单据)
  572.             Sqlstr = "SELECT ShipDeliverid From Tr_ShipDeliver ORDER BY ShipDeliverId"
  573.             Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  574.       
  575.             '新增单据
  576.             Call Sub_AddBill
  577.         Case "2"   '查询单据(单据列表)
  578.         
  579.             '填充查询单据标识
  580.             Lab_BillId.Caption = XT_BillID
  581.             Str_QueryCondi = Xtcdcsfz
  582.                 
  583.             Call Sub_ShowBill
  584.             Call Sub_OperStatus("10")
  585.       
  586.             '调入用户查询结果动态集
  587.             Sqlstr = "SELECT DISTINCT ShipDeliverId From Tr_V_ShipDeliver a " & Str_QueryCondi & " ORDER BY ShipDeliverId"
  588.             Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  589.             Rec_Query.find "ShipDeliverId=" & Val(Lab_BillId.Caption)
  590.         Case "3"   '明细帐联查单据
  591.             '设置工具条显示
  592.             With Tlb_Action
  593.                 .Buttons("xz").Enabled = False             '新增
  594.                 .Buttons("xg").Enabled = False             '修改
  595.                 .Buttons("sc").Enabled = False             '删除
  596.                 .Buttons("fgh0").Enabled = False           '分隔行
  597.                 .Buttons("fgh1").Enabled = False           '分隔行
  598.                 .Buttons("bc").Enabled = False             '保存
  599.                 .Buttons("fq").Enabled = False             '放弃
  600.                 .Buttons("shsh").Enabled = False           '审核
  601.                 .Buttons("shqs").Enabled = False           '弃审
  602.                 .Buttons("fgh2").Enabled = False           '分隔行
  603.                 .Buttons("first").Enabled = False          '首张
  604.                 .Buttons("prev").Enabled = False           '上张
  605.                 .Buttons("next").Enabled = False           '下张
  606.                 .Buttons("last").Enabled = False           '末张
  607.                 .Buttons("fgh5").Enabled = False           '分割行
  608.             End With
  609.       
  610.             Call Sub_ShowBill
  611.       
  612.             '设置操作状态为浏览
  613.             Lab_OperStatus.Caption = "1"
  614.       
  615.             '录入文本框
  616.             For jsqte = Max_Text_Index To 0 Step -1
  617.                 LrText(jsqte).Enabled = False
  618.             Next jsqte
  619.     End Select
  620.   
  621.     '<<]
  622.   
  623. End Sub
  625. Private Sub Sub_ShowBill()                                          '根据当前单据ID显示整张单据内容
  626.    
  627.     '过程默认参数为当前窗体中单据ID:Lab_BillID
  628.     Dim Sqlstr As String                           '临时使用字符串
  629.     Dim RecTemp As New ADODB.Recordset             '临时使用动态集
  630.     Dim jsqte As Long                             '临时计数器
  632.     '禁止网格刷新动作,为加快网格显示速度(Fixed)
  633.     '本张单据查询字符串
  634.     Sqlstr = "select * from tr_v_ShipDeliver Where ShipDeliverId='" & Val(Lab_BillId.Caption) & "' Order By ShipDeliverId"
  635.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  636.       
  637.     With RecTemp
  638.             '[>>显示单据头
  639.         If Not .EOF Then
  640.         TextChangeLock = True     '文本框加锁
  641.         LrText(0).Text = Format(.Fields("ShipDeliverDate"), "yyyy-mm-dd")   '日期
  642.         LrText(1).Text = Trim(.Fields("ShipDelivernum"))          '提货单号
  643.         LrText(2).Text = Trim(.Fields("ldgnum") & "")             '货源单位名称
  644.         LrText(3).Tag = Trim(.Fields("sellcustcode"))             '客户编码
  645.         LrText(3).Text = Trim(.Fields("sellcustname"))            '客户名称
  646.         LrText(4).Text = Trim(.Fields("address") & "")            '地址
  647.         LrText(5).Text = Trim(.Fields("phone"))                   '联系方式
  648.         LrText(6).Text = Trim(.Fields("person") & "")             '联系人
  649.         LrText(7).Text = Trim(.Fields("mnumber"))                 '货物编码
  650.         LrText(8).Text = Trim(.Fields("mname") & "")              '货物名称
  651.         LrText(9).Text = Trim(.Fields("model") & "")              '规格
  652.         LrText(10).Text = Trim(.Fields("goodsgroup"))             '批次
  653.         LrText(11).Text = Trim(.Fields("quantity") & "")          '吨位
  654.         LrText(12).Text = Trim(.Fields("price") & "")             '单价
  655.         LrText(13).Text = Trim(.Fields("boxnum") & "")            '箱量
  656.         LrText(14).Text = Trim(.Fields("watcherman") & "")        '监装人
  657.         LrText(15).Text = Trim(.Fields("sendman") & "")           '发货人
  658.         LrText(16).Tag = Trim(.Fields("receivecode") & "")        '承运单位编码
  659.         LrText(16).Text = Trim(.Fields("trancompanyname") & "")   '承运单位名称
  660.         LrText(17).Text = IIf(.Fields("upboxdate") & "" = "", "", Format(.Fields("upboxdate"), "yyyy-mm-dd")) '装箱日期
  661.         LrText(18).Text = IIf(.Fields("startdate") & "" = "", "", Format(.Fields("startdate"), "yyyy-mm-dd")) '开船日期
  662.         LrText(19).Text = IIf(.Fields("returndate") & "" = "", "", Format(.Fields("returndate"), "yyyy-mm-dd")) '回单日期
  663.         LrText(20).Text = Trim(.Fields("shipway") & "")           '船名航次
  664.         LrText(21).Text = Trim(.Fields("carrynum") & "")          '运单号
  665.         LrText(22).Text = Trim(.Fields("Remark") & "")            '备注
  666.         LrText(23).Text = Trim(.Fields("Maker") & "")             '制单人
  667.         LrText(24).Text = Trim(.Fields("Checker") & "")           '审核人
  668.         TextChangeLock = False    '文本框解锁
  669.         End If
  670.     End With
  671.        
  672.     '设置审核弃审按钮状态
  673.     Call Sub_CheckStatus
  674.        
  675. End Sub
  677. Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
  678.      
  679.     '屏蔽文本框,下拉组合框有效性判断
  680.     Valilock = True
  681.      
  682.     '屏蔽网格失去焦点产生的有效性判断
  683.     Changelock = True
  684.        
  685.     Select Case Button.Key
  686.         Case "yl"                                            '预 览
  687.             BillTextPrint Lab_Title, LrText, TextGroupCode, XtReportCode, False
  688.         Case "dy"                                            '打 印
  689.             Dim yhAnswer As Integer      '打印提示
  690.             
  691.             '用户确认是否打印单据
  692.             Tsxx = "请确认是否打印当前单据?"
  693.             yhAnswer = Xtxxts(Tsxx, 2, 2)
  694.             If yhAnswer = 2 Then
  695.                 Exit Sub
  696.             End If
  697.             BillTextPrint Lab_Title, LrText, TextGroupCode, XtReportCode, True
  698.         Case "xz"                                            '新 增
  699.             Call Sub_AddBill
  700.         Case "xg"                                            '修 改
  701.             Call Sub_EditBill
  702.         Case "sc"                                            '删 除
  703.             Call Sub_DeleteBill
  704.         Case "bc"                                            '保 存
  705.             Call Sub_SaveBill
  706.         Case "fq"                                            '放 弃
  707.             Call Sub_AbandonBill
  708.         Case "shsh"                                          '审 核
  709.             Call Sub_CheckBill
  710.         Case "shqs"                                          '弃 审
  711.             Call Sub_AbandonCheck
  712.         Case "first"                                         '首 张
  713.             Call Sub_First
  714.         Case "prev"                                          '上 张
  715.             Call Sub_Prev
  716.         Case "next"                                          '下 张
  717.             Call Sub_Next
  718.         Case "last"                                          '末 张
  719.             Call Sub_Last
  720.         Case "bz"                                            '帮 助
  721.             Call F1bz
  722.         Case "fh"                                            '退 出
  723.             Unload Me
  724.     End Select
  725.        
  726.     '解 锁
  727.     Valilock = False
  728.     Changelock = False
  729.     TextChangeLock = False
  730.         
  731. End Sub
  733. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)     '支持热键操作
  734.     
  735.     Select Case KeyCode
  736.         Case vbKeyF5          '增加单据
  737.             If Tlb_Action.Buttons("xz").Enabled And Tlb_Action.Buttons("xz").Visible Then
  738.                 Call Sub_AddBill
  739.             End If
  740.         Case vbKeyF3          '修改单据
  741.             If Tlb_Action.Buttons("xg").Enabled And Tlb_Action.Buttons("xg").Visible Then
  742.                 Call Sub_EditBill
  743.             End If
  744.         Case vbKeyF6          '保存单据
  745.             If Tlb_Action.Buttons("bc").Enabled And Tlb_Action.Buttons("bc").Visible Then
  746.                 Call Sub_SaveBill
  747.             End If
  748.     End Select
  750. End Sub
  752. Private Sub Sub_OperStatus(Str_Status As String)                 '工具条依据不同状态所进行的变化
  753.   
  754.     With Tlb_Action
  755.         Select Case Str_Status
  756.             Case "10"   '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
  757.                 '工具条
  758.                 .Buttons("dy").Enabled = True       '打印
  759.                 .Buttons("yl").Enabled = True       '预览
  760.                 .Buttons("xz").Enabled = True       '新增
  761.                 .Buttons("xg").Enabled = True       '修改
  762.                 .Buttons("sc").Enabled = True       '删除
  763.                 .Buttons("bc").Enabled = False      '保存
  764.                 .Buttons("fq").Enabled = False      '放弃
  765.                 .Buttons("first").Enabled = True    '首张
  766.                 .Buttons("prev").Enabled = True     '上张
  767.                 .Buttons("next").Enabled = True     '下张
  768.                 .Buttons("last").Enabled = True     '末张
  769.                 .Buttons("bz").Enabled = True       '帮助
  770.                 .Buttons("fh").Enabled = True       '退出
  771.                 
  772.                 '设置审核弃审按钮状态
  773.                 Call Sub_CheckStatus
  774.                 
  775.                 '设置文本框录入状态
  776.                 Call Sub_LrtextStatus(False)
  777.             Case "20"   '新增单据(（录入）新增一张单据 、（列表）新增一张单据)
  778.                  '工具条
  779.                  .Buttons("dy").Enabled = False      '打印
  780.                  .Buttons("yl").Enabled = False      '预览
  781.                  .Buttons("xz").Enabled = False      '新增
  782.                  .Buttons("xg").Enabled = False      '修改
  783.                  .Buttons("sc").Enabled = False      '删除
  784.                  .Buttons("bc").Enabled = True       '保存
  785.                  .Buttons("fq").Enabled = True       '放弃
  786.                  .Buttons("shsh").Enabled = False    '审核
  787.                  .Buttons("shqs").Enabled = False    '弃审
  788.                  .Buttons("first").Enabled = False   '首张
  789.                  .Buttons("prev").Enabled = False    '上张
  790.                  .Buttons("next").Enabled = False    '下张
  791.                  .Buttons("last").Enabled = False    '末张
  792.                  .Buttons("bz").Enabled = True       '帮助
  793.                  .Buttons("fh").Enabled = True       '退出
  794.                  
  795.                  '设置文本框录入状态
  796.                  Call Sub_LrtextStatus(True)
  797.             Case "30"   '修改(（录入）调入修改功能、（列表）调入修改功能)
  798.                 '工具条
  799.                 .Buttons("dy").Enabled = False      '打印
  800.                 .Buttons("yl").Enabled = False      '预览
  801.                 .Buttons("xz").Enabled = False      '新增
  802.                 .Buttons("xg").Enabled = False      '修改
  803.                 .Buttons("sc").Enabled = False      '删除
  804.                 .Buttons("bc").Enabled = True       '保存
  805.                 .Buttons("fq").Enabled = True       '放弃
  806.                 .Buttons("shsh").Enabled = False    '审核
  807.                 .Buttons("shqs").Enabled = False    '弃审
  808.                 .Buttons("first").Enabled = False   '首张
  809.                 .Buttons("prev").Enabled = False    '上张
  810.                 .Buttons("next").Enabled = False    '下张
  811.                 .Buttons("last").Enabled = False    '末张
  812.                 .Buttons("bz").Enabled = True       '帮助
  813.                 .Buttons("fh").Enabled = True       '退出
  814.                 
  815.                 '设置文本框录入状态
  816.                 Call Sub_LrtextStatus(True)
  817.                 LrText(0).Enabled = False
  818.                 LrText(2).SetFocus
  819.         End Select
  820.     End With
  821.     
  822. End Sub
  824. Private Sub Sub_LrtextStatus(TextEnabled As Boolean)                            '设置录入文本框状态
  826.     '录入文本框状态设置
  827.     If TextEnabled Then
  828.         For jsqte = Max_Text_Index To 0 Step -1
  829.             '判断文本框是否可编辑
  830.             If Textboolean(jsqte, 5) Then
  831.                 LrText(jsqte).Enabled = True
  832.             Else
  833.                 LrText(jsqte).Enabled = False
  834.             End If
  835.         Next jsqte
  836.     Else
  837.         For jsqte = Max_Text_Index To 0 Step -1
  838.             LrText(jsqte).Enabled = False
  839.         Next jsqte
  840.     End If
  842. End Sub
  844. Private Sub Sub_CheckStatus()                                       '设置审核弃审按钮状态(亦可设置其他动作按钮状态)
  845.     
  846.     '根据当前单据状态来确定审核弃审按钮状态
  847.     If Trim(LrText(23).Text) <> "" And Trim(LrText(24).Text) = "" Then
  848.         Tlb_Action.Buttons("shsh").Enabled = True      '审核
  849.     Else
  850.         Tlb_Action.Buttons("shsh").Enabled = False   '审核
  851.     End If
  852.     If Trim(LrText(23).Text) <> "" And Trim(LrText(24).Text) <> "" Then
  853.         Tlb_Action.Buttons("shqs").Enabled = True      '弃审
  854.     Else
  855.         Tlb_Action.Buttons("shqs").Enabled = False   '弃审
  856.     End If
  858. End Sub
  860. Private Sub Sub_AddBill()                                                '新增一张单据
  861.     
  862.     Dim RecTemp As New ADODB.Recordset            '临时使用动态集
  863.     Dim jsqte As Long                            '临时计数器
  864.     Dim Sqlstr As String
  865.      
  866.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  867.      If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  868.         Exit Sub
  869.      End If
  870.           
  871.     '设置操作状态为新增(Fixed)
  872.     Lab_OperStatus.Caption = "2"
  873.        
  874.     '设置工具条状态(Fixed)
  875.     Call Sub_OperStatus("20")
  876.    
  877.     '清空VouchID(Fixed)
  878.     Lab_BillId.Caption = ""
  879.       
  880.     '录入文本框清除内容
  881.     For jsqte = Max_Text_Index To 0 Step -1
  882.         LrText(jsqte).Tag = ""
  883.         LrText(jsqte).Text = ""
  884.     Next jsqte
  885.     '[>>显示制单人,清空审核人,此处还可以设置录入默认值如自动生成单据号、默认单据录入日期注意加锁
  886.     TextChangeLock = True
  887.     LrText(0).Text = Format(Xtrq, "yyyy-mm-dd")
  888.     '读取最新的单据编码
  889.     LrText(1).Text = CreatBillCode(BillCode, False)
  890.     LrText(23).Text = Xtczy
  891.     LrText(24).Text = ""
  892.     TextChangeLock = False
  893.    
  894.     '<<]
  895.     '让第一个录入项得到焦点(Fixed)
  896.     On Error Resume Next
  897.     LrText(0).SetFocus
  898.    
  899. End Sub
  901. Private Sub Sub_EditBill()                                                '修改一张单据
  902.    
  903.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  904.      
  905.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  906.      If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  907.         Exit Sub
  908.      End If
  909.           
  910.     '非有效单据不予进行修改动作
  911.     If Val(Lab_BillId.Caption) = 0 Then
  912.         Exit Sub
  913.     End If
  914.    
  915.     '判断当前单据是否允许修改
  916.     If Not Fun_AllowEdit Then
  917.         Exit Sub
  918.     End If
  919.    
  920.     '设置操作状态为修改
  921.     Lab_OperStatus.Caption = "3"
  922.    
  923.     '设置工具条状态
  924.     Call Sub_OperStatus("30")
  925.         
  926.     '显示制单人
  927.     LrText(23).Text = Xtczy
  928.    
  929. End Sub
  931. Private Sub Sub_DeleteBill()                                               '删除当前单据
  932.     Dim YAnswer As Integer               '确认是否删除当前单据
  933.     Dim jsqte As Long                   '临时使用计数器
  934.      
  935.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  936.      If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  937.         Exit Sub
  938.      End If
  939.           
  940.     '非有效单据不予进行删除动作
  941.     If Val(Lab_BillId.Caption) = 0 Then
  942.         Exit Sub
  943.     End If
  944.    
  945.     Tsxx = "请确认是否删除当前单据?"
  946.     YAnswer = Xtxxts(Tsxx, 2, 2)
  947.    
  948.     If YAnswer = 1 Then
  949.    
  950.         '判断当前单据是否允许删除
  951.         If Not Fun_AllowEdit Then
  952.             Exit Sub
  953.         End If
  954.       
  955.         '进行事务处理
  956.         On Error GoTo Swcwcl
  957.         Cw_DataEnvi.DataConnect.BeginTrans
  958.    
  959.         '1.删除单据所有内容
  960.         Cw_DataEnvi.DataConnect.Execute ("Delete Tr_ShipDeliver Where ShipDeliverId=" & Val(Lab_BillId.Caption))
  961.         Cw_DataEnvi.DataConnect.CommitTrans
  962.       
  963.         '标识单据发生改动
  964.         Bln_BillChange = True
  965.   
  966.         '单据ID置0
  967.         Lab_BillId.Caption = 0
  968.     Else
  969.         Exit Sub
  970.     End If
  971.     
  972.    '删除单据后重置状态
  973.         
  974.     '1.显示下一张单据
  975.     Call Sub_Next
  976.         
  977.     '2.如果无下一张单据则搜索上一张单据
  978.     If Val(Lab_BillId.Caption) = 0 Then
  979.         Call Sub_Prev
  980.     End If
  981.         
  982.     '3.如无单据则置单据为空状态
  983.     If Val(Lab_BillId.Caption) = 0 Then
  984.         '清除录入文本框
  985.         For jsqte = Max_Text_Index To 0 Step -1
  986.             LrText(jsqte).Tag = ""
  987.             LrText(jsqte).Text = ""
  988.         Next jsqte
  989.         '设置操作状态为浏览
  990.         Lab_OperStatus = "1"
  991.         Call Sub_OperStatus("10")
  992.     End If
  994.     Rec_Query.Requery
  995.     Rec_Query.find "ShipDeliverId=" & Val(Lab_BillId.Caption)
  996.     Exit Sub
  997.    
  998. Swcwcl:          '单据删除时出现错误
  999.     Cw_DataEnvi.DataConnect.RollbackTrans
  1000.     Tsxx = "单据删除过程中出现未知错误,程序自动恢复保存前状态!"
  1001.     Call Xtxxts(Tsxx, 0, 1)
  1002.     Exit Sub
  1004. End Sub
  1006. Private Sub Sub_AbandonBill()                                              '放弃对当前单据的操作
  1007.  
  1008.     Dim jsqte As Long                   '临时使用计数器
  1009.   
  1010.     '先关闭录入载体(Fixed)
  1011.     Changelock = True
  1012.     Valilock = True
  1013.     Changelock = False
  1014.     Valilock = False
  1016.     '如果单据有效则重新显示当前单据,置单据为空状态
  1017.     If Not Rec_Query.EOF Then
  1018.         Lab_BillId.Caption = Rec_Query.Fields("ShipDeliverId")
  1019.         Call Sub_ShowBill
  1020.     Else
  1021.         '单据ID置为0
  1022.         Lab_BillId.Caption = 0
  1023.      
  1024.         '清除录入文本框
  1025.         For jsqte = Max_Text_Index To 0 Step -1
  1026.             LrText(jsqte).Tag = ""
  1027.             LrText(jsqte).Text = ""
  1028.         Next jsqte
  1030.     End If
  1031.     
  1032.     '设置操作状态为浏览
  1033.     Lab_OperStatus = "1"
  1034.     Call Sub_OperStatus("10")
  1036. End Sub
  1038. Private Function Sub_SaveBill() As Boolean                                   '保 存 单 据
  1039.   
  1040.     Dim RecTemp As New ADODB.Recordset                    '临时使用动态集
  1041.     Dim Rec_VouchMain As New ADODB.Recordset              '单据主表动态集
  1042.     Dim Rec_VouchSub As New ADODB.Recordset               '单据子表动态集
  1043.     Dim Rowjsq As Long                                    '网格行计数器
  1044.     Dim Coljsq As Long                                    '网格列计数器
  1045.     Dim jsqte As Integer                                 '临时计数器
  1046.     Dim Lng_RowCount As Long                              '有效数据行计数器
  1047.     Dim Lrywlz As Long                                    '录入有误列值
  1048.     
  1049.     Sub_SaveBill = False
  1050.   
  1051.     '一.============先对单据内容进行有效性判断==============='
  1052.     '对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
  1053.     For jsqte = 0 To Max_Text_Index
  1054.         If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
  1055.             If Not TextYxxpd(jsqte) Then
  1056.                 Call TextShow(jsqte)
  1057.                 Exit Function
  1058.             End If
  1059.         End If
  1060.     Next jsqte
  1061.     '先进行字段不能为空或不能为零有效性判断(Fixed)
  1062.     For jsqte = 0 To Max_Text_Index
  1063.         If Textint(jsqte, 8) = 1 Then     '字段不能为空
  1064.             If Len(Trim(LrText(jsqte).Text)) = 0 Then
  1065.                 Tsxx = Textstr(jsqte, 7) & "不能为空!"
  1066.                 Call Xtxxts(Tsxx, 0, 1)
  1067.                 LrText(jsqte).SetFocus
  1068.                 Exit Function
  1069.             End If
  1070.         Else
  1071.             If Textint(jsqte, 8) = 2 Then   '字段不能为零
  1072.                 If Val(Trim(LrText(jsqte).Text)) = 0 Then
  1073.                     Tsxx = Textstr(jsqte, 7) & "不能为零!"
  1074.                     Call Xtxxts(Tsxx, 0, 1)
  1075.                     LrText(jsqte).SetFocus
  1076.                     Exit Function
  1077.                 End If
  1078.             End If
  1079.         End If
  1080.     Next jsqte
  1081.     
  1082.     If IsDate(LrText(17)) And LrText(17) > LrText(18) Then
  1083.         Tsxx = "装箱日期不能大于开船日期!"
  1084.         Call Xtxxts(Tsxx, 0, 1)
  1085.         LrText(17).SetFocus
  1086.         Exit Function
  1087.     End If
  1088.     
  1089.     If IsDate(LrText(19)) And LrText(18) > LrText(19) Then
  1090.         Tsxx = "开船日期不能大于回单日期!"
  1091.         Call Xtxxts(Tsxx, 0, 1)
  1092.         LrText(18).SetFocus
  1093.         Exit Function
  1094.     End If
  1095.     
  1096.     '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
  1097.    
  1098.     '对存盘进行事务处理(Fixed)
  1099.     On Error GoTo Swcwcl
  1100.     Cw_DataEnvi.DataConnect.BeginTrans
  1101.     
  1102.     '判断单据状态以进行不同处理
  1103.     
  1104.     '1.先对单据主表进行处理
  1105.     If Trim(Lab_OperStatus) = "2" Then
  1106.     
  1107.         '新增单据
  1108.         
  1109.         '1.对于某些单据号自动生成的单据则可在此处自动生成
  1110.          LrText(1).Text = CreatBillCode(BillCode, True)
  1111.     
  1112.         '2.开始存盘
  1113.          
  1114.         '打开单据主表动态集
  1115.         If Rec_VouchMain.State = 1 Then Rec_VouchMain.Close
  1116.         Rec_VouchMain.Open "Select * From Tr_ShipDeliver Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1117.              
  1118.         With Rec_VouchMain
  1119.             .AddNew
  1120.             .Fields("ShipdeliverId") = CreatBillID(BillCode)
  1121.             .Fields("ShipdeliverDate") = CDate(LrText(0).Text)    '开票日期
  1122.             .Fields("ShipDelivernum") = Trim(LrText(1).Text)      '水运单号
  1123.             .Fields("ldgnum") = Trim(LrText(2))                   '销售发货单号
  1124.             .Fields("sellcustcode") = Trim(LrText(3).Tag)         '客户编码
  1125.             .Fields("sellcustname") = Trim(LrText(3))
  1126.             .Fields("address") = Trim(LrText(4))                  '地址
  1127.             .Fields("phone") = Trim(LrText(5))                    '联系方式
  1128.             .Fields("person") = Trim(LrText(6))                   '联系人
  1129.             .Fields("Mnumber") = Trim(LrText(7))                  '货物编码
  1130.             .Fields("goodsgroup") = Trim(LrText(10))              '批次
  1131.             .Fields("quantity") = Trim(LrText(11))                '吨位
  1132.             .Fields("price") = Trim(LrText(12))                   '单价
  1133.             .Fields("boxnum") = Val(LrText(13))                   '箱量
  1134.             .Fields("watcherman") = Trim(LrText(14))              '监装人
  1135.             .Fields("sendman") = Trim(LrText(15))                 '发货人
  1136.             .Fields("receivecode") = Trim(LrText(16).Tag)         '承运单位
  1137.             If IsDate(Trim(LrText(17))) Then                      '装箱日期
  1138.                 .Fields("upboxdate") = Trim(LrText(17))
  1139.             Else
  1140.                 .Fields("upboxdate") = Null
  1141.             End If
  1142.             .Fields("startdate") = Trim(LrText(18))               '开船日期
  1143.             If IsDate(LrText(19)) Then                            '回单日期
  1144.                 .Fields("returndate") = Trim(LrText(19))
  1145.             Else
  1146.                 .Fields("returndate") = Null
  1147.             End If
  1148.             .Fields("shipway") = Trim(LrText(20))                 '船名船号
  1149.             .Fields("carrynum") = Trim(LrText(21))                '运单号
  1150.             .Fields("remark") = Trim(LrText(22))                  '备注
  1151.             .Fields("maker") = Xtczy                              '制单人
  1152.             .Fields("Checker") = ""                               '审核人置空
  1153.             .Update
  1154.             '系统读出单据ID写入Lab_BillID
  1155.             Lab_BillId.Caption = .Fields("ShipDeliverId")
  1156.         End With
  1157.     Else
  1158.         '修改单据
  1159.         '打开单据主表动态集
  1160.         If Rec_VouchMain.State = 1 Then Rec_VouchMain.Close
  1161.         Rec_VouchMain.Open "Select * From Tr_ShipDeliver  Where ShipDeliverId=" & Val(Lab_BillId.Caption), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1162.         With Rec_VouchMain
  1163.             .Fields("ShipdeliverDate") = CDate(LrText(0).Text)    '开票日期
  1164.             .Fields("ShipDelivernum") = Trim(LrText(1).Text)      '水运单号
  1165.             .Fields("ldgnum") = Trim(LrText(2))                   '销售发货单号
  1166.             .Fields("sellcustcode") = Trim(LrText(3).Tag)         '客户编码
  1167.             .Fields("sellcustname") = Trim(LrText(3))
  1168.             .Fields("address") = Trim(LrText(4))                  '地址
  1169.             .Fields("phone") = Trim(LrText(5))                    '联系方式
  1170.             .Fields("person") = Trim(LrText(6))                   '联系人
  1171.             .Fields("Mnumber") = Trim(LrText(7))                  '货物编码
  1172.             .Fields("goodsgroup") = Trim(LrText(10))              '批次
  1173.             .Fields("quantity") = Trim(LrText(11))                '吨位
  1174.             .Fields("price") = Trim(LrText(12))                   '单价
  1175.             .Fields("boxnum") = Val(LrText(13))                   '箱量
  1176.             .Fields("watcherman") = Trim(LrText(14))              '监装人
  1177.             .Fields("sendman") = Trim(LrText(15))                 '发货人
  1178.             .Fields("receivecode") = Trim(LrText(16).Tag)         '承运单位
  1179.             If IsDate(Trim(LrText(17))) Then                      '装箱日期
  1180.                 .Fields("upboxdate") = Trim(LrText(17))
  1181.             Else
  1182.                 .Fields("upboxdate") = Null
  1183.             End If
  1184.             .Fields("startdate") = Trim(LrText(18))               '开船日期
  1185.             If IsDate(LrText(19)) Then                            '回单日期
  1186.                 .Fields("returndate") = Trim(LrText(19))
  1187.             Else
  1188.                 .Fields("returndate") = Null
  1189.             End If
  1190.             .Fields("shipway") = Trim(LrText(20))                 '船名船号
  1191.             .Fields("carrynum") = Trim(LrText(21))                '运单号
  1192.             .Fields("remark") = Trim(LrText(22))                  '备注
  1193.             .Fields("maker") = Xtczy                              '制单人
  1194.             .Fields("Checker") = ""                               '审核人置空
  1195.             .Update
  1196.         End With
  1197.     End If
  1198.          
  1199.     Cw_DataEnvi.DataConnect.CommitTrans
  1200.     
  1201.     Sub_SaveBill = True
  1202.     Tsxx = "单据存盘完毕! 单据号:" & Trim(LrText(1).Text)
  1203.     Call Xtxxts(Tsxx, 0, 4)
  1204.     
  1205.     '标识单据发生改动
  1206.     Bln_BillChange = True
  1207.     
  1208.     '设置单据改变后的状态
  1209.     Lab_OperStatus = "1"
  1210.     Call Sub_OperStatus("10")
  1211.     Rec_Query.Requery
  1212.     Rec_Query.find "ShipDeliverId=" & Val(Lab_BillId.Caption)
  1213.     
  1214.     Exit Function
  1216. Swcwcl:       '数据存盘时出现错误
  1217.     Cw_DataEnvi.DataConnect.RollbackTrans
  1218.     If Err.Number = -2147217887 Then
  1219.         Tsxx = "录入数据超出允许范围!"
  1220.         Call Xtxxts(Tsxx, 0, 1)
  1221.         Exit Function
  1222.      Else
  1223.         Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  1224.         Call Xtxxts(Tsxx, 0, 1)
  1225.         Exit Function
  1226.     End If
  1227. End Function
  1229. '选择首张,上张,下张,末张(此4个过程只需用您的单据ID字段名替换"ArriveMainId"即可)
  1230. Private Sub Sub_First()             '首 张
  1231.     
  1232.     With Rec_Query
  1233.         If .RecordCount = 0 Then
  1234.             Exit Sub
  1235.         End If
  1236.         .MoveFirst
  1237.         Lab_BillId.Caption = .Fields("ShipDeliverId")
  1238.         Call Sub_ShowBill
  1239.     End With
  1241. End Sub
  1243. Private Sub Sub_Prev()             '上 张
  1244.     
  1245.     With Rec_Query
  1246.         If .RecordCount = 0 Then
  1247.             Exit Sub
  1248.         End If
  1249.         .MovePrevious
  1250.         If Not .BOF Then
  1251.             Lab_BillId.Caption = .Fields("ShipDeliverId")
  1252.         Else
  1253.             .MoveNext
  1254.         End If
  1255.         Call Sub_ShowBill
  1256.     End With
  1258. End Sub
  1260. Private Sub Sub_Next()             '下 张
  1261.     With Rec_Query
  1262.         If .RecordCount = 0 Then
  1263.             Exit Sub
  1264.         End If
  1265.         .MoveNext
  1266.         If Not .EOF Then
  1267.             Lab_BillId.Caption = .Fields("ShipDeliverId")
  1268.         Else
  1269.             .MovePrevious
  1270.         End If
  1271.         Call Sub_ShowBill
  1272.     End With
  1274. End Sub
  1276. Private Sub Sub_Last()              '末 张
  1277.     
  1278.     With Rec_Query
  1279.         If .RecordCount = 0 Then
  1280.             Exit Sub
  1281.         End If
  1282.         .MoveLast
  1283.         Lab_BillId.Caption = .Fields("ShipDeliverId")
  1284.         Call Sub_ShowBill
  1285.     End With
  1287. End Sub
  1288.     
  1289. '[>>===================以下为根据实际业务需要自定义过程区域=============================<<]
  1291. '审核,弃审
  1292. Private Sub Sub_CheckBill()             '审 核
  1293.      
  1294.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1295.      If Not Security_Log(Str_RightCheck, Xtczybm, 1, True) Then
  1296.         Exit Sub
  1297.      End If
  1298.            
  1299.     '[>>
  1300.     '此处可以写入禁止单据审核的理由
  1301.     '<<]
  1302.     
  1303.     '将单据写入审核标识
  1304.     Cw_DataEnvi.DataConnect.Execute ("Update Tr_ShipDeliver Set Checker='" & Xtczy & "' Where ShipDeliverId=" & Val(Lab_BillId.Caption))
  1305.     
  1306.     '写入系统操作员
  1307.     LrText(24).Text = Xtczy
  1308.     
  1309.     '设置审核弃审按钮状态
  1310.     Call Sub_CheckStatus
  1311.     Tsxx = "审核完毕!"
  1312.     Call Xtxxts(Tsxx, 0, 4)
  1313.     '标识单据发生变化
  1314.     Bln_BillChange = True
  1316. End Sub
  1318. Private Sub Sub_AbandonCheck()          '弃 审
  1319.      
  1320.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1321.      If Not Security_Log(Str_RightCheck, Xtczybm, 1, True) Then
  1322.         Exit Sub
  1323.      End If
  1324.            
  1325.     '[>>
  1326.     '此处可以写入禁止单据弃审的理由
  1327.     '<<]
  1328.    
  1329.     '将单据清除审核标识
  1330.     Cw_DataEnvi.DataConnect.Execute ("Update Tr_ShipDeliver Set Checker='' Where ShipDeliverId=" & Val(Lab_BillId.Caption))
  1331.     
  1332.     '清空单据审核人
  1333.     LrText(24).Text = ""
  1334.     
  1335.     '设置审核弃审按钮状态
  1336.     Call Sub_CheckStatus
  1337.     Tsxx = "弃审完毕!"
  1338.     Call Xtxxts(Tsxx, 0, 4)
  1339.     '标识单据发生变化
  1340.     Bln_BillChange = True
  1341.   
  1342. End Sub
  1344. Private Function Fun_AllowEdit() As Boolean                      '判断当前单据是否允许编辑或删除
  1345.   
  1346.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  1347.     Fun_AllowEdit = False
  1348.     Sqlstr = "Select Checker From Tr_ShipDeliver Where ShipDeliverId=" & Val(Lab_BillId.Caption)
  1349.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1350.     With RecTemp
  1351.         If Not .EOF Then
  1352.             If Trim(.Fields("Checker") & "") <> "" Then
  1353.                 Tsxx = "该单据已审核确认,不能修改或删除!"
  1354.                 Call Xtxxts(Tsxx, 0, 4)
  1355.                 Exit Function
  1356.             End If
  1357.         End If
  1358.     End With
  1359.     Fun_AllowEdit = True
  1361. End Function
  1362. '[>>===================以上为根据实际业务需要自定义过程区域=============================<<]
  1364. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  1365.    
  1366.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  1367.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1368.         Exit Function
  1369.     End If
  1370.    
  1371.     '[>>
  1372.     
  1373.     '此处可以填写禁止文本框激活使单据处于录入状态的理由
  1374.    
  1375.     '<<]
  1376.    
  1377.     Fun_AllowInput = True
  1379. End Function
  1381. '*****************************以下为文本框录入处理程序(固定不变部分)*******************************'
  1383. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  1385.     '以下为依据实际情况自定义部分[
  1386.     
  1387.     '在此填写文本框录入事后处理程序
  1388.     
  1389.     ']以上为依据实际情况自定义部分
  1391. End Sub
  1393. Private Sub LrText_Change(Index As Integer)
  1394.     Dim rs As New ADODB.Recordset
  1395.     Dim str_sql As String
  1396.     
  1397.     '屏蔽程序改变控制
  1398.     If TextChangeLock Then
  1399.         Exit Sub
  1400.     End If
  1401.    
  1402.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  1403.         
  1404.     '限制字段录入长度
  1405.           
  1406.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  1407.         Select Case Textint(Index, 1)
  1408.             Case 8, 11       '金额型
  1409.                 Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  1410.             Case 9, 12       '数量型
  1411.                 Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  1412.             Case 10          '单价型
  1413.                 Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1414.             Case Else        '其他小数类型控制
  1415.                 If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  1416.                     Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  1417.                 End If
  1418.         End Select
  1419.     If Index = 2 Then
  1420.         str_sql = "select ConsignCode,gy_customer.cuscode,cusname,contacttype,contactperson,address from Xs_ConsignBillMain,gy_customer where Xs_ConsignBillMain.cuscode=gy_customer.cuscode and ConsignCode='" & Trim(LrText(2)) & "'"
  1421.         Set rs = Cw_DataEnvi.DataConnect.Execute(str_sql)
  1422.         If Not rs.EOF Then
  1423.             LrText(3).Tag = Trim(rs("cuscode"))
  1424.             LrText(3) = Trim(rs("cusname"))
  1425.             LrText(4) = Trim(rs("address"))
  1426.             LrText(5) = Trim(rs("contacttype"))
  1427.             LrText(6) = Trim(rs("contactperson"))
  1428.         Else
  1429.             LrText(3) = ""
  1430.             LrText(3).Tag = ""
  1431.             LrText(4) = ""
  1432.             LrText(5) = ""
  1433.             LrText(6) = ""
  1434.         End If
  1435.     End If
  1436.     If Index = 3 Then
  1437.         str_sql = "select cuscode,cusname,contacttype,contactperson,address from gy_customer where cuscode='" & Trim(LrText(3).Tag) & "'"
  1438.         Set rs = Cw_DataEnvi.DataConnect.Execute(str_sql)
  1439.         If Not rs.EOF Then
  1440.             LrText(4) = Trim(rs("address"))
  1441.             LrText(5) = Trim(rs("contacttype"))
  1442.             LrText(6) = Trim(rs("contactperson"))
  1443.         Else
  1444.             LrText(4) = ""
  1445.             LrText(5) = ""
  1446.             LrText(6) = ""
  1447.         End If
  1448.     End If
  1449.     If Index = 7 Then
  1450.         str_sql = "select mnumber,mname,model from gy_material where mnumber='" & Trim(LrText(7)) & "'"
  1451.         Set rs = Cw_DataEnvi.DataConnect.Execute(str_sql)
  1452.         If Not rs.EOF Then
  1453.             LrText(8) = rs("mname")
  1454.             LrText(9) = rs("model")
  1455.         Else
  1456.             LrText(8) = ""
  1457.             LrText(9) = ""
  1458.         End If
  1459.     End If
  1460.     TextChangeLock = False '解锁
  1461.      
  1462. End Sub
  1464. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  1465.     Call TextShow(Index)
  1466. End Sub
  1468. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  1469.     
  1470.     Select Case KeyCode
  1471.         Case vbKeyF2
  1472.             Call Text_Help(Index)
  1473.     End Select
  1475. End Sub
  1477. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  1478.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  1479. End Sub
  1481. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
  1482.     
  1483.     If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
  1484.         Call TextYxxpd(Index)
  1485.     End If
  1487. End Sub
  1489. Private Sub Ydcommand1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '点击按钮
  1490.     Call Text_Help(Ydcommand1.Tag)
  1491. End Sub
  1493. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  1494.     
  1495.     If Not Ydcommand1.Visible Then
  1496.         Exit Sub
  1497.     End If
  1498.     TextValiLock = True
  1499.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  1500.     If Len(Xtfhcs) <> 0 Then
  1501.         If Textint(Index, 3) = 1 Then
  1502.             LrText(Index).Text = Xtfhcsfz
  1503.             LrText(Index).Tag = Xtfhcs
  1504.         Else
  1505.             LrText(Index).Text = Xtfhcs
  1506.             LrText(Index).Tag = Xtfhcsfz
  1507.         End If
  1508.     End If
  1509.     TextValiLock = False
  1510.     LrText(Index).SetFocus
  1512. End Sub
  1514. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  1516.     '如果文本框有帮助,则显示帮助按钮
  1517.     If Textboolean(Index, 1) Then
  1518.         Ydcommand1.Visible = True
  1519.         Ydcommand1.Move LrText(Index).Left + LrText(Index).Width, LrText(Index).Top
  1520.         Ydcommand1.Tag = Index
  1521.     Else
  1522.         Ydcommand1.Tag = ""
  1523.         Ydcommand1.Visible = False
  1524.     End If
  1525.     
  1526.     '[>>
  1527.     '可在此处定义其他处理动作
  1528.     '<<]
  1530. End Sub
  1532. Private Sub Wbkcsh()                          '录入文本框初始化
  1534.     Dim Int_TabIndex As Integer         'Tab焦点计数器
  1535.   
  1536.     '单据录入中文本框焦点由0开始
  1537.     LrText(0).TabIndex = 0
  1538.   
  1539.     '最大录入文本框索引值
  1540.     Max_Text_Index = Textvar(1)
  1541.   
  1542.     ReDim TextValiJudgeLock(Max_Text_Index)
  1543.     For jsqte = 0 To Max_Text_Index
  1544.         
  1545.         '判断此文本框录入索引号是否存在,如存在则对其进行初始化
  1546.         If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  1547.         
  1548.             '自动装入录入文本框和其解释标签
  1549.             If jsqte <> 0 Then
  1550.                 Load LrText(jsqte)
  1551.                 Load TsLabel(jsqte)
  1552.            
  1553.                 '判断录入文本框是否显示
  1554.                 If Textboolean(jsqte, 4) Then
  1555.                     LrText(jsqte).Visible = True
  1556.                     TsLabel(jsqte).Visible = True
  1557.                 Else
  1558.                     LrText(jsqte).Visible = False
  1559.                     TsLabel(jsqte).Visible = False
  1560.                 End If
  1561.             
  1562.                 '判断文本框是否可编辑
  1563.                 If Textboolean(jsqte, 5) Then
  1564.                     LrText(jsqte).Enabled = True
  1565.                 Else
  1566.                     LrText(jsqte).Enabled = False
  1567.                 End If
  1568.             End If
  1569.            
  1570.            '初始化其内容
  1571.             TextChangeLock = True
  1572.             LrText(jsqte).Text = ""
  1573.             LrText(jsqte).Tag = ""
  1574.             LrText(jsqte).MaxLength = Textint(jsqte, 5)
  1575.             TextChangeLock = False
  1576.         
  1577.             '设置文本框位置及大小,并设置相应标签内容及其位置
  1578.             LrText(jsqte).Move Textint(jsqte, 13), Textint(jsqte, 12), Textint(jsqte, 11), Textint(jsqte, 10)
  1579.             TsLabel(jsqte).Caption = Textstr(jsqte, 7) & ":"
  1580.             TsLabel(jsqte).Move Textint(jsqte, 13) - TsLabel(jsqte).Width - 20, Textint(jsqte, 12) + (Textint(jsqte, 10) - TsLabel(jsqte).Height) / 2 - 30
  1581.             
  1582.         End If
  1583.      
  1584.         '将文本框有效性判断进行加锁,在文本框内容发生变化时将锁打开
  1585.         TextValiJudgeLock(jsqte) = True
  1586.       
  1587.     Next jsqte
  1588.     
  1589.     '设置文本框焦点转移顺序(前提文本焦点从0至Max_Text_Index)
  1590.     For Int_TabIndex = 0 To Max_Text_Index
  1591.         For jsqte = 0 To Max_Text_Index
  1592.             If Textint(jsqte, 14) = Int_TabIndex Then
  1593.                LrText(jsqte).TabIndex = Int_TabIndex
  1594.             End If
  1595.         Next jsqte
  1596.     Next Int_TabIndex
  1597.   
  1598. End Sub
  1600. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  1601.   
  1602.     Dim Sqlstr As String
  1603.     Dim Findrec As New ADODB.Recordset
  1604.   
  1605.     '按帮助不进行有效性判断
  1606.   
  1607.     If TextValiLock Then
  1608.         TextValiLock = False
  1609.         TextYxxpd = True
  1610.         Exit Function
  1611.     End If
  1612.   
  1613.     '文本框内容未曾改变不进行有效性判断
  1614.   
  1615.     If TextValiJudgeLock(Index) Then
  1616.         Ydcommand1.Visible = False
  1617.         TextYxxpd = True
  1618.         Exit Function
  1619.     End If
  1620.   
  1621.     '文本框内容为空认为有效,并清空其Tag值
  1622.   
  1623.     If Trim(LrText(Index)) = "" Then
  1624.         LrText(Index).Tag = ""
  1625.         Call Wbklrwbcl(Index)
  1626.         Ydcommand1.Visible = False
  1627.         TextValiJudgeLock(Index) = True
  1628.         TextYxxpd = True
  1629.         Exit Function
  1630.     End If
  1631.    
  1632.     Select Case Textint(Index, 4)
  1633.         Case 1      '编码型
  1634.             Sqlstr = Trim(Textstr(Index, 5))
  1635.             Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  1636.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1637.             If Findrec.EOF Then
  1638.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  1639.                 LrText(Index).SetFocus
  1640.                 Exit Function
  1641.             Else
  1642.                 Select Case Textint(Index, 3)
  1643.                     Case 0
  1644.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1645.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1646.                         End If
  1647.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1648.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1649.                         End If
  1650.                     Case 1
  1651.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1652.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1653.                         End If
  1654.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1655.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1656.                         End If
  1657.                 End Select
  1658.                 If Index = 3 Then
  1659.                     Dim myrs As New ADODB.Recordset
  1660.                     myrs.Open "select mname,model,Saleunit from gy_material where stopflag=0  and (mnumber='" & Trim(LrText(Index).Text) & "' or mname='" & Trim(LrText(Index).Text) & "') order by mnumber", Cw_DataEnvi.DataConnect
  1661.                     If Not myrs.EOF Then
  1662.                         LrText(4).Text = myrs.Fields("model")
  1663.                     End If
  1664.                 End If
  1665.             End If
  1666.         Case 2      '日期型
  1667.             If IsDate(LrText(Index).Text) Then
  1668.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  1669.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  1670.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  1671.                 End If
  1672.             Else
  1673.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  1674.                 Call Xtxxts(Tsxx, 0, 1)
  1675.                 LrText(Index).SetFocus
  1676.                 Exit Function
  1677.             End If
  1678.         Case 3      '其他类型
  1679.     End Select
  1680.     
  1681.     '隐藏帮助按钮
  1682.     Ydcommand1.Visible = False
  1683.    
  1684.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  1685.     TextValiJudgeLock(Index) = True
  1687.     '调用文本框事后处理程序
  1688.     Call Wbklrwbcl(Index)
  1689.    
  1690.     '有效性判断通过则返回True
  1691.     TextYxxpd = True
  1692.     
  1693. End Function