上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:68k
源码类别:

企业管理

开发平台:

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