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

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

企业管理

开发平台：

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