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

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

企业管理

开发平台：

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