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

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

企业管理

开发平台：

Visual Basic

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