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

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

企业管理

开发平台：

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