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

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

企业管理

开发平台：

Visual Basic

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