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

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

企业管理

开发平台：

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