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

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

企业管理

开发平台：

Visual Basic

：源码内容
  1. VERSION 5.00
  2. Object = "{65A39231-6133-11D1-BAA2-444553540000}#1.0#0"; "vslight6.OCX"
  3. Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.OCX"
  4. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  5. Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
  6. Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
  7. Begin VB.Form Tr_DispatchOut 
  8.    BorderStyle     =   1  'Fixed Single
  9.    Caption         =   "调卸单"
  10.    ClientHeight    =   7095
  11.    ClientLeft      =   45
  12.    ClientTop       =   330
  13.    ClientWidth     =   9345
  14.    Icon            =   "铁运管理_调卸单.frx":0000
  15.    KeyPreview      =   -1  'True
  16.    LinkTopic       =   "Form2"
  17.    MaxButton       =   0   'False
  18.    MinButton       =   0   'False
  19.    ScaleHeight     =   7095
  20.    ScaleWidth      =   9345
  21.    StartUpPosition =   1  '所有者中心
  22.    Begin TabDlg.SSTab StTab 
  23.       Height          =   6435
  24.       Left            =   30
  25.       TabIndex        =   8
  26.       Top             =   660
  27.       Width           =   9330
  28.       _ExtentX        =   16457
  29.       _ExtentY        =   11351
  30.       _Version        =   393216
  31.       Style           =   1
  32.       Tabs            =   2
  33.       Tab             =   1
  34.       TabHeight       =   520
  35.       TabCaption(0)   =   "列表视图"
  36.       TabPicture(0)   =   "铁运管理_调卸单.frx":1042
  37.       Tab(0).ControlEnabled=   0   'False
  38.       Tab(0).Control(0)=   "CzxsGrid"
  39.       Tab(0).ControlCount=   1
  40.       TabCaption(1)   =   "单张视图"
  41.       TabPicture(1)   =   "铁运管理_调卸单.frx":105E
  42.       Tab(1).ControlEnabled=   -1  'True
  43.       Tab(1).Control(0)=   "Frame1"
  44.       Tab(1).Control(0).Enabled=   0   'False
  45.       Tab(1).ControlCount=   1
  46.       Begin VB.Frame Frame1 
  47.          Height          =   6015
  48.          Left            =   90
  49.          TabIndex        =   9
  50.          Top             =   330
  51.          Width           =   9135
  52.          Begin VB.TextBox LrText 
  53.             Height          =   300
  54.             Index           =   4
  55.             Left            =   1755
  56.             TabIndex        =   6
  57.             Text            =   "4"
  58.             Top             =   3030
  59.             Width           =   1620
  60.          End
  61.          Begin VB.TextBox LrText 
  62.             Height          =   300
  63.             Index           =   3
  64.             Left            =   1755
  65.             TabIndex        =   5
  66.             Text            =   "3"
  67.             Top             =   2585
  68.             Width           =   1620
  69.          End
  70.          Begin VB.TextBox LrText 
  71.             Height          =   300
  72.             Index           =   2
  73.             Left            =   1740
  74.             TabIndex        =   4
  75.             Text            =   "2"
  76.             Top             =   2140
  77.             Width           =   1618
  78.          End
  79.          Begin VB.TextBox LrText 
  80.             Height          =   300
  81.             Index           =   0
  82.             Left            =   1755
  83.             TabIndex        =   0
  84.             Text            =   "0"
  85.             Top             =   360
  86.             Width           =   1618
  87.          End
  88.          Begin VB.TextBox LrText 
  89.             Height          =   300
  90.             Index           =   1
  91.             Left            =   1755
  92.             TabIndex        =   3
  93.             Text            =   "1"
  94.             Top             =   1695
  95.             Width           =   1620
  96.          End
  97.          Begin VB.CommandButton QxCommand 
  98.             Cancel          =   -1  'True
  99.             Caption         =   "取消(&C)"
  100.             Height          =   300
  101.             Left            =   2100
  102.             TabIndex        =   11
  103.             Top             =   3660
  104.             Width           =   1120
  105.          End
  106.          Begin VB.CommandButton BcCommand 
  107.             Caption         =   "保存(&S)"
  108.             Height          =   300
  109.             Left            =   870
  110.             TabIndex        =   7
  111.             Top             =   3660
  112.             Width           =   1120
  113.          End
  114.          Begin VB.CommandButton Ydcommand1 
  115.             Height          =   300
  116.             Index           =   0
  117.             Left            =   3720
  118.             Picture         =   "铁运管理_调卸单.frx":107A
  119.             Style           =   1  'Graphical
  120.             TabIndex        =   10
  121.             Top             =   3270
  122.             Visible         =   0   'False
  123.             Width           =   300
  124.          End
  125.          Begin MSMask.MaskEdBox JiText 
  126.             Height          =   300
  127.             Index           =   1
  128.             Left            =   1755
  129.             TabIndex        =   2
  130.             Top             =   1250
  131.             Width           =   1620
  132.             _ExtentX        =   2858
  133.             _ExtentY        =   529
  134.             _Version        =   393216
  135.             MaxLength       =   16
  136.             Mask            =   "####-##-## ##:##"
  137.             PromptChar      =   "_"
  138.          End
  139.          Begin MSMask.MaskEdBox JiText 
  140.             Height          =   300
  141.             Index           =   0
  142.             Left            =   1755
  143.             TabIndex        =   1
  144.             Top             =   805
  145.             Width           =   1620
  146.             _ExtentX        =   2858
  147.             _ExtentY        =   529
  148.             _Version        =   393216
  149.             MaxLength       =   16
  150.             Mask            =   "####-##-## ##:##"
  151.             PromptChar      =   "_"
  152.          End
  153.          Begin VB.Label TsLabel 
  154.             AutoSize        =   -1  'True
  155.             Caption         =   "吨位:"
  156.             Height          =   180
  157.             Index           =   6
  158.             Left            =   420
  159.             TabIndex        =   21
  160.             Top             =   3090
  161.             Width           =   450
  162.          End
  163.          Begin VB.Label TsLabel 
  164.             AutoSize        =   -1  'True
  165.             Caption         =   "货物名称:"
  166.             Height          =   180
  167.             Index           =   5
  168.             Left            =   420
  169.             TabIndex        =   20
  170.             Top             =   2645
  171.             Width           =   810
  172.          End
  173.          Begin VB.Label TsLabel 
  174.             AutoSize        =   -1  'True
  175.             Caption         =   "货物编码:"
  176.             Height          =   180
  177.             Index           =   4
  178.             Left            =   420
  179.             TabIndex        =   19
  180.             Top             =   2200
  181.             Width           =   810
  182.          End
  183.          Begin VB.Label TsLabel 
  184.             AutoSize        =   -1  'True
  185.             Caption         =   "车号:"
  186.             Height          =   180
  187.             Index           =   0
  188.             Left            =   420
  189.             TabIndex        =   15
  190.             Top             =   420
  191.             Width           =   450
  192.          End
  193.          Begin VB.Label TsLabel 
  194.             AutoSize        =   -1  'True
  195.             Caption         =   "调卸负责人:"
  196.             Height          =   180
  197.             Index           =   1
  198.             Left            =   420
  199.             TabIndex        =   14
  200.             Top             =   1755
  201.             Width           =   990
  202.          End
  203.          Begin VB.Label TsLabel 
  204.             AutoSize        =   -1  'True
  205.             Caption         =   "要求调卸时间:"
  206.             Height          =   180
  207.             Index           =   2
  208.             Left            =   420
  209.             TabIndex        =   13
  210.             Top             =   865
  211.             Width           =   1170
  212.          End
  213.          Begin VB.Label TsLabel 
  214.             AutoSize        =   -1  'True
  215.             Caption         =   "调卸完毕时间:"
  216.             Height          =   180
  217.             Index           =   3
  218.             Left            =   420
  219.             TabIndex        =   12
  220.             Top             =   1310
  221.             Width           =   1170
  222.          End
  223.       End
  224.       Begin VSFlex8Ctl.VSFlexGrid CzxsGrid 
  225.          Height          =   5955
  226.          Left            =   -74910
  227.          TabIndex        =   16
  228.          Top             =   390
  229.          Width           =   9135
  230.          _ExtentX        =   16113
  231.          _ExtentY        =   10504
  232.          Appearance      =   1
  233.          BorderStyle     =   1
  234.          Enabled         =   -1  'True
  235.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  236.             Name            =   "宋体"
  237.             Size            =   9
  238.             Charset         =   134
  239.             Weight          =   400
  240.             Underline       =   0   'False
  241.             Italic          =   0   'False
  242.             Strikethrough   =   0   'False
  243.          EndProperty
  244.          MousePointer    =   0
  245.          BackColor       =   -2147483643
  246.          ForeColor       =   -2147483640
  247.          BackColorFixed  =   -2147483633
  248.          ForeColorFixed  =   -2147483630
  249.          BackColorSel    =   -2147483635
  250.          ForeColorSel    =   -2147483634
  251.          BackColorBkg    =   8421504
  252.          BackColorAlternate=   -2147483643
  253.          GridColor       =   -2147483633
  254.          GridColorFixed  =   -2147483632
  255.          TreeColor       =   -2147483632
  256.          FloodColor      =   192
  257.          SheetBorder     =   -2147483642
  258.          FocusRect       =   1
  259.          HighLight       =   1
  260.          AllowSelection  =   -1  'True
  261.          AllowBigSelection=   -1  'True
  262.          AllowUserResizing=   0
  263.          SelectionMode   =   0
  264.          GridLines       =   1
  265.          GridLinesFixed  =   2
  266.          GridLineWidth   =   1
  267.          Rows            =   5000
  268.          Cols            =   10
  269.          FixedRows       =   1
  270.          FixedCols       =   0
  271.          RowHeightMin    =   0
  272.          RowHeightMax    =   0
  273.          ColWidthMin     =   0
  274.          ColWidthMax     =   0
  275.          ExtendLastCol   =   0   'False
  276.          FormatString    =   ""
  277.          ScrollTrack     =   0   'False
  278.          ScrollBars      =   3
  279.          ScrollTips      =   0   'False
  280.          MergeCells      =   0
  281.          MergeCompare    =   0
  282.          AutoResize      =   -1  'True
  283.          AutoSizeMode    =   0
  284.          AutoSearch      =   0
  285.          MultiTotals     =   -1  'True
  286.          SubtotalPosition=   1
  287.          OutlineBar      =   0
  288.          OutlineCol      =   0
  289.          Ellipsis        =   0
  290.          ExplorerBar     =   0
  291.          PicturesOver    =   0   'False
  292.          FillStyle       =   0
  293.          RightToLeft     =   0   'False
  294.          PictureType     =   0
  295.          TabBehavior     =   0
  296.          OwnerDraw       =   0
  297.          Editable        =   0   'False
  298.          ShowComboButton =   -1  'True
  299.          WordWrap        =   0   'False
  300.          TextStyle       =   0
  301.          TextStyleFixed  =   0
  302.          OleDragMode     =   0
  303.          OleDropMode     =   0
  304.          DataMode        =   0
  305.          VirtualData     =   -1  'True
  306.       End
  307.    End
  308.    Begin MSComctlLib.Toolbar SzToolbar 
  309.       Align           =   1  'Align Top
  310.       Height          =   570
  311.       Left            =   0
  312.       TabIndex        =   17
  313.       Top             =   0
  314.       Width           =   9345
  315.       _ExtentX        =   16484
  316.       _ExtentY        =   1005
  317.       ButtonWidth     =   820
  318.       ButtonHeight    =   953
  319.       AllowCustomize  =   0   'False
  320.       Appearance      =   1
  321.       Style           =   1
  322.       ImageList       =   "ImageList1"
  323.       _Version        =   393216
  324.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  325.          NumButtons      =   12
  326.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  327.             Caption         =   "设置"
  328.             Key             =   "ymsz"
  329.             ImageKey        =   "sz"
  330.          EndProperty
  331.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  332.             Caption         =   "打印"
  333.             Key             =   "dy"
  334.             Object.ToolTipText     =   "点击或按Ctrl+P打印表格"
  335.             ImageKey        =   "dy"
  336.          EndProperty
  337.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  338.             Caption         =   "预览"
  339.             Key             =   "yl"
  340.             ImageKey        =   "yl"
  341.          EndProperty
  342.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  343.             Style           =   3
  344.          EndProperty
  345.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  346.             Caption         =   "增加"
  347.             Key             =   "zj"
  348.             Object.ToolTipText     =   "点击或按Ctrl+A增加记录"
  349.             ImageKey        =   "xz"
  350.          EndProperty
  351.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  352.             Caption         =   "修改"
  353.             Key             =   "xg"
  354.             ImageKey        =   "xg"
  355.          EndProperty
  356.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  357.             Caption         =   "删除"
  358.             Key             =   "sc"
  359.             Object.ToolTipText     =   "点击或按Ctrl+D删除当前记录"
  360.             ImageKey        =   "sc"
  361.          EndProperty
  362.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  363.             Style           =   3
  364.          EndProperty
  365.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  366.             Caption         =   "刷新"
  367.             Key             =   "sx"
  368.             ImageKey        =   "sx"
  369.          EndProperty
  370.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  371.             Style           =   3
  372.          EndProperty
  373.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  374.             Caption         =   "帮助"
  375.             Key             =   "bz"
  376.             ImageKey        =   "bz"
  377.          EndProperty
  378.          BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  379.             Caption         =   "退出"
  380.             Key             =   "fh"
  381.             ImageKey        =   "tc"
  382.          EndProperty
  383.       EndProperty
  384.       BorderStyle     =   1
  385.       Begin MSComctlLib.Toolbar GsToolbar 
  386.          Height          =   540
  387.          Left            =   6870
  388.          TabIndex        =   18
  389.          Top             =   0
  390.          Width           =   2475
  391.          _ExtentX        =   4366
  392.          _ExtentY        =   953
  393.          ButtonWidth     =   1455
  394.          ButtonHeight    =   953
  395.          AllowCustomize  =   0   'False
  396.          Appearance      =   1
  397.          Style           =   1
  398.          ImageList       =   "ImageList1"
  399.          _Version        =   393216
  400.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  401.             NumButtons      =   3
  402.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  403.                Caption         =   "保存格式"
  404.                Key             =   "bcgs"
  405.                ImageKey        =   "bcgs"
  406.             EndProperty
  407.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  408.                Caption         =   "默认列宽"
  409.                Key             =   "hfmrgs"
  410.                ImageKey        =   "mrlk"
  411.             EndProperty
  412.             BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  413.                Caption         =   "显示项目"
  414.                Key             =   "szxsxm"
  415.                ImageKey        =   "xsxm"
  416.             EndProperty
  417.          EndProperty
  418.       End
  419.    End
  420.    Begin MSComctlLib.ImageList ImageList1 
  421.       Left            =   0
  422.       Top             =   420
  423.       _ExtentX        =   1005
  424.       _ExtentY        =   1005
  425.       BackColor       =   -2147483643
  426.       ImageWidth      =   16
  427.       ImageHeight     =   16
  428.       MaskColor       =   12632256
  429.       _Version        =   393216
  430.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  431.          NumListImages   =   29
  432.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  433.             Picture         =   "铁运管理_调卸单.frx":1404
  434.             Key             =   "sz"
  435.          EndProperty
  436.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  437.             Picture         =   "铁运管理_调卸单.frx":179E
  438.             Key             =   "dy"
  439.          EndProperty
  440.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  441.             Picture         =   "铁运管理_调卸单.frx":1B38
  442.             Key             =   "yl"
  443.          EndProperty
  444.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  445.             Picture         =   "铁运管理_调卸单.frx":1ED2
  446.             Key             =   "xg"
  447.          EndProperty
  448.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  449.             Picture         =   "铁运管理_调卸单.frx":226C
  450.             Key             =   "zh"
  451.          EndProperty
  452.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  453.             Picture         =   "铁运管理_调卸单.frx":2606
  454.             Key             =   "sh"
  455.          EndProperty
  456.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  457.             Picture         =   "铁运管理_调卸单.frx":29A0
  458.             Key             =   "bc"
  459.          EndProperty
  460.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  461.             Picture         =   "铁运管理_调卸单.frx":2D3A
  462.             Key             =   "fq"
  463.          EndProperty
  464.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  465.             Picture         =   "铁运管理_调卸单.frx":30D4
  466.             Key             =   "bz"
  467.          EndProperty
  468.          BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  469.             Picture         =   "铁运管理_调卸单.frx":346E
  470.             Key             =   "tc"
  471.          EndProperty
  472.          BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  473.             Picture         =   "铁运管理_调卸单.frx":3808
  474.             Key             =   "bcgs"
  475.          EndProperty
  476.          BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  477.             Picture         =   "铁运管理_调卸单.frx":3BA2
  478.             Key             =   "mrlk"
  479.          EndProperty
  480.          BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  481.             Picture         =   "铁运管理_调卸单.frx":3F3C
  482.             Key             =   "xsxm"
  483.          EndProperty
  484.          BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  485.             Picture         =   "铁运管理_调卸单.frx":42D6
  486.             Key             =   "first"
  487.          EndProperty
  488.          BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  489.             Picture         =   "铁运管理_调卸单.frx":4670
  490.             Key             =   "prev"
  491.          EndProperty
  492.          BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  493.             Picture         =   "铁运管理_调卸单.frx":4A0A
  494.             Key             =   "next"
  495.          EndProperty
  496.          BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  497.             Picture         =   "铁运管理_调卸单.frx":4DA4
  498.             Key             =   "last"
  499.          EndProperty
  500.          BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  501.             Picture         =   "铁运管理_调卸单.frx":513E
  502.             Key             =   "xx"
  503.          EndProperty
  504.          BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  505.             Picture         =   "铁运管理_调卸单.frx":54D8
  506.             Key             =   "define"
  507.          EndProperty
  508.          BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  509.             Picture         =   "铁运管理_调卸单.frx":5872
  510.             Key             =   "exec"
  511.          EndProperty
  512.          BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  513.             Picture         =   "铁运管理_调卸单.frx":5C0C
  514.             Key             =   "xz"
  515.          EndProperty
  516.          BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  517.             Picture         =   "铁运管理_调卸单.frx":5FA6
  518.             Key             =   "sc"
  519.          EndProperty
  520.          BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  521.             Picture         =   "铁运管理_调卸单.frx":6340
  522.             Key             =   "sx"
  523.          EndProperty
  524.          BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  525.             Picture         =   "铁运管理_调卸单.frx":66DA
  526.             Key             =   "cx"
  527.          EndProperty
  528.          BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  529.             Picture         =   "铁运管理_调卸单.frx":6A74
  530.             Key             =   "zd"
  531.          EndProperty
  532.          BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  533.             Picture         =   "铁运管理_调卸单.frx":6E0E
  534.             Key             =   "dz"
  535.          EndProperty
  536.          BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  537.             Picture         =   "铁运管理_调卸单.frx":71A8
  538.             Key             =   "ph"
  539.          EndProperty
  540.          BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  541.             Picture         =   "铁运管理_调卸单.frx":7542
  542.             Key             =   "fz"
  543.          EndProperty
  544.          BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  545.             Picture         =   "铁运管理_调卸单.frx":78DC
  546.             Key             =   "dw"
  547.          EndProperty
  548.       EndProperty
  549.    End
  550. End
  551. Attribute VB_Name = "Tr_DispatchOut"
  552. Attribute VB_GlobalNameSpace = False
  553. Attribute VB_Creatable = False
  554. Attribute VB_PredeclaredId = True
  555. Attribute VB_Exposed = False
  556. '*******************************************************
  557. '*    模 块 名 称 :调卸单设置
  558. '*    功 能 描 述 :设置车辆卸货单据
  559. '*    程序员姓名  :孙宝龙
  560. '*    最后修改人  :孙宝龙
  561. '*    最后修改时间:2001/12/06
  562. '*    备        注:
  563. '*******************************************************
  564. Dim Rec_CodeSet As New ADODB.Recordset   '编码设置表
  565. Dim jdzygs As Integer                    '控件焦点转移个数
  566. Dim Lrzt As Integer                      '录入状态标志(0-非录入状态 1-增加 2-修改)
  567. Dim ReportTitle As String                '报表主标题
  568. Dim Str_RightEdit As String              '编辑(新增、修改、删除)权限索引
  570. '自定义
  571. Public dbl_RecordAutoCode As Double
  572. '以下为固定使用变量(网格)
  573. Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
  574. Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
  575. Dim GridCode As String                   '显示网格网格代码
  576. Dim GridInf() As Variant                 '整个网格设置信息
  577. Dim Tsxx As String                       '系统提示信息
  578. Dim Qslz As Long                         '网格隐藏(非操作显示)列数
  579. Dim Sjhgd As Double                      '网格数据行高度
  580. Dim GridBoolean() As Boolean             '网格列信息(布尔型)
  581. Dim GridStr()  As String                 '网格列信息(字符型)
  582. Dim GridInt() As Integer                 '网格列信息(整型)
  583. Dim szzls As Integer                     '数组总列数(网格列数-1)
  585. '以下为固定使用变量(文本框)
  586. Dim Textvar() As Variant                 '存储变体型文本框信息
  587. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  588. Dim Textint() As Integer                 '存储整型文本框信息
  589. Dim Textstr() As String                  '存储字符型文本框信息
  590. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  591. Dim TextGroupCode As String              '文本框录入分组编码
  592. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  593. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  594. Dim CurTextIndex As Integer              '当前文本框索引值
  595. Dim TextChangeLock As Boolean            '文本框内容变换控制锁
  596. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  598. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
  600.     jdzygs = 5
  601.     
  602.     Select Case KeyAscii
  603.         Case vbKeyReturn
  604.             If Kjjdzy(jdzygs) Then
  605.                 KeyAscii = 0
  606.             End If
  607.         Case 39           '屏蔽"'"
  608.             KeyAscii = 0
  609.    End Select
  610.    
  611. End Sub
  613. Private Sub Form_Load()
  614.   
  615.     '打印报表标题信息
  616.     ReportTitle = "调 卸 单"
  617.     Xtrq = Format(Xtrq, "yyyy-mm-dd hh:mm")
  618.     '调入打印页面设置窗体
  619.     XtReportCode = "Tr_DispatchOut"
  620.     Load Dyymctbl
  621.     
  622.     '以下为文本框处理程序(读入文本框录入信息)
  623.     TextGroupCode = "Tr_DispatchOut"
  624.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
  625.     Call Wbkcsh
  626.     
  627.     '调入网格设置信息
  628.     GridCode = "Tr_DispatchOut"
  629.     Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  630.     Qslz = GridInf(1)
  631.     Sjhgd = GridInf(2)
  632.     szzls = CzxsGrid.Cols - 1
  633.     
  634.     '填 充 网 格
  635.     Call Cxnrtcwg
  636.        
  637.     '初始化toolbar,tab卡状态
  638.     StTab.Tab = 0
  639.     StTab.TabEnabled(1) = False
  640.     Frame1.Enabled = False
  641.      
  642.     '设置为非录入状态
  643.     Lrzt = 0
  644.     
  645.     '编辑(新增、修改、删除)权限索引
  646.     Str_RightEdit = "Tr_DispatchOut_Edit"
  647.     
  648. End Sub
  649.  
  650. Private Sub Cxnrtcwg()                               '查询内容填充网格
  652.     Dim Sqlstr As String              '查询连接串
  653.     Dim jsqte As Long                '查询临时使用变量
  654.   
  655.     '为加快显示速度,将网格刷新动作冻结
  656.     CzxsGrid.Redraw = False
  657.   
  658.     '[>>查询连接串
  659.    Sqlstr = "SELECT Tr_DispatchOut.*,Tr_NowAccount.VoucherId as VoucherId FROM Tr_DispatchOut left outer join Tr_NowAccount on Tr_DispatchOut.OutId=Tr_NowAccount.ChildId where Tr_NowAccount.VoucherNum=7 order by Tr_DispatchOut.OutTime"
  660.     '<<]
  661.     Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  662.     
  663.     With Cxnrrec
  664.         CzxsGrid.Rows = CzxsGrid.FixedRows
  665.         If .EOF And .BOF Then
  666.             CzxsGrid.Redraw = True
  667.             Exit Sub
  668.         End If
  669.         
  670.         jsqte = CzxsGrid.FixedRows
  671.         
  672.         Do While Not .EOF
  673.             CzxsGrid.AddItem ""
  674.             Call Jltcwg(Cxnrrec, jsqte)                              '调入填充网格子过程
  675.             CzxsGrid.RowHeight(jsqte) = Sjhgd                        '设置网格高度
  676.             .MoveNext
  677.             jsqte = jsqte + 1
  678.         Loop
  679.     End With
  680.   
  681.     '将网格刷新动作解冻
  682.     CzxsGrid.Redraw = True
  683.     
  684. End Sub
  686. Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格
  688.     '[>>以下为自定义部分
  689.     Dim Str_temp As String
  690.     Dim Rs_temp As New ADODB.Recordset
  691.     
  692.     With Jlbrec
  693.         CzxsGrid.TextMatrix(Rowjsq, 0) = .Fields("OutId")
  694.         CzxsGrid.TextMatrix(Rowjsq, 1) = .Fields("VoucherId")
  695.         CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), szzls)) = Trim(.Fields("VehicleNum") & "")                               '车号
  696.         If Not IsNull(.Fields("OutTime")) Then
  697.               CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), szzls)) = Format(Trim(.Fields("OutTime")), "yyyy-mm-dd hh:mm")     '要求调卸时间
  698.         Else
  699.               CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), szzls)) = ""
  700.         End If
  701.         If Not IsNull(.Fields("OutEndTime")) Then
  702.               CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), szzls)) = Format(Trim(.Fields("OutEndTime")), "yyyy-mm-dd hh:mm") '调卸完毕时间
  703.         Else
  704.               CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), szzls)) = ""
  705.         End If
  706.         If Not IsNull(.Fields("OutMan")) Then
  707.               CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), szzls)) = Trim(.Fields("OutMan") & "")                            '调卸负责人
  708.         Else
  709.               CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), szzls)) = ""
  710.         End If
  711.         If Trim(.Fields("Result")) = True Then                                                                                     '调卸状态
  712.               CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), szzls)) = "已调卸"
  713.         Else
  714.               CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), szzls)) = "未调卸"
  715.         End If
  716.         Str_temp = "select mnumber,mname,model,caizhi,primaryunitname from gy_material where stopflag=0 and MNumber='" & Trim(.Fields("MNumber") & "") & "' "
  717.         Set Rs_temp = Nothing
  718.         Set Rs_temp = Cw_DataEnvi.DataConnect.Execute(Str_temp)
  719.         If Not Rs_temp.EOF() Then
  720.            CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), szzls)) = Trim(Rs_temp.Fields("MName"))
  721.            CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), szzls)) = Trim(Rs_temp.Fields("Model"))
  722.         End If
  723.         If Trim(.Fields("Quantity") & "") <> 0 Then
  724.            CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), szzls)) = Val(Trim(.Fields("Quantity") & ""))
  725.         End If
  726.     End With
  727.     '以上为自定义部分<<]
  728.     
  729. End Sub
  731. Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
  732.     dbl_RecordAutoCode = 0
  733.     Set Cxnrrec = Nothing
  734.     Set Rec_CodeSet = Nothing
  735.     Unload Dyymctbl
  736.    
  737. End Sub
  739. Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
  741.     Dim jsqte As Integer
  742.     Dim Findrc As New ADODB.Recordset
  743.   
  744.     '对文本框录入内容进行为零和为空判断(固定不变)
  745.     With Rec_CodeSet
  746.     
  747.         For jsqte = 0 To Max_Text_Index
  748.             If Textint(jsqte, 8) = 1 Then     '字段不能为空
  749.                 If Len(Trim(LrText(jsqte).Text)) = 0 Then
  750.                     Tsxx = Textstr(jsqte, 7) & "不能为空!"
  751.                     Call Xtxxts(Tsxx, 0, 1)
  752.                     LrText(jsqte).SetFocus
  753.                     Bclrsj = False
  754.                     Exit Function
  755.                 End If
  756.             Else
  757.                 If Textint(jsqte, 8) = 2 Then   '字段不能为零
  758.                     If Val(Trim(LrText(jsqte).Text)) = 0 Then
  759.                         Tsxx = Textstr(jsqte, 7) & "不能为零!"
  760.                         Call Xtxxts(Tsxx, 0, 1)
  761.                         LrText(jsqte).SetFocus
  762.                         Bclrsj = False
  763.                         Exit Function
  764.                     End If
  765.                 End If
  766.             End If
  767.         Next jsqte
  768.          '<<自定义
  769.         '判断要求调卸时间的年度是否与当前会计年度相符
  770.         If Trim(JiText(0).Text <> "____-__-__ __:__") Then
  771.         If IsDate(JiText(0).Text) Then
  772.             JiText(0).Text = Format(JiText(0).Text, "yyyy-mm-dd hh:mm")
  773.             If Val(Trim(JiText(0).Text)) <> Val(Year(Xtrq)) Then
  774.                 Tsxx = "年度与当前会计年度不符，请重新输入"
  775.                 Call Xtxxts(Tsxx, 0, 4)
  776.                 JiText(0).SetFocus
  777.                 Exit Function
  778.             End If
  779.         Else
  780.             Tsxx = "非法公历时间!(格式:" + Format(Date, "yyyy-mm-dd hh:mm") + ")"
  781.             Call Xtxxts(Tsxx, 0, 1)
  782.             JiText(0).SetFocus
  783.             Exit Function
  784.         End If
  785.     End If
  786.     
  787.     '要求调卸时间不能为空
  788.     If Trim(JiText(0).Text) = "____-__-__ __:__" Then
  789.         Tsxx = "要求调卸时间不能为空!"
  790.         Call Xtxxts(Tsxx, 0, 1)
  791.         JiText(0).SetFocus
  792.         Bclrsj = False
  793.         Exit Function
  794.     End If
  795.     '判断调卸完毕时间的年度是否与当前会计年度相符
  796.     If Trim(JiText(1).Text <> "____-__-__ __:__") Then
  797.         If IsDate(JiText(1).Text) Then
  798.             JiText(1).Text = Format(JiText(1).Text, "yyyy-mm-dd hh:mm")
  799.             If Val(Trim(JiText(1).Text)) <> Val(Year(Xtrq)) Then
  800.                 Tsxx = "年度与当前会计年度不符，请重新输入"
  801.                 Call Xtxxts(Tsxx, 0, 4)
  802.                 JiText(1).SetFocus
  803.                 Exit Function
  804.             End If
  805.         Else
  806.             Tsxx = "非法公历时间!(格式:" + Format(Date, "yyyy-mm-dd hh:mm") + ")"
  807.             Call Xtxxts(Tsxx, 0, 1)
  808.             JiText(1).SetFocus
  809.             Exit Function
  810.         End If
  811.     End If
  812.     '要求调卸时间不能大于调卸完毕时间
  813.     If Trim(JiText(0).Text) <> "____-__-__ __:__" And Trim(JiText(1).Text) <> "____-__-__ __:__" Then
  814.         If CDate(JiText(0).Text) > CDate(JiText(1).Text) Then
  815.             Tsxx = "要求调卸时间不能大于调卸完毕时间!"
  816.             Call Xtxxts(Tsxx, 0, 1)
  817.             Bclrsj = False
  818.             JiText(1).SetFocus
  819.             Exit Function
  820.         End If
  821.     End If
  822.     If Not JiTextptpd Then
  823.         Exit Function
  824.     End If
  825.     
  826.     '>>
  827.     
  828.         '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
  829.         For jsqte = 0 To Max_Text_Index
  830.             If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
  831.                 If Not TextYxxpd(jsqte) Then
  832.                     Exit Function
  833.                 End If
  834.             End If
  835.         Next jsqte
  836.         
  837.    
  838.         If Lrzt = 1 Then  '增 加
  839.         
  840.             If .State = 1 Then .Close
  841.             .Open "SELECT * FROM Tr_DispatchOut where 1=2 ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  843.             '判断记录内容无误后,将记录内容写入数据表
  844.             On Error GoTo Swcwcl
  845.     
  846.             Cw_DataEnvi.DataConnect.BeginTrans
  847.    
  848.             .AddNew
  849.                 .Fields("VehicleNum") = Trim(LrText(0).Text & "")                            '车号
  850.                 If Trim(JiText(0).Text) <> "____-__-__ __:__" Then
  851.                     .Fields("OutTime") = Format(JiText(0).Text, "yyyy-mm-dd hh:mm")          '要求调卸时间
  852.                 Else
  853.                     .Fields("OutTime") = Null
  854.                 End If
  855.                 If Trim(JiText(1).Text) <> "____-__-__ __:__" Then
  856.                     .Fields("OutEndTime") = Format(JiText(1).Text, "yyyy-mm-dd hh:mm")       '调卸完毕时间
  857.                 Else
  858.                     .Fields("OutEndTime") = Null
  859.                 End If
  860.                 If Trim(LrText(1).Text) <> "" Then
  861.                     .Fields("OutMan") = Trim(LrText(1).Text & "")                            '调卸负责人
  862.                 Else
  863.                     .Fields("OutMan") = ""
  864.                 End If
  865.                 If Trim(JiText(1).Text) <> "____-__-__ __:__" Then                           '调卸状态
  866.                     .Fields("Result") = 1
  867.                 Else
  868.                     .Fields("Result") = 0
  869.                 End If
  870.                 .Fields("MNumber") = Trim(LrText(2).Text & "")                               '货物编码
  871.                 .Fields("Quantity") = (Trim(LrText(4).Text) & "")                            '重量
  872.                
  873.                
  874.             .Update
  875.             dbl_RecordAutoCode = .Fields("OutId")
  876.             '增加记录的同时增加台准帐排它表中的记录(由此判断各状态时间问题)
  877.              If Findrc.State = 1 Then Findrc.Close
  878.                 Findrc.Open "SELECT * FROM Tr_NowAccount where 1=2 ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  879.     
  880.     
  881.                 Findrc.AddNew
  882.                 Findrc.Fields("VoucherNum") = 7                                                         '各状态拾别号调卸为7
  883.                 Findrc.Fields("ChildId") = dbl_RecordAutoCode
  884.                 Findrc.Fields("VehicleNum") = Trim(.Fields("VehicleNum") & "")                          '车号
  885.                 If Not IsNull(.Fields("OutTime")) Then
  886.                      Findrc.Fields("BeginTime") = Format(Trim(.Fields("OutTime")), "yyyy-mm-dd hh:mm")  '各状态要求时间
  887.                 Else
  888.                      Findrc.Fields("BeginTime") = Format(Trim(.Fields("OutTime")), "yyyy-mm-dd hh:mm")
  889.                 End If
  890.                 If Not IsNull(.Fields("OutEndTime")) Then
  891.                      Findrc.Fields("EndTime") = Format(Trim(.Fields("OutEndTime")), "yyyy-mm-dd hh:mm") '各状态完毕时间
  892.                 Else
  893.                      Findrc.Fields("EndTime") = Format(Trim(.Fields("OutTime")), "yyyy-mm-dd hh:mm")
  894.                 End If
  895.                 Findrc.Fields("MNumber") = Trim(.Fields("MNumber") & "")
  896.                 If .Fields("Result") = True Then
  897.                     Findrc.Fields("NowStatus") = "已调卸"                                               '目前状态
  898.                     Findrc.Fields("LimitMark") = 1
  899.                 Else
  900.                     Findrc.Fields("NowStatus") = "调卸"
  901.                     Findrc.Fields("LimitMark") = 0
  902.                 End If
  903.                 
  904.                 Findrc.Update
  905.             
  906.             Cw_DataEnvi.DataConnect.CommitTrans
  908.             '将记录加入网格
  909.             Sqlstr = "SELECT Tr_DispatchOut.*,Tr_NowAccount.VoucherId as VoucherId FROM Tr_DispatchOut left outer join Tr_NowAccount on Tr_DispatchOut.OutId=Tr_NowAccount.ChildId where Tr_NowAccount.VoucherNum=7 and Tr_DispatchOut.OutId='" & dbl_RecordAutoCode & "' order by Tr_DispatchOut.OutTime"
  910.             Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  911.    
  912.             With CzxsGrid
  913.                 .AddItem ""
  914.                 .RowHeight(.Rows - 1) = Sjhgd
  915.                 .Select .Rows - 1, Qslz
  916.                 Call Jltcwg(Cxnrrec, .Rows - 1)
  917.             End With
  919.             Tsxx = "保存完毕!"
  920.             Call Xtxxts(Tsxx, 0, 4)
  921.             
  922.             Call Cshlrxx(1)
  923.             LrText(0).SetFocus
  925.             '将网格按编码排序
  926.             With CzxsGrid
  927.                 .Col = Sydz("002", GridStr(), szzls)
  928.                 CzxsGrid.Sort = flexSortStringAscending
  929.             End With
  930.             '<<]
  931.     
  932.         Else  '否则为修改记录
  933.             On Error GoTo Swcwcl
  934.             Cw_DataEnvi.DataConnect.BeginTrans
  935.             If .State = 1 Then .Close
  936.             .Open "SELECT * FROM Tr_DispatchOut WHERE OutId= '" & dbl_RecordAutoCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  937.      
  938.             If Not .EOF Then
  939.                 If Trim(JiText(0).Text) <> "____-__-__ __:__" Then
  940.                     .Fields("OutTime") = Format(JiText(0).Text, "yyyy-mm-dd hh:mm")           '要求调卸时间
  941.                 Else
  942.                     .Fields("OutTime") = Null
  943.                 End If
  944.                 If Trim(JiText(1).Text) <> "____-__-__ __:__" Then
  945.                     .Fields("OutEndTime") = Format(JiText(1).Text, "yyyy-mm-dd hh:mm")        '调卸完毕时间
  946.                 Else
  947.                     .Fields("OutEndTime") = Null
  948.                 End If
  949.                 If Trim(LrText(1).Text) <> "" Then
  950.                     .Fields("OutMan") = Trim(LrText(1).Text & "")                             '调卸负责人
  951.                 Else
  952.                     .Fields("OutMan") = ""
  953.                 End If
  954.                 If Trim(JiText(1).Text) <> "____-__-__ __:__" Then                            '调卸状态
  955.                     .Fields("Result") = 1
  956.                 Else
  957.                     .Fields("Result") = 0
  958.                 End If
  959.                 .Fields("MNumber") = Trim(LrText(2).Text & "")                                '货物编码
  960.                 .Fields("Quantity") = (Trim(LrText(4).Text) & "")                             '重量
  961.                 .Update
  962.             End If
  963.             If Findrc.State = 1 Then Findrc.Close
  964.                 Findrc.Open "SELECT * FROM Tr_NowAccount where ChildId = '" & dbl_RecordAutoCode & "'and VoucherNum=7", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  965.                 If Not Findrc.EOF Then
  966.                     If Not IsNull(.Fields("OutTime")) Then
  967.                          Findrc.Fields("BeginTime") = Format(Trim(.Fields("OutTime")), "yyyy-mm-dd hh:mm")  '各状态要求时间
  968.                     Else
  969.                          Findrc.Fields("BeginTime") = Format(Trim(.Fields("OutTime")), "yyyy-mm-dd hh:mm")
  970.                     End If
  971.                     If Not IsNull(.Fields("OutEndTime")) Then
  972.                          Findrc.Fields("EndTime") = Format(Trim(.Fields("OutEndTime")), "yyyy-mm-dd hh:mm") '各状态完毕时间
  973.                     Else
  974.                          Findrc.Fields("EndTime") = Format(Trim(.Fields("OutTime")), "yyyy-mm-dd hh:mm")
  975.                     End If
  976.                     Findrc.Fields("MNumber") = Trim(.Fields("MNumber") & "")
  977.                     If .Fields("Result") = True Then
  978.                         Findrc.Fields("NowStatus") = "已调卸"                                                 '目前状态
  979.                         Findrc.Fields("LimitMark") = 1
  980.                     Else
  981.                         Findrc.Fields("NowStatus") = "调卸"
  982.                         Findrc.Fields("LimitMark") = 0
  983.                     End If
  984.                     
  985.                     Findrc.Update
  986.               End If
  987.              Cw_DataEnvi.DataConnect.CommitTrans
  988.    
  989.             '刷新当前网格
  990.             Sqlstr = "SELECT Tr_DispatchOut.*,Tr_NowAccount.VoucherId as VoucherId FROM Tr_DispatchOut left outer join Tr_NowAccount on Tr_DispatchOut.OutId=Tr_NowAccount.ChildId where Tr_NowAccount.VoucherNum=7  and Tr_DispatchOut.OutId='" & dbl_RecordAutoCode & "' order by Tr_DispatchOut.OutTime"
  991.             Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  992.    
  993.             With CzxsGrid
  994.                 Call Jltcwg(Cxnrrec, .Row)
  995.             End With
  996.    
  997.         End If
  998.      
  999.         '保存记录成功,函数返回真值
  1000.         Bclrsj = True
  1001.         Exit Function
  1002.         
  1003.     End With
  1004.  
  1005. Swcwcl:
  1007.      Cw_DataEnvi.DataConnect.RollbackTrans
  1009.      Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
  1010.      Call Xtxxts(Tsxx, 0, 1)
  1012.      Exit Function
  1013.      
  1014. End Function
  1016. Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息
  1017.     Dim Str_temp As String
  1018.     Dim Rs_temp As New ADODB.Recordset
  1019.     TextChangeLock = True       '关闭文本框Chang事件
  1020.     
  1021.     If lrztxx = 1 Then
  1022.     
  1023.         '增加新记录时将文本框清空
  1024.         For jsqte = 0 To Max_Text_Index
  1025.             If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  1026.                 LrText(jsqte).Text = ""
  1027.                 LrText(jsqte).Tag = ""
  1028.             End If
  1029.             TextValiJudgeLock(jsqte) = True
  1030.         Next jsqte
  1031.        
  1032.         '[>>
  1033.         JiText(1).Text = "____-__-__ __:__"
  1034.         JiText(0).Text = Format(Xtrq, "yyyy-mm-dd hh:mm")
  1035.         '<<]
  1036.     Else
  1037.     
  1038.         '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
  1039.         With RecTemp
  1040.             Sqlstr = "Select * From Tr_DispatchOut Where  OutId='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) & "'"
  1042.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1043.        
  1044.             '记录如存在则读入其内容,否则提示记录已被其他人删除
  1045.             If Not RecTemp.EOF Then
  1046.                 LrText(0).Tag = Trim(RecTemp.Fields("VehicleNum") & " ")          '车号
  1047.                 LrText(0).Text = Trim(RecTemp.Fields("VehicleNum") & " ")
  1048.                 JiText(0).Text = Format(Trim(RecTemp.Fields("OutTime")), "yyyy-mm-dd hh:mm")  '要求调卸时间
  1049.                 If IsNull(Trim(RecTemp.Fields("OutEndTime"))) Then                            '调卸完毕时间
  1050.                     JiText(1).Text = "____-__-__ __:__"
  1051.                 Else
  1052.                     JiText(1).Text = Format(Trim(RecTemp.Fields("OutEndTime")), "yyyy-mm-dd hh:mm")
  1053.                 End If
  1054.                 If Not IsNull(RecTemp.Fields("OutMan")) Then                                   '调卸负责人
  1055.                     LrText(1).Text = Trim(RecTemp.Fields("OutMan") & "")
  1056.                 Else
  1057.                     LrText(1).Text = ""
  1058.                 End If
  1059.                 Str_temp = "select mnumber,mname,model,caizhi,primaryunitname from gy_material where stopflag=0 and MNumber='" & Trim(.Fields("MNumber") & "") & "' "
  1060.                 Set Rs_temp = Nothing
  1061.                 Set Rs_temp = Cw_DataEnvi.DataConnect.Execute(Str_temp)
  1062.                 If Not Rs_temp.EOF() Then
  1063.                     LrText(2).Text = Trim(Rs_temp.Fields("MNumber"))
  1064.                     LrText(3).Text = Trim(Rs_temp.Fields("MName"))
  1065.                 End If
  1066.                 If Not IsNull(RecTemp.Fields("Quantity")) Then                                   '调卸负责人
  1067.                     LrText(4).Text = Trim(RecTemp.Fields("Quantity") & "")
  1068.                 Else
  1069.                     LrText(4).Text = ""
  1070.                 End If
  1071.                 dbl_RecordAutoCode = RecTemp.Fields("OutId")
  1072.             Else
  1073.                 Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
  1074.                 Call Xtxxts(Tsxx, 0, 4)
  1075.                 Call Cancel
  1076.                 TextChangeLock = False
  1077.                 Exit Function
  1078.             End If
  1079.         End With
  1080.     End If
  1081.     
  1082.     Cshlrxx = True
  1083.     TextChangeLock = False
  1084.     
  1085. End Function
  1087. Private Sub Scdqjl()                 '删 除 当 前 记 录
  1089.     Dim yhAnswer As Integer
  1090.     Dim Str_Parent As String
  1091.     Dim Sqlstr As String
  1092.     Dim Ts_temp1 As New ADODB.Recordset
  1093.     Dim Findrc As New ADODB.Recordset
  1094.     
  1095.      '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1096.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1097.         Exit Sub
  1098.     End If
  1099.     
  1100.     '非数据行不能删除
  1101.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1102.         Exit Sub
  1103.     End If
  1104.   
  1105.     '用户确认是否删除记录
  1106.     Tsxx = "请确认是否删除当前记录?"
  1107.     yhAnswer = Xtxxts(Tsxx, 2, 2)
  1108.     
  1109.     If yhAnswer = 2 Then
  1110.         Exit Sub
  1111.     End If
  1113.     On Error GoTo Cwcl
  1114.   
  1115.     Cw_DataEnvi.DataConnect.BeginTrans
  1117.     '[>>以下需自定义部分
  1118.     Cw_DataEnvi.DataConnect.Execute "delete Tr_DispatchOut where OutId = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) + "'"
  1119.     Cw_DataEnvi.DataConnect.Execute "delete Tr_NowAccount where ChildId = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) + "'and VoucherNum=7 "
  1120.   
  1121.     '以上为自定义部分<<]
  1122.   
  1123.     Cw_DataEnvi.DataConnect.CommitTrans
  1125.     CzxsGrid.RemoveItem CzxsGrid.Row
  1127.     Exit Sub
  1128.   
  1129. Cwcl:
  1131.     Cw_DataEnvi.DataConnect.RollbackTrans
  1132.     
  1133.     If Err.Number = -2147217873 Then                '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
  1134.         Tsxx = "该编码已经被使用,不能删除!"
  1135.         Call Xtxxts(Tsxx, 0, 1)
  1136.         Exit Sub
  1137.     Else
  1138.         Tsxx = "出现未知情况,该编码不能被删除!"
  1139.         Call Xtxxts(Tsxx, 0, 1)
  1140.         Exit Sub
  1141.     End If
  1142.     
  1143. End Sub
  1145. '*******************以下区域为编写自定义过程区域**********************
  1146.  '判断各状态的时间
  1147.  Function JiTextptpd() As Boolean
  1148.     Dim Sqlstr As String
  1149.     Dim jsqte As Long
  1150.     Dim str_TempSql As String
  1151.     Dim arrVar_TableCon()
  1152.     Dim arrVar_TableCon1()
  1153.     Dim arr_Var_TableCon2()
  1154.     Dim arrVar_TableCon3()
  1155.     Dim rs_Tmp As New ADODB.Recordset
  1156.     Dim Findrec As New ADODB.Recordset
  1157. On Error GoTo Pdbz
  1158. If Lrzt = 1 Then '各状态增加时的判断
  1159.         '先查询出同车号各状态正在进行的记录并找出最大时间与填入记录进行判断
  1160.         str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=0 order by BeginTime      "
  1161.         Set rs_Tmp = Nothing
  1162.         Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
  1163.         If Not rs_Tmp.RecordCount = 0 Then
  1164.             ReDim arrVar_TableCon(rs_Tmp.RecordCount - 1, 2)
  1165.         End If
  1166.         k = 0
  1167.         Do While Not rs_Tmp.EOF()
  1168.             arrVar_TableCon(k, 0) = Trim(rs_Tmp.Fields("NowStatus"))                              '目前状态
  1169.             arrVar_TableCon(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm")  '要求时间
  1170.             arrVar_TableCon(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm")    '完毕时间
  1171.             rs_Tmp.MoveNext
  1172.             k = k + 1
  1173.         Loop
  1174.         If Not rs_Tmp.RecordCount = 0 Then
  1176.             If JiText(0).Text < arrVar_TableCon(UBound(arrVar_TableCon, 1), 2) Then
  1177.                 If Trim(JiText(1).Text) = "____-__-__ __:__" Then
  1178.                     Tsxx = "调卸完毕时间不能为空"
  1179.                     Call Xtxxts(Tsxx, 0, 1)
  1180.                     JiText(1).SetFocus
  1181.                     JiTextptpd = False
  1182.                     Exit Function
  1183.                 End If
  1184.             End If
  1185.             For i = LBound(arrVar_TableCon, 1) To UBound(arrVar_TableCon, 1)
  1186.                 If i = UBound(arrVar_TableCon, 1) Then
  1187.                     If JiText(0).Text >= arrVar_TableCon(i, 1) Then
  1188.                         Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态，不能进行其他处理！"
  1189.                         Call Xtxxts(Tsxx, 0, 1)
  1190.                         JiText(0).SetFocus
  1191.                         JiTextptpd = False
  1192.                         Exit Function
  1193.                     End If
  1194.                 End If
  1195.                 If JiText(1).Text <> "____-__-__ __:__" Then
  1196.                     If JiText(1).Text >= arrVar_TableCon(i, 1) Then
  1197.                         Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态，请重新输入时间！"
  1198.                         Call Xtxxts(Tsxx, 0, 1)
  1199.                          JiText(1).SetFocus
  1200.                         JiTextptpd = False
  1201.                         Exit Function
  1202.                     End If
  1203.                 End If
  1204.             Next i
  1205.         End If
  1206.          '查询出各状态同车号已完成的记录并找出最大时间与填入的记录进行判断
  1207.         str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=1 order by BeginTime      "
  1208.         Set rs_Tmp = Nothing
  1209.         Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
  1210.         If Not rs_Tmp.RecordCount = 0 Then
  1211.             ReDim arrVar_TableCon2(rs_Tmp.RecordCount - 1, 2)
  1212.         End If
  1213.         k = 0
  1214.         Do While Not rs_Tmp.EOF()
  1215.             arrVar_TableCon2(k, 0) = Trim(rs_Tmp.Fields("NowStatus"))
  1216.             arrVar_TableCon2(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm")
  1217.             arrVar_TableCon2(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm")
  1218.             rs_Tmp.MoveNext
  1219.             k = k + 1
  1220.         Loop
  1221.         If Not rs_Tmp.RecordCount = 0 Then
  1222.             If JiText(0).Text < arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 2) Then
  1223.                 If Trim(JiText(1).Text) = "____-__-__ __:__" Then
  1224.                     Tsxx = "调卸完毕时间不能为空"
  1225.                     Call Xtxxts(Tsxx, 0, 1)
  1226.                     JiText(1).SetFocus
  1227.                     JiTextptpd = False
  1228.                     Exit Function
  1229.                 End If
  1230.             End If
  1231.             For i = LBound(arrVar_TableCon2, 1) To UBound(arrVar_TableCon2, 1)
  1232.                 If JiText(0).Text >= arrVar_TableCon2(i, 1) And JiText(0).Text <= arrVar_TableCon2(i, 2) Then
  1233.                     Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
  1234.                     Call Xtxxts(Tsxx, 0, 1)
  1235.                     JiText(0).SetFocus
  1236.                     JiTextptpd = False
  1237.                     Exit Function
  1238.                 End If
  1239.                 If JiText(1).Text >= arrVar_TableCon2(i, 1) And JiText(1).Text <= arrVar_TableCon2(i, 2) Then
  1240.                     Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
  1241.                     Call Xtxxts(Tsxx, 0, 1)
  1242.                     JiText(1).SetFocus
  1243.                     JiTextptpd = False
  1244.                     Exit Function
  1245.                 End If
  1246.                 If JiText(0) <= arrVar_TableCon2(i, 1) And JiText(1).Text >= arrVar_TableCon2(i, 2) Then
  1247.                         Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
  1248.                         Call Xtxxts(Tsxx, 0, 1)
  1249.                         JiText(1).SetFocus
  1250.                         JiTextptpd = False
  1251.                         Exit Function
  1252.                 End If
  1253.             Next i
  1254.         End If
  1255.         
  1256.         
  1257.         
  1258. Else  '修改
  1260.             '先查询出同车号各状态正在进行的记录并找出最大时间与填入记录进行判断
  1261.             str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=0 order by BeginTime      "
  1262.             Set rs_Tmp = Nothing
  1263.             Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
  1264.             If Not rs_Tmp.RecordCount = 0 Then
  1265.                 ReDim arrVar_TableCon(rs_Tmp.RecordCount - 1, 3)
  1266.             End If
  1267.             k = 0
  1268.             Do While Not rs_Tmp.EOF()
  1269.                 arrVar_TableCon(k, 0) = Trim(rs_Tmp.Fields("NowStatus"))
  1270.                 arrVar_TableCon(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm")
  1271.                 arrVar_TableCon(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm")
  1272.                 arrVar_TableCon(k, 3) = rs_Tmp.Fields("VoucherId")
  1273.                 rs_Tmp.MoveNext
  1274.                 k = k + 1
  1275.             Loop
  1276.             If Not rs_Tmp.RecordCount = 0 Then
  1277.                 For i = LBound(arrVar_TableCon, 1) To UBound(arrVar_TableCon, 1)
  1278.                     If i = UBound(arrVar_TableCon, 1) Then
  1279.                         If JiText(0).Text >= arrVar_TableCon(i, 1) And arrVar_TableCon(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
  1280.                             Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态，请重新输入时间！"
  1281.                             Call Xtxxts(Tsxx, 0, 1)
  1282.                             JiText(0).SetFocus
  1283.                             JiTextptpd = False
  1284.                             Exit Function
  1285.                         End If
  1286.                         If JiText(1).Text <> "____-__-__ __:__" Then
  1287.                             If JiText(1).Text >= arrVar_TableCon(i, 1) And arrVar_TableCon(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
  1288.                                 Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态，请重新输入时间！"
  1289.                                 Call Xtxxts(Tsxx, 0, 1)
  1290.                                  JiText(1).SetFocus
  1291.                                 JiTextptpd = False
  1292.                                 Exit Function
  1293.                             End If
  1294.                         End If
  1295.                     End If
  1296.                 Next i
  1297.                 str_tmp = "select * from Tr_DispatchOut where OutId='" & dbl_RecordAutoCode & "'and result=0 order by OutEndTime      "
  1298.                 Set Findrec = Nothing
  1299.                 Set Findrec = Cw_DataEnvi.DataConnect.Execute(str_tmp)
  1300.                 If Findrec.RecordCount = 0 Then
  1301.                     If JiText(1).Text = "____-__-__ __:__" Then
  1302.                         Tsxx = "调卸完毕时间不能为空"
  1303.                         Call Xtxxts(Tsxx, 0, 1)
  1304.                         JiText(1).SetFocus
  1305.                         JiTextptpd = False
  1306.                         Exit Function
  1307.                     End If
  1308.                 End If
  1309.             End If
  1310.             '先查询出同车号各状态已完成的记录并找出最大时间与填入记录进行判断
  1311.             str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=1 order by BeginTime      "
  1312.             Set rs_Tmp = Nothing
  1313.             Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
  1314.             If Not rs_Tmp.RecordCount = 0 Then
  1315.                  ReDim arrVar_TableCon2(rs_Tmp.RecordCount - 1, 3)
  1316.             End If
  1317.             k = 0
  1318.             Do While Not rs_Tmp.EOF()
  1319.                 arrVar_TableCon2(k, 0) = Trim(rs_Tmp.Fields("NowStatus"))
  1320.                 arrVar_TableCon2(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm")
  1321.                 arrVar_TableCon2(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm")
  1322.                 arrVar_TableCon2(k, 3) = rs_Tmp.Fields("VoucherId")
  1323.                 rs_Tmp.MoveNext
  1324.                 k = k + 1
  1325.             Loop
  1326.             
  1327.             str_tmp = "select * from Tr_DispatchOut where OutId='" & dbl_RecordAutoCode & "'and result=1 order by OutEndTime      "
  1328.             Set Findrec = Nothing
  1329.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(str_tmp)
  1330.                     If Not Findrec.RecordCount = 0 Then
  1331.                       If CDate(Findrec.Fields("OutEndTime")) = arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 2) Then
  1332.                         If JiText(1).Text = "____-__-__ __:__" Then
  1333.                             If JiText(0).Text = arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 1) Then
  1334.                                 JiTextptpd = True
  1335.                                 Exit Function
  1336.                             End If
  1337.                         End If
  1338.                       End If
  1339.                     End If
  1340.             If Not rs_Tmp.RecordCount = 0 Then
  1341.                 If JiText(0).Text < arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 2) Then
  1342.                     If Trim(JiText(1).Text) = "____-__-__ __:__" Then
  1343.                         Tsxx = "调卸完毕时间不能为空"
  1344.                         Call Xtxxts(Tsxx, 0, 1)
  1345.                         JiText(1).SetFocus
  1346.                         JiTextptpd = False
  1347.                         Exit Function
  1348.                     End If
  1349.                 End If
  1350.                 For i = LBound(arrVar_TableCon2, 1) To UBound(arrVar_TableCon2, 1)
  1351.                     If JiText(0) >= arrVar_TableCon2(i, 1) And JiText(0).Text <= arrVar_TableCon2(i, 2) And arrVar_TableCon2(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
  1352.                         Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
  1353.                         Call Xtxxts(Tsxx, 0, 1)
  1354.                         JiText(0).SetFocus
  1355.                         JiTextptpd = False
  1356.                         Exit Function
  1357.                     End If
  1358.                     If JiText(1) >= arrVar_TableCon2(i, 1) And JiText(1).Text <= arrVar_TableCon2(i, 2) And arrVar_TableCon2(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
  1359.                         Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
  1360.                         Call Xtxxts(Tsxx, 0, 1)
  1361.                         JiText(1).SetFocus
  1362.                         JiTextptpd = False
  1363.                         Exit Function
  1364.                     End If
  1365.                     If JiText(0) <= arrVar_TableCon2(i, 1) And JiText(1).Text >= arrVar_TableCon2(i, 2) And arrVar_TableCon2(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
  1366.                         Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
  1367.                         Call Xtxxts(Tsxx, 0, 1)
  1368.                         JiText(1).SetFocus
  1369.                         JiTextptpd = False
  1370.                         Exit Function
  1371.                     End If
  1372.                 Next i
  1373.             End If
  1374.             
  1375.             
  1376. '    End If
  1377.     
  1378.        
  1379. End If
  1380.        JiTextptpd = True
  1381.        Exit Function
  1382. Pdbz:
  1383.       Tsxx = "出现未知错误!"
  1384.      Call Xtxxts(Tsxx, 0, 1)
  1385.      JiTextptpd = False
  1386.      Exit Function
  1387.    
  1388. End Function
  1391. '*******************以上区域为编写自定义过程区域**********************
  1393. '******************以下为基本处理程序(固定不变)************************'
  1394. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  1396.     If Shift = 2 Then
  1397.         Select Case UCase(Chr(KeyCode))
  1398.             Case "P"                                                                          'Ctrl+P 打印
  1399.                 If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
  1400.                     Call bbyl(False)
  1401.                 End If
  1402.             Case "A"                                                                          'Ctrl+A 增加
  1403.                  '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1404.                 If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1405.                     Exit Sub
  1406.                 End If
  1407.                 If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
  1408.                     Call Toolbjzt
  1409.                     Lrzt = 1
  1410.                     Call Cshlrxx(Lrzt)
  1411.                     LrText(0).Enabled = True
  1412.                     LrText(0).SetFocus
  1413.                 End If
  1414.             Case "D"                                                                          'Ctrl+D 删除
  1415.                 If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
  1416.                     Call Scdqjl
  1417.                 End If
  1418.         End Select
  1419.     End If
  1420.     
  1421. End Sub
  1423. Private Sub LrText_Validate(Index As Integer, Cancel As Boolean)
  1424.  Dim Sqlstr As String
  1425.  Dim Rs_temp As New ADODB.Recordset
  1426.     If Index = 2 Then
  1427.         If Trim(LrText(Index).Text) <> "" Then
  1428.             Sqlstr = "select mnumber,mname,model,caizhi,primaryunitname from gy_material where stopflag=0 and MNumber='" & Trim(LrText(Index).Text) & "'"
  1429.             Set Rs_temp = Nothing
  1430.             Set Rs_temp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1431.             If Not Rs_temp.EOF() Then
  1432.                 If Not IsNull(Trim(Rs_temp.Fields("MName"))) Then
  1433.                   LrText(3).Text = Trim(Rs_temp.Fields("MName") & "")
  1434.                 Else
  1435.                   LrText(3).Text = ""
  1436.                 End If
  1437.             End If
  1438.         Else
  1439.            LrText(3).Text = ""
  1440.         End If
  1441.     End If
  1442. End Sub
  1444. Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  1445.    
  1446.     Select Case Button.Key
  1447.         Case "ymsz"                                          '页面设置
  1448.             Dyymctbl.Show 1
  1449.         Case "yl"                                            '预 览
  1450.             Call bbyl(True)
  1451.         Case "dy"                                            '打 印
  1452.             Call bbyl(False)
  1453.         Case "zj"                                            '增 加
  1454.              '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1455.             If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1456.                 Exit Sub
  1457.             End If
  1458.             Call Toolbjzt
  1459.             Lrzt = 1
  1460.             Call Cshlrxx(Lrzt)
  1461.             LrText(0).Enabled = True
  1462.             LrText(0).SetFocus
  1463.             Ydcommand1(0).Enabled = True
  1464.            
  1465.         Case "xg"                                            '修 改
  1466.             Call Xgdqjl
  1467.         Case "sc"                                            '删 除
  1468.             Call Scdqjl
  1469.         Case "sx"                                            '刷 新
  1470.             Call Cxnrtcwg
  1471.         Case "bz"                                            '帮 助
  1472.             Call F1bz
  1473.         Case "fh"                                            '退 出
  1474.             Unload Me
  1475.         End Select
  1476.         
  1477. End Sub
  1479. Private Sub CzxsGrid_DblClick()                            '修改当前编码记录
  1481.     Call Xgdqjl
  1482.   
  1483. End Sub
  1485. Private Sub Xgdqjl()                                       '修改当前编码记录
  1486.     
  1487.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1488.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
  1489.         BcCommand.Enabled = False
  1490.     End If
  1491.     
  1492.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1493.         Exit Sub
  1494.     End If
  1495.     
  1496.     Call Toolbjzt
  1497.     Lrzt = 2
  1498.     
  1499.     If Cshlrxx(Lrzt) Then
  1500.         LrText(1).SetFocus
  1501.         LrText(0).Enabled = False
  1502.         Ydcommand1(0).Enabled = False
  1503.         
  1504.     End If
  1505.   
  1506. End Sub
  1508. Private Sub Toolbjzt()                                     'Toolbar状态(编辑状态)
  1510.     StTab.TabEnabled(1) = True
  1511.     StTab.Tab = 1
  1512.     Frame1.Enabled = True
  1513.     StTab.TabEnabled(0) = False
  1514.     CzxsGrid.Enabled = False
  1516.     With SzToolbar
  1517.         .Buttons("ymsz").Enabled = False
  1518.         .Buttons("dy").Enabled = False
  1519.         .Buttons("yl").Enabled = False
  1520.         .Buttons("zj").Enabled = False
  1521.         .Buttons("xg").Enabled = False
  1522.         .Buttons("sc").Enabled = False
  1523.         .Buttons("sx").Enabled = False
  1524.     End With
  1525.   
  1526. End Sub
  1528. Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)
  1530.     StTab.TabEnabled(0) = True
  1531.     StTab.Tab = 0
  1532.     CzxsGrid.Enabled = True
  1533.     Frame1.Enabled = False
  1534.     StTab.TabEnabled(1) = False
  1535.     Lrzt = 0
  1536.     
  1537.     With SzToolbar
  1538.         .Buttons("ymsz").Enabled = True
  1539.         .Buttons("dy").Enabled = True
  1540.         .Buttons("yl").Enabled = True
  1541.         .Buttons("zj").Enabled = True
  1542.         .Buttons("xg").Enabled = True
  1543.         .Buttons("sc").Enabled = True
  1544.         .Buttons("sx").Enabled = True
  1545.     End With
  1546.   
  1547. End Sub
  1549. Private Sub BcCommand_Click()                                           '保 存
  1551.     If Not Bclrsj Then
  1552.         Exit Sub
  1553.     End If
  1554.   
  1555.     If Lrzt = 2 Then
  1556.         Call Toolfbjzt
  1557.     End If
  1558.   
  1559. End Sub
  1561. Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)       '取消
  1562.   
  1563.     '避免执行Click程序
  1564.     Bln_Cancel = True
  1565.   
  1566.     Call Cancel
  1567.     
  1568. End Sub
  1570. Private Sub QxCommand_Click()                                                                         '取消
  1571.  
  1572.     If Bln_Cancel Then
  1573.         Bln_Cancel = False
  1574.         Exit Sub
  1575.     End If
  1576.  
  1577.     Call Cancel
  1578.     
  1579. End Sub
  1581. Private Sub Cancel()                                                                                  '取消
  1582.   
  1583.     '文本框加锁
  1584.     For jsqte = 0 To Max_Text_Index
  1585.         TextValiJudgeLock(jsqte) = True
  1586.     Next jsqte
  1587.   
  1588.     Call Toolfbjzt
  1589.     
  1590. End Sub
  1592. Private Sub CzxsGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  1593.     
  1594.     FnBln_RefreshArray Col, Position, GridStr(), GridInf()
  1596. End Sub
  1598. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  1599.     
  1600.     Select Case Button.Key
  1601.         Case "bcgs"                                       '保存表格格式
  1602.             Call Bcwggs(CzxsGrid, GridCode, GridStr())
  1603.         Case "hfmrgs"                                     '恢复默认格式
  1604.             Call Hfmrgs(CzxsGrid, GridCode, GridStr())
  1605.         Case "szxsxm"                                     '设置显示项目
  1606.             Call Szxsxm(CzxsGrid, GridCode)
  1607.     End Select
  1608.     
  1609. End Sub
  1611. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  1613.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  1614.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  1615.     Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  1616.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  1617.     ReDim Bbxbt(1 To Bbxbtgs)
  1618.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  1619.     
  1620.     If Bbbwhgs <> 0 Then
  1621.         ReDim Bbbwh(1 To Bbbwhgs)
  1622.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  1623.     End If
  1624.     
  1625.     Bbzbt = ReportTitle
  1626.     Bbxbt(1) = " "
  1627.     bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  1628.     
  1629.     Call Scyxsjb(CzxsGrid)                               '生成报表数据
  1630.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  1631.   
  1632.     If Not bbylte Then
  1633.         Unload DY_Tybbyldy
  1634.     End If
  1635.     
  1636. End Sub
  1638. '************以下为文本框录入处理程序(固定不变部分)*************'
  1640. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  1642.     '以下为依据实际情况自定义部分[
  1643.   
  1644.         '在此填写文本框录入事后处理程序
  1645.    
  1646.     ']以上为依据实际情况自定义部分
  1647.     
  1648. End Sub
  1650. Private Sub LrText_Change(Index As Integer)
  1652.     '屏蔽程序改变控制
  1653.     If TextChangeLock Then
  1654.         Exit Sub
  1655.     End If
  1656.     
  1657.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  1658.     
  1659.     '限制字段录入长度
  1660.           
  1661.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  1662.      
  1663.     Select Case Textint(Index, 1)
  1664.         Case 8, 11      '金额型
  1665.             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  1666.         Case 9, 12      '数量型
  1667.             Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  1668.         Case 10          '单价型
  1669.             Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1670.         Case Else        '其他小数类型控制
  1671.             If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  1672.                 Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  1673.             End If
  1674.     End Select
  1675.         
  1676.     TextChangeLock = False '解锁
  1677.     
  1678. End Sub
  1680. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  1681.    
  1682.     Call TextShow(Index)
  1683.     CurTextIndex = Index
  1684.     LrText(Index).SelStart = Len(LrText(Index))
  1685.    
  1686. End Sub
  1688. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  1689.    
  1690.     Select Case KeyCode
  1691.          Case vbKeyF2
  1692.              Call Text_Help(Index)
  1693.     End Select
  1694.    
  1695. End Sub
  1697. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  1698.    
  1699.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  1701. End Sub
  1703. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点
  1705.     '显示相应信息但不能进行有效性判断
  1706.   
  1707. End Sub
  1709. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
  1710.     
  1711.     Call Text_Help(Index)
  1712.     
  1713. End Sub
  1715. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  1716.   
  1717.     If Not Textboolean(Index, 1) Then
  1718.         Exit Sub
  1719.     End If
  1720.    
  1721.     '调用帮助
  1722.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  1723.   
  1724.     '根据设置选择显示编码和名称,并进行存储
  1725.     If Len(Xtfhcs) <> 0 Then
  1726.         If Textint(Index, 3) = 1 Then
  1727.             LrText(Index).Text = Xtfhcsfz
  1728.             LrText(Index).Tag = Xtfhcs
  1729.         Else
  1730.             LrText(Index).Text = Xtfhcs
  1731.             LrText(Index).Tag = Xtfhcsfz
  1732.         End If
  1733.     End If
  1734.    
  1735.     LrText(Index).SetFocus
  1736.     
  1737. End Sub
  1739. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  1741.     '填写文本框得到焦点,进行相应信息处理程序
  1742.    
  1743. End Sub
  1745. Private Sub Wbkcsh()                          '录入文本框初始化
  1747.     Dim jsqte As Long
  1748.   
  1749.     '最大录入文本框索引值
  1750.     Max_Text_Index = Textvar(1)
  1751.   
  1752.     ReDim TextValiJudgeLock(Max_Text_Index)
  1753.     
  1754.     For jsqte = 0 To Max_Text_Index
  1755.      
  1756.         If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  1757.             If Textboolean(jsqte, 1) Then
  1758.                 If jsqte <> 0 And Not Textboolean(jsqte, 3) Then
  1759.                     Load Ydcommand1(jsqte)
  1760.                 End If
  1761.                 Ydcommand1(jsqte).Visible = True
  1762.                 Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
  1763.             End If
  1764.             TextChangeLock = True
  1765.             LrText(jsqte).Text = ""
  1766.             LrText(jsqte).Tag = ""
  1767.             
  1768.             If Textint(jsqte, 5) <> 0 Then
  1769.                 LrText(jsqte).MaxLength = Textint(jsqte, 5)
  1770.             End If
  1771.             
  1772.             TextChangeLock = False
  1773.         End If
  1774.         
  1775.         TextValiJudgeLock(jsqte) = True
  1776.     Next jsqte
  1777.     
  1778. End Sub
  1780. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  1782.     Dim Sqlstr As String
  1783.     Dim Findrec As ADODB.Recordset
  1784.   
  1785.     '文本框内容未曾改变不进行有效性判断
  1786.     If TextValiJudgeLock(Index) Then
  1787.         TextYxxpd = True
  1788.         Exit Function
  1789.     End If
  1790.   
  1791.     '文本框内容为空认为有效,并清空其Tag值
  1792.     If Trim(LrText(Index)) = "" Then
  1793.         LrText(Index).Tag = ""
  1794.         Call Wbklrwbcl(Index)
  1795.         TextValiJudgeLock(Index) = True
  1796.         TextYxxpd = True
  1797.         Exit Function
  1798.     End If
  1799.   
  1800.     '可在此加入不做有效性判断的理由
  1801.   
  1802.     Select Case Textint(Index, 4)
  1803.         Case 1      '编码型
  1804.             Sqlstr = Trim(Textstr(Index, 5))
  1805.             Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  1806.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1807.          
  1808.             If Findrec.EOF Then
  1809.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  1810.                 LrText(Index).SetFocus
  1811.                 Exit Function
  1812.             Else
  1813.                 Select Case Textint(Index, 3)
  1814.                     Case 0
  1815.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1816.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1817.                         End If
  1818.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1819.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1820.                         End If
  1821.                     Case 1
  1822.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1823.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1824.                         End If
  1825.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1826.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1827.                         End If
  1828.                 End Select
  1829.             End If
  1830.             
  1831.         Case 2      '日期型
  1832.             If IsDate(LrText(Index).Text) Then
  1833.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  1834.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  1835.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  1836.                 End If
  1837.             Else
  1838.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  1839.                 Call Xtxxts(Tsxx, 0, 1)
  1840.                 LrText(Index).SetFocus
  1841.                 Exit Function
  1842.             End If
  1843.             
  1844.         Case 3      '其他类型
  1845.             If Index = 0 Then
  1846.                 If Len(LrText(Index).Text) <> 7 And Len(LrText(Index).Text) <> 8 Then
  1847.                      Tsxx = "车号只能是7位或8位数字或字符！"
  1848.                      Call Xtxxts(Tsxx, 0, 1)
  1849.                      LrText(Index).SetFocus
  1850.                      Exit Function
  1851.                 End If
  1852.             End If
  1853.         
  1854.     End Select
  1855.     
  1856.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  1857.     TextValiJudgeLock(Index) = True
  1859.     '调用文本框事后处理程序
  1860.     Call Wbklrwbcl(Index)
  1861.    
  1862.     '有效性判断通过则返回True
  1863.     TextYxxpd = True
  1864.    
  1865. End Function